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