git.maemo.org Git - dh-make-perl/blob - dev/i386/libarchive-zip-perl/libarchive-zip-perl-1.18/examples/ziprecent.pl

   1 #!/usr/bin/perl -w
   2 # Makes a zip file of the most recent files in a specified directory.
   3 # By Rudi Farkas, rudif@bluemail.ch, 9 December 2000
   4 # Usage:
   5 # ziprecent <dir> -d <ageDays> [-e <ext> ...]> [-h] [-msvc] [-q] [<zippath>]
   6 # Zips files in source directory and its subdirectories
   7 # whose file extension is in specified extensions (default: any extension).
   8 #     -d <days>       max age (days) for files to be zipped (default: 1 day)
   9 #     <dir>           source directory
  10 #     -e <ext>        one or more space-separated extensions
  11 #     -h              print help text and exit
  12 #     -msvc           may be given instead of -e and will zip all msvc source files
  13 #     -q              query only (list files but don't zip)
  14 #     <zippath>.zip   path to zipfile to be created (or updated if it exists)
  15 #
  16 # $Revision: 1.2 $
  17
  18 use strict;
  19
  20 use Archive::Zip qw(:ERROR_CODES :CONSTANTS);
  21 use Cwd;
  22 use File::Basename;
  23 use File::Copy;
  24 use File::Find;
  25 use File::Path;
  26
  27 # argument and variable defaults
  28 #
  29 my $maxFileAgeDays = 1;
  30 my $defaultzipdir = 'h:/zip/_homework';
  31 my ($sourcedir, $zipdir, $zippath, @extensions, $query);
  32
  33
  34 # usage
  35 #
  36 my $scriptname = basename $0;
  37 my $usage = <<ENDUSAGE;
  38 $scriptname <dir> -d <ageDays> [-e <ext> ...]> [-h] [-msvc] [-q] [<zippath>]
  39 Zips files in source directory and its subdirectories
  40 whose file extension is in specified extensions (default: any extension).
  41     -d <days>       max age (days) for files to be zipped (default: 1 day)
  42     <dir>           source directory
  43     -e <ext>        one or more space-separated extensions
  44     -h              print help text and exit
  45     -msvc           may be given instead of -e and will zip all msvc source files
  46     -q              query only (list files but don't zip)
  47     <zippath>.zip   path to zipfile to be created (or updated if it exists)
  48 ENDUSAGE
  49
  50
  51 # parse arguments
  52 #
  53 while (@ARGV) {
  54     my $arg = shift;
  55
  56     if ($arg eq '-d') {
  57         $maxFileAgeDays = shift;
  58         $maxFileAgeDays = 0.0 if $maxFileAgeDays < 0.0;
  59     }
  60     elsif ($arg eq '-e') {
  61         while ($ARGV[0] && $ARGV[0] !~ /^-/) {
  62             push @extensions, shift;
  63         }
  64     }
  65     elsif ($arg eq '-msvc') {
  66         push @extensions, qw / bmp c cpp def dlg dsp dsw h ico idl mak odl rc rc2 rgs /;
  67     }
  68     elsif ($arg eq '-q') {
  69         $query = 1;
  70     }
  71     elsif ($arg eq '-h') {
  72         print STDERR $usage;
  73         exit;
  74     }
  75     elsif (-d $arg) {
  76         $sourcedir = $arg;
  77     }
  78     elsif ($arg eq '-z') {
  79         if ($ARGV[0]) {
  80             $zipdir = shift;
  81         }
  82     }
  83     elsif ($arg =~ /\.zip$/) {
  84         $zippath = $arg;
  85     }
  86     else {
  87         errorExit("Unknown option or argument: $arg");
  88     }
  89 }
  90
  91 # process arguments
  92 #
  93 errorExit("Please specify an existing source directory") unless defined($sourcedir) && -d $sourcedir;
  94
  95 my $extensions;
  96 if (@extensions) {
  97     $extensions = join "|", @extensions;
  98 }
  99 else {
 100     $extensions = ".*";
 101 }
 102
 103 # change '\' to '/' (avoids trouble in substitution on Win2k)
 104 #
 105 $sourcedir =~ s|\\|/|g;
 106 $zippath =~ s|\\|/|g if defined($zippath);
 107
 108
 109 # find files
 110 #
 111 my @files;
 112 cwd $sourcedir;
 113 find(\&listFiles, $sourcedir);
 114 printf STDERR "Found %d file(s)\n", scalar @files;
 115
 116
 117 # exit ?
 118 #
 119 exit if $query;
 120 exit if @files <= 0;
 121
 122
 123 # prepare zip directory
 124 #
 125 if (defined($zippath)) {
 126     # deduce directory from zip path
 127     $zipdir = dirname($zippath);
 128     $zipdir = '.' unless length $zipdir;
 129 }
 130 else {
 131     $zipdir= $defaultzipdir;
 132 }
 133
 134 # make sure that zip directory exists
 135 #
 136 mkpath $zipdir unless -d $zipdir;
 137 -d $zipdir or die "Can't find/make directory $zipdir\n";
 138
 139
 140
 141 # create the zip object
 142 #
 143 my $zip = Archive::Zip->new();
 144
 145
 146 # read-in the existing zip file if any
 147 #
 148 if (defined $zippath && -f $zippath) {
 149     my $status = $zip->read($zippath);
 150     warn "Read $zippath failed\n" if $status != AZ_OK;
 151 }
 152
 153 # add files
 154 #
 155 foreach my $memberName (@files)
 156 {
 157     if (-d $memberName )
 158     {
 159         warn "Can't add tree $memberName\n"
 160             if $zip->addTree( $memberName, $memberName ) != AZ_OK;
 161     }
 162     else
 163     {
 164         $zip->addFile( $memberName )
 165             or warn "Can't add file $memberName\n";
 166     }
 167 }
 168
 169
 170 # prepare the new zip path
 171 #
 172 my $newzipfile = genfilename();
 173 my $newzippath = "$zipdir/$newzipfile";
 174
 175
 176 # write the new zip file
 177 #
 178 my $status = $zip->writeToFileNamed($newzippath);
 179 if ($status == AZ_OK) {
 180     # rename (and overwrite the old zip file if any)?
 181     #
 182     if (defined $zippath) {
 183         my $res = rename $newzippath, $zippath;
 184         if ($res) {
 185             print STDERR "Updated file $zippath\n";
 186         }
 187         else {
 188             print STDERR "Created file $newzippath, failed to rename to $zippath\n";
 189         }
 190     }
 191     else {
 192         print STDERR "Created file $newzippath\n";
 193     }
 194 }
 195 else {
 196     print STDERR "Failed to create file $newzippath\n";
 197 }
 198
 199
 200
 201 # subroutines
 202 #
 203
 204 sub listFiles {
 205     if (/\.($extensions)$/) {
 206         cwd $File::Find::dir;
 207         return if -d $File::Find::name; # skip directories
 208         my $fileagedays = fileAgeDays($_);
 209         if ($fileagedays < $maxFileAgeDays) {
 210             printf STDERR "$File::Find::name    (%.3g)\n", $fileagedays;
 211             (my $filename = $File::Find::name) =~ s/^[a-zA-Z]://;  # remove the leading drive letter:
 212             push @files, $filename;
 213         }
 214     }
 215 }
 216
 217 sub errorExit {
 218     printf STDERR "*** %s ***\n$usage\n", shift;
 219     exit;
 220 }
 221
 222 sub mtime {
 223     (stat shift)[9];
 224 }
 225
 226 sub fileAgeDays {
 227     (time() - mtime(shift)) / 86400;
 228 }
 229
 230 sub genfilename {
 231     my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
 232     sprintf "%04d%02d%02d-%02d%02d%02d.zip", $year+1900, $mon+1, $mday, $hour, $min, $sec;
 233 }
 234
 235 __END__
 236
 237 =head1 NAME
 238
 239 ziprecent.pl
 240
 241 =head1 SYNOPSIS
 242
 243   ziprecent h:/myperl
 244
 245   ziprecent h:/myperl -e pl pm -d 365
 246
 247   ziprecent h:/myperl -q
 248
 249   ziprecent h:/myperl h:/temp/zip/file1.zip
 250
 251
 252 =head1 DESCRIPTION
 253
 254 =over 4
 255
 256 This script helps to collect recently modified files in a source directory
 257 into a zip file (new or existing).
 258
 259 It uses Archive::Zip.
 260
 261 =item C<  ziprecent h:/myperl  >
 262
 263 Lists and zips all files more recent than 1 day (24 hours)
 264 in directory h:/myperl and it's subdirectories,
 265 and places the zip file into default zip directory.
 266 The generated zip file name is based on local time (e.g. 20001208-231237.zip).
 267
 268
 269 =item C<  ziprecent h:/myperl -e pl pm -d 365  >
 270
 271 Zips only .pl and .pm files more recent than one year.
 272
 273
 274 =item C<  ziprecent h:/myperl -msvc  >
 275
 276 Zips source files found in a typical MSVC project.
 277
 278
 279 =item C<  ziprecent h:/myperl -q  >
 280
 281 Lists files that should be zipped.
 282
 283
 284 =item C<  ziprecent h:/myperl h:/temp/zip/file1.zip  >
 285
 286 Updates file named h:/temp/zip/file1.zip
 287 (overwrites an existing file if writable).
 288
 289
 290 =item C<  ziprecent -h  >
 291
 292 Prints the help text and exits.
 293
 294  ziprecent.pl <dir> -d <days> [-e <ext> ...]> [-h] [-msvc] [-q] [<zippath>]
 295  Zips files in source directory and its subdirectories
 296  whose file extension is in specified extensions (default: any extension).
 297     -d <days>       max age (days) for files to be zipped (default: 1 day)
 298     <dir>           source directory
 299     -e <ext>        one or more space-separated extensions
 300     -h              print help text and exit
 301     -msvc           may be given instead of -e and will zip all msvc source files
 302     -q              query only (list files but don't zip)
 303     <zippath>.zip   path to zipfile to be created (or updated if it exists)
 304
 305 =back
 306
 307
 308 =head1 BUGS
 309
 310 Tested only on Win2k.
 311
 312 Does not handle filenames without extension.
 313
 314 Does not accept more than one source directory (workaround: invoke separately
 315 for each directory, specifying the same zip file).
 316
 317
 318 =head1 AUTHOR
 319
 320 Rudi Farkas rudif@lecroy.com rudif@bluemail.ch
 321
 322 =head1 SEE ALSO
 323
 324 perl ;-)
 325
 326 =cut
 327
 328
 329