Perl script for moving files between (sub)directories
This script transfers files from one subdirectory to another.
When it copies a file from a source subdirectory to a destination
subdirectory, it deletes the file on the source subdirectory.
It prompts the user for the pathname of the source and destination
subdirectories, and it permits the user to enter a Regex expression
describing the file types that should be transferred. If you bypass
the prompt asking for a Regex expression, it will transfer all
types of files.
#!/usr/local/bin/perl
#This Perl script was created by Jules J. Berman, on 9/23/10
#Disclaimer:
#The software is provided "as is", without warranty of any kind,
#express or implied, including but not limited to the warranties
#of merchantability, fitness for a particular purpose and
#noninfringement. in no event shall the authors or copyright
#holders be liable for any claim, damages or other liability,
#whether in an action of contract, tort or otherwise, arising
#from, out of or in connection with the software or the use or
#other dealings in the software.
print "This script transfers files from one subdirectory to another.\n";
print "When it copies a file from a source subdirectory to a destination\n";
print "subdirectory, it deletes the file on the source subdirectory.\n";
print "It prompts the user for the pathname of the source and destination\n";
print "subdirectories, and it permits the user to enter a Regex expression\n";
print "describing the file types that should be transferred. If you bypass\n";
print "the prompt asking for a Regex expression, it will transfer all\n";
print "types of files.\n\n\n";
use File::Copy;
use File::stat;
print "What (sub)directory would you like to copy from?\n";
print "Include the full path of the source (sub)directory.\n";
$from_dir = <STDIN>;
$from_dir =~ s/\n//o;
print "\nWhat (sub)directory would you like to copy to?\n";
print "Include the full path of to the destination (sub)directory.\n";
$to_dir = <STDIN>;
$to_dir =~ s/\n//o;
print "\nWhat regular expression for file types would you like\n";
print "to transfer? Or press enter-key for all files\.\n";
$regex = <STDIN>;
$regex =~ s/\n//o;
if ($regex eq "")
{
$regex = "\[a\-z0\-9\]\+";
}
opendir(FTPDIR, $to_dir) || die ("Unable to open directory");
@to_files = readdir(FTPDIR);
chdir($to_dir);
foreach my $to_filename (@to_files)
{
@statarray = stat($to_filename);
$to_file_time = $statarray[9];
$filehash{$to_filename} = $to_file_time;
}
closedir(FTPDIR);
opendir(FTPDIR, $from_dir) || die ("Unable to open directory");
@from_files = readdir(FTPDIR);
closedir(FTPDIR);
chdir($from_dir);
foreach my $from_filename (@from_files)
{
next if ($from_filename !~ /$regex/i);
next unless (-f($from_filename));
@statarray = stat($from_filename);
$from_file_time = $statarray[9];
$to_filename = $to_dir . "\\" . $from_filename;
if (exists($filehash{$from_filename}))
{
$filehash{$from_filename} = $file_time_in_to_directory;
if ($file_time_in_to_directory < $from_file_time)
{
copy($from_filename, $to_filename)||die"cannot";
print "File $from_filename was updated\n";
&delete($from_filename);
next;
}
if ($file_time_in_to_directory >= $from_file_time)
{
print("File $from_filename exists or is earlier than existing file\n");
&delete($from_filename);
next;
}
}
else
{
copy($from_filename, $to_filename)||die"cannot";
print "File $from_filename was copied\n";
&delete($from_filename);
next;
}
}
print "\nDone\n";
sub delete()
{
my $filename = @_[0];
$count = unlink($filename);
if ($count)
{
print("File $filename was deleted\n");
}
else
{
print "Couldn't delete file\n";
}
}
exit;