#! perl -w
# ziprecent.pl

use strict;

use Archive::Zip qw(:ERROR_CODES :CONSTANTS);
use Cwd;
use File::Basename;
use File::Copy;
use File::Find;
use File::Path;
use File::Slurp;

our $VERSION = '0.02';

# argument and variable defaults
my $maxFileAgeDays = 1;
my $defaultzipdir  = 'h:\zip\_homework';
my ( @sourcedirs, $zipdir, $zippath, @extensions, $query, $nick );
my @files;

# 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 ...>       one or more source directories
                    (directories starting with . are accepted and converted to absolute path)
    -e <ext>        one or more space-separated extensions (leave out this option to zip all files)
    -h              print help text and exit
    -msvc           may be given instead of -e and will zip all msvc source files
    -n <nick>       file nickname will be added to the date-time string name
    -q              query only (list files but don't zip)
    -z <zipdir>     zip destination directory (default $defaultzipdir)
    <zippath>.zip   path to zipfile to be created (or updated if it exists)
The zip file will be created in directory $defaultzipdir, unless full path to zip file or option -z was given.
The zip file name will be the date-time string similar to h:/zip/_homework/20020831-221955.zip,
with optional nickname inserted before .zip.
ENDUSAGE

#print STDERR "@ARGV\n";
#hangOn(10);

# parse arguments
my @msvcextensions = qw / bmp c cpp def dlg dsp dsw h ico idl mak odl rc rc2 rgs sln vcproj /;
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] ) {
            last if $ARGV[0] =~ /^-/;    # an option
            last if -d $ARGV[0];         # a directory
            push @extensions, shift;
        }
    }
    elsif ( $arg eq '-h' ) {
        print STDERR $usage;
        exit;
    }
    elsif ( $arg eq '-msvc' ) {
        push @extensions, @msvcextensions;
    }
    elsif ( $arg eq '-n' ) {
        $nick = shift;
    }
    elsif ( $arg eq '-q' ) {
        $query = 1;
    }
    elsif ( -d $arg ) {

        # if dir starts with . convert to absolute path
        push @sourcedirs, Cwd::abs_path($arg);
    }
    elsif ( $arg eq '-z' ) {
        if ( $ARGV[0] ) {
            $zipdir = shift;
        }
    }
    elsif ( $arg =~ /\w+\.zip$/ ) {
        $zippath = $arg;
    }
    else {
        errorExit("Unknown option or argument: $arg");
    }
}


my $extensions = join "|", @extensions; # if empty, will match any extension 
$extensions = 'any' if $extensions eq '';


# process arguments
{
    errorExit("Please specify an existing source directory") unless @sourcedirs > 0;

    print STDERR "Looking for files in @sourcedirs,\n";
    print STDERR "matching extensions : $extensions.\n";

    # change '\' to '/' (avoids trouble in substitution on Win2k)
    s|\\|/|g foreach @sourcedirs;

    # find files
    #my @files;
    foreach my $dir (@sourcedirs) {
        cwd $dir;
        find( \&listFiles, $dir );
    }
}

$zippath =~ s|\\|/|g if defined($zippath);

#printf STDERR "=== $zippath\n";

# remove the leading drive letter if any
s|^[a-z]\:||i foreach @files;

# for info ...
my $nfiles = @files;
printf STDERR join "\n", @files, "\n";
printf STDERR "Found %d file%s\n", $nfiles, $nfiles == 1 ? '' : 's';
print STDERR "in source directories @sourcedirs\n";

# exit ?
if ($query) {
    exit;
}

# create zip file name
my $newzipfile = genfilename( $nick );


if ( @files <= 0 ) {
    slowExit( "no files found", 10 );
}

# prepare zip directory
if ( defined($zippath) ) {

    # deduce directory from zip path
    $zipdir = dirname($zippath);
    $zipdir = '.' unless length $zipdir;
}
elsif ( defined $zipdir && -d $zipdir ) {
    printf STDERR "no such directory $zipdir\n";
    undef $zipdir;
}

$zipdir = $defaultzipdir unless defined $zipdir;

# make sure that zip directory exists
mkpath $zipdir unless -d $zipdir;
-d $zipdir or errorExit("Can't find or make directory $zipdir");

# 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 $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";
}

hangOn(5);

exit 0;

# subroutines

sub listFiles {
    return if -d $File::Find::name;    # skip directories
    if ($extensions eq 'any' || /\.($extensions)$/i) {
        cwd $File::Find::dir;
        my $fileagedays = fileAgeDays($_);
        if ( $fileagedays < $maxFileAgeDays ) {
            ( my $filename = $File::Find::name ) =~ s/^[a-zA-Z]://;    # remove the leading drive letter:
			$filename =~ s!/!\\!g;
            push @files, $filename;
        }
    }
}

sub errorExit {
    my $message = shift;
    slowExit( "*** $message ***\n$usage", 10 );
}

sub slowExit {
    my $message = shift;
    my $seconds = shift;
    print STDERR "$message\n";
    hangOn($seconds);    # give the user of embedded script  chance to read the message
    exit;
}

sub hangOn {
    my $seconds = shift;
    for ( my $i = 0 ; $i < $seconds ; ++$i ) {
        printf STDERR "%s\r", '.' x ( $seconds - $i ) . ' ' x $i;
        sleep(1);
    }
}

sub mtime {
    ( stat shift )[9];
}

sub fileAgeDays {
    ( time() - mtime(shift) ) / 86400;
}

sub genfilename {
    my $nick = shift || '';
    my $nickname = $nick ? "-$nick" : '';

    my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) = localtime(time);
    sprintf "%04d%02d%02d-%02d%02d%02d%s%s.zip", $year + 1900, $mon + 1, $mday, $hour, $min, $sec, $nickname;
}

__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 

  ziprecent -c 12345
 

=head1 DESCRIPTION

=over 4

This script helps to collect recently modified files in a source directory 
into a zip file (new or existing).

It uses Archive::Zip.

=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 on Win2k WinXP Vista

Does not handle filenames without extension.

=head1 AUTHOR

Rudi punct1 Farkas  punct2 gmail punct1 com

=head1 SEE ALSO

perl

=cut