|
Packit |
0bf95d |
#!/usr/bin/perl -w
|
|
Packit |
0bf95d |
# Makes a zip file of the most recent files in a specified directory.
|
|
Packit |
0bf95d |
# By Rudi Farkas, rudif@bluemail.ch, 9 December 2000
|
|
Packit |
0bf95d |
# Usage:
|
|
Packit |
0bf95d |
# ziprecent <dir> -d <ageDays> [-e <ext> ...]> [-h] [-msvc] [-q] [<zippath>]
|
|
Packit |
0bf95d |
# Zips files in source directory and its subdirectories
|
|
Packit |
0bf95d |
# whose file extension is in specified extensions (default: any extension).
|
|
Packit |
0bf95d |
# -d <days> max age (days) for files to be zipped (default: 1 day)
|
|
Packit |
0bf95d |
# <dir> source directory
|
|
Packit |
0bf95d |
# -e <ext> one or more space-separated extensions
|
|
Packit |
0bf95d |
# -h print help text and exit
|
|
Packit |
0bf95d |
# -msvc may be given instead of -e and will zip all msvc source files
|
|
Packit |
0bf95d |
# -q query only (list files but don't zip)
|
|
Packit |
0bf95d |
# <zippath>.zip path to zipfile to be created (or updated if it exists)
|
|
Packit |
0bf95d |
#
|
|
Packit |
0bf95d |
# $Revision: 1.2 $
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
use strict;
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
use Archive::Zip qw(:ERROR_CODES :CONSTANTS);
|
|
Packit |
0bf95d |
use Cwd;
|
|
Packit |
0bf95d |
use File::Basename;
|
|
Packit |
0bf95d |
use File::Copy;
|
|
Packit |
0bf95d |
use File::Find;
|
|
Packit |
0bf95d |
use File::Path;
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
# argument and variable defaults
|
|
Packit |
0bf95d |
#
|
|
Packit |
0bf95d |
my $maxFileAgeDays = 1;
|
|
Packit |
0bf95d |
my $defaultzipdir = 'h:/zip/_homework';
|
|
Packit |
0bf95d |
my ($sourcedir, $zipdir, $zippath, @extensions, $query);
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
# usage
|
|
Packit |
0bf95d |
#
|
|
Packit |
0bf95d |
my $scriptname = basename $0;
|
|
Packit |
0bf95d |
my $usage = <
|
|
Packit |
0bf95d |
$scriptname <dir> -d <ageDays> [-e <ext> ...]> [-h] [-msvc] [-q] [<zippath>]
|
|
Packit |
0bf95d |
Zips files in source directory and its subdirectories
|
|
Packit |
0bf95d |
whose file extension is in specified extensions (default: any extension).
|
|
Packit |
0bf95d |
-d <days> max age (days) for files to be zipped (default: 1 day)
|
|
Packit |
0bf95d |
<dir> source directory
|
|
Packit |
0bf95d |
-e <ext> one or more space-separated extensions
|
|
Packit |
0bf95d |
-h print help text and exit
|
|
Packit |
0bf95d |
-msvc may be given instead of -e and will zip all msvc source files
|
|
Packit |
0bf95d |
-q query only (list files but don't zip)
|
|
Packit |
0bf95d |
<zippath>.zip path to zipfile to be created (or updated if it exists)
|
|
Packit |
0bf95d |
ENDUSAGE
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
# parse arguments
|
|
Packit |
0bf95d |
#
|
|
Packit |
0bf95d |
while (@ARGV) {
|
|
Packit |
0bf95d |
my $arg = shift;
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
if ($arg eq '-d') {
|
|
Packit |
0bf95d |
$maxFileAgeDays = shift;
|
|
Packit |
0bf95d |
$maxFileAgeDays = 0.0 if $maxFileAgeDays < 0.0;
|
|
Packit |
0bf95d |
} elsif ($arg eq '-e') {
|
|
Packit |
0bf95d |
while ($ARGV[0] && $ARGV[0] !~ /^-/) {
|
|
Packit |
0bf95d |
push @extensions, shift;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
} elsif ($arg eq '-msvc') {
|
|
Packit |
0bf95d |
push @extensions,
|
|
Packit |
0bf95d |
qw / bmp c cpp def dlg dsp dsw h ico idl mak odl rc rc2 rgs /;
|
|
Packit |
0bf95d |
} elsif ($arg eq '-q') {
|
|
Packit |
0bf95d |
$query = 1;
|
|
Packit |
0bf95d |
} elsif ($arg eq '-h') {
|
|
Packit |
0bf95d |
print STDERR $usage;
|
|
Packit |
0bf95d |
exit;
|
|
Packit |
0bf95d |
} elsif (-d $arg) {
|
|
Packit |
0bf95d |
$sourcedir = $arg;
|
|
Packit |
0bf95d |
} elsif ($arg eq '-z') {
|
|
Packit |
0bf95d |
if ($ARGV[0]) {
|
|
Packit |
0bf95d |
$zipdir = shift;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
} elsif ($arg =~ /\.zip$/) {
|
|
Packit |
0bf95d |
$zippath = $arg;
|
|
Packit |
0bf95d |
} else {
|
|
Packit |
0bf95d |
errorExit("Unknown option or argument: $arg");
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
# process arguments
|
|
Packit |
0bf95d |
#
|
|
Packit |
0bf95d |
errorExit("Please specify an existing source directory")
|
|
Packit |
0bf95d |
unless defined($sourcedir) && -d $sourcedir;
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
my $extensions;
|
|
Packit |
0bf95d |
if (@extensions) {
|
|
Packit |
0bf95d |
$extensions = join "|", @extensions;
|
|
Packit |
0bf95d |
} else {
|
|
Packit |
0bf95d |
$extensions = ".*";
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
# change '\' to '/' (avoids trouble in substitution on Win2k)
|
|
Packit |
0bf95d |
#
|
|
Packit |
0bf95d |
$sourcedir =~ s|\\|/|g;
|
|
Packit |
0bf95d |
$zippath =~ s|\\|/|g if defined($zippath);
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
# find files
|
|
Packit |
0bf95d |
#
|
|
Packit |
0bf95d |
my @files;
|
|
Packit |
0bf95d |
cwd $sourcedir;
|
|
Packit |
0bf95d |
find(\&listFiles, $sourcedir);
|
|
Packit |
0bf95d |
printf STDERR "Found %d file(s)\n", scalar @files;
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
# exit ?
|
|
Packit |
0bf95d |
#
|
|
Packit |
0bf95d |
exit if $query;
|
|
Packit |
0bf95d |
exit if @files <= 0;
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
# prepare zip directory
|
|
Packit |
0bf95d |
#
|
|
Packit |
0bf95d |
if (defined($zippath)) {
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
# deduce directory from zip path
|
|
Packit |
0bf95d |
$zipdir = dirname($zippath);
|
|
Packit |
0bf95d |
$zipdir = '.' unless length $zipdir;
|
|
Packit |
0bf95d |
} else {
|
|
Packit |
0bf95d |
$zipdir = $defaultzipdir;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
# make sure that zip directory exists
|
|
Packit |
0bf95d |
#
|
|
Packit |
0bf95d |
mkpath $zipdir unless -d $zipdir;
|
|
Packit |
0bf95d |
-d $zipdir or die "Can't find/make directory $zipdir\n";
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
# create the zip object
|
|
Packit |
0bf95d |
#
|
|
Packit |
0bf95d |
my $zip = Archive::Zip->new();
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
# read-in the existing zip file if any
|
|
Packit |
0bf95d |
#
|
|
Packit |
0bf95d |
if (defined $zippath && -f $zippath) {
|
|
Packit |
0bf95d |
my $status = $zip->read($zippath);
|
|
Packit |
0bf95d |
warn "Read $zippath failed\n" if $status != AZ_OK;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
# add files
|
|
Packit |
0bf95d |
#
|
|
Packit |
0bf95d |
foreach my $memberName (@files) {
|
|
Packit |
0bf95d |
if (-d $memberName) {
|
|
Packit |
0bf95d |
warn "Can't add tree $memberName\n"
|
|
Packit |
0bf95d |
if $zip->addTree($memberName, $memberName) != AZ_OK;
|
|
Packit |
0bf95d |
} else {
|
|
Packit |
0bf95d |
$zip->addFile($memberName)
|
|
Packit |
0bf95d |
or warn "Can't add file $memberName\n";
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
# prepare the new zip path
|
|
Packit |
0bf95d |
#
|
|
Packit |
0bf95d |
my $newzipfile = genfilename();
|
|
Packit |
0bf95d |
my $newzippath = "$zipdir/$newzipfile";
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
# write the new zip file
|
|
Packit |
0bf95d |
#
|
|
Packit |
0bf95d |
my $status = $zip->writeToFileNamed($newzippath);
|
|
Packit |
0bf95d |
if ($status == AZ_OK) {
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
# rename (and overwrite the old zip file if any)?
|
|
Packit |
0bf95d |
#
|
|
Packit |
0bf95d |
if (defined $zippath) {
|
|
Packit |
0bf95d |
my $res = rename $newzippath, $zippath;
|
|
Packit |
0bf95d |
if ($res) {
|
|
Packit |
0bf95d |
print STDERR "Updated file $zippath\n";
|
|
Packit |
0bf95d |
} else {
|
|
Packit |
0bf95d |
print STDERR
|
|
Packit |
0bf95d |
"Created file $newzippath, failed to rename to $zippath\n";
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
} else {
|
|
Packit |
0bf95d |
print STDERR "Created file $newzippath\n";
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
} else {
|
|
Packit |
0bf95d |
print STDERR "Failed to create file $newzippath\n";
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
# subroutines
|
|
Packit |
0bf95d |
#
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
sub listFiles {
|
|
Packit |
0bf95d |
if (/\.($extensions)$/) {
|
|
Packit |
0bf95d |
cwd $File::Find::dir;
|
|
Packit |
0bf95d |
return if -d $File::Find::name; # skip directories
|
|
Packit |
0bf95d |
my $fileagedays = fileAgeDays($_);
|
|
Packit |
0bf95d |
if ($fileagedays < $maxFileAgeDays) {
|
|
Packit |
0bf95d |
printf STDERR "$File::Find::name (%.3g)\n", $fileagedays;
|
|
Packit |
0bf95d |
(my $filename = $File::Find::name) =~
|
|
Packit |
0bf95d |
s/^[a-zA-Z]://; # remove the leading drive letter:
|
|
Packit |
0bf95d |
push @files, $filename;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
sub errorExit {
|
|
Packit |
0bf95d |
printf STDERR "*** %s ***\n$usage\n", shift;
|
|
Packit |
0bf95d |
exit;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
sub mtime {
|
|
Packit |
0bf95d |
(stat shift)[9];
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
sub fileAgeDays {
|
|
Packit |
0bf95d |
(time() - mtime(shift)) / 86400;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
sub genfilename {
|
|
Packit |
0bf95d |
my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) =
|
|
Packit |
0bf95d |
localtime(time);
|
|
Packit |
0bf95d |
sprintf "%04d%02d%02d-%02d%02d%02d.zip", $year + 1900, $mon + 1, $mday,
|
|
Packit |
0bf95d |
$hour, $min, $sec;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
__END__
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
=head1 NAME
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
ziprecent.pl
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
=head1 SYNOPSIS
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
ziprecent h:/myperl
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
ziprecent h:/myperl -e pl pm -d 365
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
ziprecent h:/myperl -q
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
ziprecent h:/myperl h:/temp/zip/file1.zip
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
=head1 DESCRIPTION
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
This script helps to collect recently modified files in a source directory
|
|
Packit |
0bf95d |
into a zip file (new or existing).
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
It uses Archive::Zip.
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
=over 4
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
=item C< ziprecent h:/myperl >
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
Lists and zips all files more recent than 1 day (24 hours)
|
|
Packit |
0bf95d |
in directory h:/myperl and it's subdirectories,
|
|
Packit |
0bf95d |
and places the zip file into default zip directory.
|
|
Packit |
0bf95d |
The generated zip file name is based on local time (e.g. 20001208-231237.zip).
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
=item C< ziprecent h:/myperl -e pl pm -d 365 >
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
Zips only .pl and .pm files more recent than one year.
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
=item C< ziprecent h:/myperl -msvc >
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
Zips source files found in a typical MSVC project.
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
=item C< ziprecent h:/myperl -q >
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
Lists files that should be zipped.
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
=item C< ziprecent h:/myperl h:/temp/zip/file1.zip >
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
Updates file named h:/temp/zip/file1.zip
|
|
Packit |
0bf95d |
(overwrites an existing file if writable).
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
=item C< ziprecent -h >
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
Prints the help text and exits.
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
ziprecent.pl <dir> -d <days> [-e <ext> ...]> [-h] [-msvc] [-q] [<zippath>]
|
|
Packit |
0bf95d |
Zips files in source directory and its subdirectories
|
|
Packit |
0bf95d |
whose file extension is in specified extensions (default: any extension).
|
|
Packit |
0bf95d |
-d <days> max age (days) for files to be zipped (default: 1 day)
|
|
Packit |
0bf95d |
<dir> source directory
|
|
Packit |
0bf95d |
-e <ext> one or more space-separated extensions
|
|
Packit |
0bf95d |
-h print help text and exit
|
|
Packit |
0bf95d |
-msvc may be given instead of -e and will zip all msvc source files
|
|
Packit |
0bf95d |
-q query only (list files but don't zip)
|
|
Packit |
0bf95d |
<zippath>.zip path to zipfile to be created (or updated if it exists)
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
=back
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
=head1 BUGS
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
Tested only on Win2k.
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
Does not handle filenames without extension.
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
Does not accept more than one source directory (workaround: invoke separately
|
|
Packit |
0bf95d |
for each directory, specifying the same zip file).
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
=head1 AUTHOR
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
Rudi Farkas rudif@lecroy.com rudif@bluemail.ch
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
=head1 SEE ALSO
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
perl ;-)
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
=cut
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
|