path: root/examples/ziprecent.pl

#!/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