#!/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 () { 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;