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]);
}
}
}