I'm using rcopy to move directories and it calls dircopy. It fails and $! is blank. Here is the code. I'm running this on Windows Server 2012 R2 Standard as the System user in a scheduled task.
use strict;
use warnings;
use File::Glob ':bsd_glob';
## This module is not included in ActiveState Perl so run this script
+with d:\portableperl\portableshell.bat.
use File::Copy::Recursive qw(rcopy);
#local $File::Copy::Recursive::SkipFlop = 1;
my $logfile = 'sync_study_to_prod_test.log';
open my $fh_log, ">", $logfile or die "Couldn't open $logfile for outp
+ut: $!\n";
print $fh_log "Ran at: ", scalar localtime, "\n";
print "Ran at: ", scalar localtime, "\n";
if( not defined $ENV{SERVER_ENVIRONMENT} or not $ENV{SERVER_ENVIRONMEN
+T} ) {
print $fh_log "Environment variable \"SERVER_ENVIRONMENT\" is requ
+ired to be set up. \n";
die "Environment variable \"SERVER_ENVIRONMENT\" is required to be
+ set up. \n";
}
while ( <DATA> ) {
chomp;
#skip blank lines
next if /^\s*$/;
my ($source,$destination) = split /\|/;
## trim whitespace at start or end of paths:
$source =~ s/^\s+//;
$destination =~ s/^\s+//;
$source =~ s/\s+$//;
$destination =~ s/\s+$//;
## Resolve environment variables
$source =~ s/\%(.+?)\%/$ENV{$1}/g;
$destination =~ s/\%(.+?)\%/$ENV{$1}/g;
## verify paths
if ( not -e $source ) {
print $fh_log "s-Warning: $source not found - skipping.\n";
next;
}
if ( not -e $destination ) {
print $fh_log "d-Warning: $destination not found - skipping.\n
+";
next;
}
clear_readonly_bit($source);
clear_readonly_bit($destination);
my ($num_of_files_and_dirs,$num_of_dirs,$depth_traversed) = rcopy
+( $source, $destination);
if($num_of_files_and_dirs == 0) {
print $fh_log "Error: Couldn't copy $source to $destination :
+$! -\n";
print $fh_log "--$num_of_files_and_dirs,$num_of_dirs,$depth_tr
+aversed\n";
next;
}
print $fh_log "****Copied $source to $destination\n ($num_of_fi
+les_and_dirs files and directories, $num_of_dirs directories, depth =
+ $depth_traversed)\n";
}
print $fh_log "Finished at: ", scalar localtime, "\n";
sub clear_readonly_bit {
my $folder = shift;
foreach my $file ( glob( "$folder/*" )) {
#print $fh_log "file: $file\n";
## test if not writable
if( not -w $file ){
print $fh_log "$file is read only.\n--Clearing read-only b
+it...\n";
## clear read only bit
my $cnt = chmod 0777, $file;
if( $cnt == 0){
print $fh_log "--Error-Couldn't clear read-only bit.\n
+";
}
}
if ( -d $file ) {
## clear ro bits in files in sub folders.
clear_readonly_bit($file);
}
}
}
__DATA__
D:\Eterra\Distribution\FileUpdaterServer\%SERVER_ENVIRONMENT%\Bitmaps
+| %IDMS_ROOT%\bitmaps
The result of running that is:
Ran at: Tue Jun 12 10:56:21 2018
Error: Couldn't copy D:\Eterra\Distribution\FileUpdaterServer\PROD\Bit
+maps to D:\Eterra\Distribution\XXXCorpXXX\bitmaps : -
--,,
Finished at: Tue Jun 12 10:56:22 2018
When I uncomment the line with SkipFlop it copies all but a few files. For the result below there was one file in the folder. I had narrowed down the files to find this one that won't copy.
Ran at: Tue Jun 12 10:51:56 2018
****Copied D:\Eterra\Distribution\FileUpdaterServer\PROD\Bitmaps to D:
+\Eterra\Distribution\XXXCorpXXX\bitmaps
(1 files and directories, 1 directories, depth = 1)
Finished at: Tue Jun 12 10:51:56 2018
I can't find anything wrong or different about the file it can't copy. When I put the files in the source and destination folders in test folders the script works without failing.
I can't find a verbose option for File::Copy::Recursive (version '0.38' on Strawberry Perl 5.24.1, portable) so I started looking through the module to possibly add some debugging lines in but I'm having trouble following what is going on. The sub here has if statements that do nothing. This sub seems to be used by the part that does the copying.
my $ok_todo_asper_condcopy = sub {
my $org = shift;
my $copy = 1;
if(exists $CondCopy->{$org}) {
if($CondCopy->{$org}{'md5'}) {
}
if($copy) {
}
}
return $copy;
};
This part takes me back to fcopy():
for my $file (@files) {
my ($file_ut) = $file =~ m{ (.*) }xms;
my $org = File::Spec->catfile($str, $file_ut);
my $new = File::Spec->catfile($end, $file_ut);
if( -l $org && $CopyLink ) {
carp "Copying a symlink ($org) whose target does not exi
+st"
if !-e readlink($org) && $BdTrgWrn;
symlink readlink($org), $new or return;
}
elsif(-d $org) {
$recurs->($org,$new,$buf) if defined $buf;
$recurs->($org,$new) if !defined $buf;
$filen++;
$dirn++;
}
else {
if($ok_todo_asper_condcopy->($org)) {
if($SkipFlop) {
fcopy($org,$new,$buf) or next if defined $buf;
fcopy($org,$new) or next if !defined $buf;
+
}
else {
fcopy($org,$new,$buf) or return if defined $buf;
fcopy($org,$new) or return if !defined $buf;
}
chmod scalar((stat($org))[2]), $new if $KeepMode;
$filen++;
}
}
}
fcopy() uses copy() in File::Copy (I have version 2.31).
I'm wondering if I'm missing something obvious before I spend more time going down the rabbithole looking into Perl modules. I've been using File::Copy::Recursive for years without problems. To get this working I'll have to shell out to xcopy or something for now but I would like to continue using File::Copy::Recursive.
Update: I just noticed the current version is 0.44 which is several revisions above 0.38 that I have so my first step should likely be to upgrade and try again.
