#!/usr/local/bin/perl
;#
;# Copyright (c) 1996, 1997
;# Ikuo Nakagawa. All rights reserved.
;#
;# Redistribution and use in source and binary forms, with or without
;# modification, are permitted provided that the following conditions
;# are met:
;#
;# 1. Redistributions of source code must retain the above copyright
;# notice unmodified, this list of conditions, and the following
;# disclaimer.
;# 2. Redistributions in binary form must reproduce the above copyright
;# notice, this list of conditions and the following disclaimer in the
;# documentation and/or other materials provided with the distribution.
;#
;# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
;# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
;# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
;# PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS
;# BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY,
;# OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT
;# OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
;# BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
;# WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
;# OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
;# EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;#
;# $id$
;#
use strict;
use vars qw($package $version $dir
$opt_v $opt_d $tar_flags $gzip_flags @file);
;# we use getopts.
use Getopt::Std;
;# get our name
($program) = $0 =~ m|([^/]+)$|;
;# show message and die.
sub usage {
die("Usage: $program [-v] package [version]\n");
}
;# parse options.
getopts("vd") && (@ARGV == 1 || @ARGV == 2) or &usage;
$package = shift;
$version = @ARGV ? shift : undef;
;# debug log
if ($opt_d) {
print STDERR "* package=$package";
print STDERR ", version=$version" if $version ne '';
print STDERR "\n";
}
;# If $version is given, try to use it,
;# otherwise try to find newest version of the package.
if ($version ne '') {
$dir = "$package-$version";
if (! -d $dir) {
print STDERR "$package-$version: directory not found\n"
if $opt_v;
&usage;
}
} else {
my $e;
$dir = '';
local *DIR;
opendir(DIR, ".") || die("opendir(.): $!\n");
while (defined($e = readdir(DIR))) {
next if $e eq '.' || $e eq '..';
if ($e eq $package || $e =~ /^$package(-|\.)/) {
$dir = $e if -d $e && $dir lt $e;
}
}
close(DIR);
if ($dir eq '') {
print STDERR "$package: no directory found\n" if $opt_v;
&usage;
}
}
;#
print STDERR "* directory=$dir\n" if $opt_d;
;# do real work
if (-f "$dir.tar") {
print STDERR "* unlink $dir.tar\n" if $opt_d;
unlink("$dir.tar");
}
if (-f "$dir.tar.gz") {
print STDERR "* unlink $dir.tar.gz\n" if $opt_d;
unlink("$dir.tar.gz");
}
;#
if ($opt_d) {
print STDERR "* archiving $dir...\n";
$tar_flags = 'cvf';
} else {
$tar_flags = 'cf';
}
;# Search files
open(PIPE, "find '$dir' -type f -print|") || die("open(find): $!");
while (<PIPE>) {
chomp;
next if /CVS/;
next if /\/\.depend$/;
print STDERR "* add $_\n" if $opt_d;
push(@file, $_);
}
close(PIPE);
die("find: $!") if $?;
;# check existence of target files
@file || die("no file found in $dir\n");
;# sorting
@file = sort(@file);
;# Now, try to invoke tar.
system("tar", $tar_flags, "$dir.tar", @file);
die("system: $!") if $?;
;# verbose message
if ($opt_d) {
print STDERR "* compressing $dir.tar...\n";
$gzip_flags = '-9fnv';
} else {
$gzip_flags = '-9fn';
}
;# Now, try to invoke gzip.
system "gzip", $gzip_flags, "$dir.tar";
die("system: $!") if $?;
;#
print STDERR "$dir ... ok\n" if $opt_v;
syntax highlighted by Code2HTML, v. 0.9.1