jatoba has asked for the wisdom of the Perl Monks concerning the following question:

Hey Monks, I'm having trouble with the Archive::Zip module. (Code is below) As I recurse through a directory tree on a Win32 system, once the first .zip is created, the program kicks out to the next item in the list without finishing the recursion and testing the remaining subdirectories. Any ideas on how to get it to finish the recursion after creating the first zip file? Thanks.
use Time::localtime; use File::Find; use File::Path; use Win32::FileOp; use Getopt::Long; use Archive::Zip qw( :ERROR_CODES :CONSTANTS ); #Get the command line options from the user # # compress: age (in days) of files/dirs to archive # purge: age (in days) of files/dirs in archive location to delete # output: archive location to store zip files in # dirlist: text file containin list of dirs/files to evaluate # GetOptions( "compress=i" => \$compress, "purge=i" => \$purge, "output=s" => \$output, "dirlist=s" => \$dirlist); #Open the input list open CONFIG, "$dirlist" or die "Can't open config file: $!\n"; #For each entry in the input file, execute loop while ( $line = <CONFIG>) { #Remove newline character at end of line chomp($line); #Search dir tree and run &archiveFiles on each entry find(\&archiveFiles, $line); } #Search archive location and run &purgeArchive on each entry find(\&purgeArchive, $output); #Close the input filehandle close(CONFIG); ######################################################## # Subroutine to search dir tree and evaluate dirs/files # to determine if they are old enough to archive. # sub archiveFiles { #Get the next item in the tree $file_name = $File::Find::name; #Translate any '/' to '\' for Win32 $file_name =~ s(\/)(\\); #If the entry is a directory if( -d $file_name ) { $count = (-M $file_name); print "$file_name is $count days old\n"; #Get the local time, and then format it into YYYYMMDDhhmmss $tm = localtime; $timestamp = ($tm->year + 1900) . ($tm->mon + 1) . $tm->mday . + $tm->hour . $tm->min . $tm->sec; #Strip off the directory tree up to the filename $relative_path = substr($file_name, length($line), ); $relative_path =~ s(\/)(\\); #Add the archive directory to the front of the file name $archive_path = $output . "\\" . substr($file_name, 3, ); $archive_path =~ s(\/)(\\); #Now tack the timestamp computed above and .zip onto the end o +f the path #to give us our compressed file name in the archive. $archive_name = $archive_path . "\\" . $timestamp . ".zip"; $archive_name =~ s(\/)(\\); #If the age of the directory is older than our user defined th +reshold if( -M $file_name >= $compress ) { #Create a new zip file buffer my $zip = Archive::Zip->new(); #Recursively add the directory to the zip file $zip->addTree($file_name, $relative_path); #If the destination directory doesn't exist, create it. if(! -e $archive_path ) { mkpath($archive_path) or die "Can't create dir $archiv +e_path: $!\n"; } #Now that the zip file is created, write the buffer out to + our #destination file. unless ( $zip->writeToFileNamed( $archive_name ) == AZ_OK +) { die 'write error'; } #After creating the archive, delete the original directory + tree #to save disk space. Delete($file_name); } #Sleep for 1 second. This is done to make sure that no timest +amp #computed above is identical to the one before. That way, we #prevent duplicate file names, and zip contents from being ove +rwritten. sleep(1); } #If the current item in the list is a file if(-f $line) { #If the file is older than the user defined threshold if( -M $file_name >= $compress ) { #Get the local time, and then format it into YYYYMMDDhhmms +s $tm = localtime; $timestamp = ($tm->year + 1900) . ($tm->mon + 1) . $tm->md +ay . $tm->hour . $tm->min . $tm->sec; #Strip off the directory tree up to the filename $relative_path = substr($file_name, length($line), ); $relative_path =~ s(\/)(\\); #Add the archive directory to the front of the file name $archive_path = $output . "\\" . substr($file_name, 3, ); $archive_path =~ s(\/)(\\); #Now tack the timestamp computed above and .zip onto the e +nd of the path #to give us our compressed file name in the archive. $archive_name = $archive_path . "\\" . $timestamp . ".zip" +; $archive_name =~ s(\/)(\\); #Create a new zip file buffer my $zip = Archive::Zip->new(); #Add the file to the zip file $zip->addFile( $file_name ); #If the destination directory doesn't exist, create it if(! -e $archive_path ) { mkpath($archive_path) or die "Can't create dir $archiv +e_path: $!\n"; } #Now that the zip file is created, write the buffer out to + our #destination file. unless ( $zip->writeToFileNamed( $archive_name ) == AZ_OK +) { die 'write error'; } #After creating the archive, delete the original file #to save disk space. Delete($file_name); } } } ###################################################################### +### # # Subroutine to search the archive location and permanently delete fil +es # older than 'purge' threshold # sub purgeArchive { #Get the next file in the list $purge_name = $File::Find::name; #Translate any '/' to '\' for Win32 $purge_name =~ s(\/)(\\); #If the file is older than the user defined threshold if( -M $purge_name >= $purge ) { #If the entry is NOT a directory, the delete it. if( ! -d $purge_name ) { print "$purge_name will be purged\n"; Delete($purge_name); } } }

Replies are listed 'Best First'.
Re: Archive::Zip problem
by kyle (Abbot) on Dec 27, 2006 at 21:45 UTC

    I think this might be your problem:

    #Translate any '/' to '\' for Win32 $file_name =~ s(\/)(\\);

    Your translation (why is it s instead of tr?) is only going to get one slash, not them all. You need the 'g' modifier.

    The code above might be rewritten this way:

    #Translate any '/' to '\' for Win32 $file_name =~ s(\/)(\\)g;

    I stopped reading when I saw that, so if that's not the problem, let us know. Maybe I'll read further.

      Forgetting the 'g' was an oversight. I corrected and tried again with the same result. The recursion works correctly when I comment out the Archive::Zip code. It only fails when I add the zip code back in.
Re: Archive::Zip problem
by kyle (Abbot) on Dec 28, 2006 at 05:28 UTC

    Archive::Zip::addTree calls File::Find::find, which probably clobbers the find you're doing. I don't see anything in the Archive::Zip code to accommodate an already running find, so if File::Find doesn't have it (I haven't checked, but I doubt it does), that's the problem.

    What you'd need to do is avoid calling anything in Archive::Zip while you're still in the middle of your own find. That means using find to build a list of things you want to operate on, and then doing the Archive::Zip work with them after your find is done.

      I think your (kyle's) concern with recursive calls to File::Find does not apply anymore (since 5.8). In the section HISTORY, we read:

      File::Find used to produce incorrect results if called recursively. During the development of perl 5.8 this bug was fixed. The first fixed version of File::Find was 1.01.
      That makes sense. I'll resctructure the code and give it a try. Thanks for the help.