Perl script to archive then copy files from one location to another.

Created: 2 December 2005  Modified:

Originally published on chrislynch.info website.


use Archive::Zip qw( :ERROR_CODES :CONSTANTS );
use File::Copy;

sub recurseDirectories($$$);   
sub zipFile($);
sub zipDirectory($);
sub copyFile($);
sub fixFile($);
sub createDirectory($);

########################subroutine references
my $zipFileRef = *zipFile{CODE};
my $zipDirectoryRef = *zipDirectory{CODE};
my $copyFileRef = *copyFile{CODE};
my $fixFileRef = *fixFile{CODE};
my $createDirectoryRef = *createDirectory{CODE};

#####################array of text replacements
my @replaceArray;
my @pairArray = ("d:\\\\work\\\\perfectrecall.info","d:\\work\\prtest");
$replaceArray[0] = $pairArray;


###############################################
my $zipDirectory = 'd:/work/perfectrecall.info';
my $copyDirectory = 'd:/work/prtest';
my $directory = 'd:/work';
my $zip = Archive::Zip->new();
my $menmber;
my @fileTime = localtime(time());
my $timeMarker = sprintf "%4d%02d%02d%02d",($fileTime[5] + 1900) ,$fileTime[4],$fileTime[3],$fileTime[2];

print "\nZip source directory:  " . $zipDirectory . "\n";
recurseDirectories($zipDirectory,$zipFileRef,$zipDirectoryRef);
die 'write error' unless $zip->writeToFileNamed( $directory . "/www.perfectrecall.info.from.laptop.$timeMarker.zip" ) == AZ_OK;

$zip = Archive::Zip->new();
print "\nZip target directory:  " . $copyDirectory . "\n";
recurseDirectories($copyDirectory,$zipFileRef,$zipDirectoryRef);
die 'write error' unless $zip->writeToFileNamed( $directory . "/www.perfectrecall.info.to.desktop.$timeMarker.zip" ) == AZ_OK;

print "\nCopy source directory:  " . $zipDirectory . "\n";
recurseDirectories($zipDirectory,$copyFileRef,$createDirectoryRef);


##################add file to zip archive
sub zipFile($) {
  my $source = $_[0];
  my $target = $source;
  $target =~ s/$zipDirectory//;
  $target =~ s/\\/\//g;
  my $member = $zip->addFile( $source, $target);  
}

##################add file to zip archive
sub zipDirectory($) {
  null;

}


##################replace text in file for new location
sub fixFile($) {
  my $source = $_[0];
  my $target = $source;
  my $file = new IO::File;
  my $i;
  $file->open("<" . $source) or die "fixFile: Could not open file $source";
  ############get stats
  $source =~ s/\//\\/g;
  my @stats = stat($source);
  my $content;
  $file->read($content,$stats[7]);
  $file->close();
  for($i=0;$i <= $#replaceArray;$i++) {
    $pairArray = $replaceArray[$i];
    print "find:  " . $pairArray[0] ."\n";    
    print "place:  " . $pairArray[1] ."\n";    
    $content =~ s/$pairArray[0]/$pairArray[1]/gi;
  }
  $target =~ s/$zipDirectory/$copyDirectory/;
  $file->open(">" . $target) or die "fixFile: Could not open file $source";
  $file->write($content,length($content));
  $file->close();  
}
#######################copy file
sub copyFile($) {
  my $source = $_[0];
  my $target = $source;
  $target =~ s/$zipDirectory/$copyDirectory/;
  if($source =~ m/\.prj$|\.config$/i) {
    fixFile($source);
  } else {
    copy($source,$target);
  }
}
#######################create directory
sub createDirectory($) {
  my $source = $_[0];
  my $target = $source;
  $target =~ s/$zipDirectory/$copyDirectory/;
  mkdir $target;
}



#########define subroutines
sub recurseDirectories($$$) {
  my $directory;
  my $fileCount;
  my $i;
  my @thefiles;
  my $IMD;
  my $filehandle;
  my $writedir;
  my $curdir;
  my $fileextension;
  my $key;
  my $fileFunction;
  my $directoryFunction;
  
  #get directory parameter
  $directory = @_[0];
  $fileFunction = @_[1];
  $directoryFunction = @_[2];
  #get directory contents
  opendir(IMD, $directory) || die("Cannot open directory: $directory" );
	@thefiles= grep(!/^\.$|^\.\.$/,readdir(IMD));
	closedir(IMD);
  #########change to the write directore
  chdir $directory;
  #loop through directory contents
  $fileCount = $#thefiles + 1;
  $directoryCount = 0;

  ########loop through files
  for($i=0;$i < $fileCount;$i++) {
    ##################found a directory
#    print $directory. "/" . $thefiles[$i] . "\n";
    if(-d $directory. "/" . $thefiles[$i]) {
      
      ############add to zip file
      &$directoryFunction($directory. "/" . $thefiles[$i]);
      
      ###########recursive call
      recurseDirectories($directory. "\\" . $thefiles[$i],$fileFunction,$directoryFunction);
    } else {

      ############referenced function
      &$fileFunction($directory. "/" . $thefiles[$i]);
    }
  }
}
tags: blog - old blog - Perl
   Memory is Fleeting