Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?

Re: Archive::Zip Compaitibility Issues??

by Rudif (Hermit)
on Dec 17, 2008 at 22:12 UTC ( #731080=note: print w/replies, xml ) Need Help??

in reply to Archive::Zip Compaitibility Issues??

Hello Commy_Code_Monkey

I have a command line script named, reproduced below. It uses Archive::Zip and a few other modules, all part of Active State Perl, or available via ppm.

It works nicely for me with 5.10 as it did for 5.8 and with earlier Perl builds.
Does it work for you ?
If yes, perhaps you will find out what you are doing differently, by comparing your script with mine.
If not, perhaps there is a problem with your perl installation.



#! perl -w # 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 extensio +n). -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 conv +erted 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 s +ource files -n <nick> file nickname will be added to the date-time strin +g 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 ex +ists) 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/_home +work/, 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 ext +ension $extensions = 'any' if $extensions eq ''; # process arguments { errorExit("Please specify an existing source directory") unless @s +ourcedirs > 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 t +o $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 "", $year + 1900, $mon + +1, $mday, $hour, $min, $sec, $nickname; } __END__ =head1 NAME =head1 SYNOPSIS ziprecent h:/myperl ziprecent h:/myperl -e pl pm -d 365 ziprecent h:/myperl -q ziprecent h:/myperl h:/temp/zip/ ziprecent -c 12345 =head1 DESCRIPTION =over 4 This script helps to collect recently modified files in a source direc +tory 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-2312 =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/ > Updates file named h:/temp/zip/ (overwrites an existing file if writable). =item C< ziprecent -h > Prints the help text and exits. <dir> -d <days> [-e <ext> ...]> [-h] [-msvc] [-q] [<zipp +ath>] Zips files in source directory and its subdirectories whose file extension is in specified extensions (default: any extensi +on). -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 s +ource files -q query only (list files but don't zip) <zippath>.zip path to zipfile to be created (or updated if it ex +ists) =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

Log In?

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://731080]
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others chilling in the Monastery: (5)
As of 2023-02-06 13:16 GMT
Find Nodes?
    Voting Booth?
    I prefer not to run the latest version of Perl because:

    Results (34 votes). Check out past polls.