Beefy Boxes and Bandwidth Generously Provided by pair Networks
"be consistent"

File::Copy::Recursive::dircopy failing without error in $!

by Lotus1 (Priest)
on Jun 12, 2018 at 15:56 UTC ( #1216477=perlquestion: print w/replies, xml ) Need Help??
Lotus1 has asked for the wisdom of the Perl Monks concerning the following question:

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.

Replies are listed 'Best First'.
Re: File::Copy::Recursive::dircopy failing without error in $!
by haj (Monk) on Jun 13, 2018 at 09:29 UTC

    You should closely inspect the security settings of D:\Eterra\Distribution\XXXCorpXXX\bitmaps in Windows explorer. I could reproduce the behaviour (no files are copied, no content in $!) by denying write access for the destination file. These Windows DENY permissions can not be modified with chmod and they are not visible to any checks made by File::Copy::Recursive. On Windows, the copy operation eventually calls Win32::CopyFile which does not set $! in that case.

    There may be other relevant settings in a Windows environment which I did not test. For example, chmod does only change the user's permission, the "group" and "others" parts are ignored.

    A minor note: When you call clear_readonly_bit($destination); please be aware that this does not remove any readonly bit of $destination itself. This can bite you if $source and $destination are both files and not directories.

      I found that the file that could not be copied over, the one at the destination, was owned by the local Administrators while other files in the same folder were owned by SYSTEM. I changed it to SYSTEM to match and the problem went away. I don't understand this since both have full control access to the file. Setting it back to Admins didn't cause the problem to reappear. This issue might have been cleared by something else I did to the security settings without realizing while investigating.

      I was able to duplicate what you described with the DENY write access setting.

      Your observation about my clear_readonly_bit() function was a good one. In this case I'm always copying folders but I wanted to set it up in case someone else puts a file in the list to copy. Thanks!

      Update: I found if I set $File::Copy::Recursive::RMTrgFil to true it will delete the target file first even if it has the deny setting. I don't want to do this all the time since normally only a few files will change or be added. But I can use this in the case where there is a copy error to retry by setting $File::Copy::Recursive::RMTrgFil true locally.

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://1216477]
Approved by Paladin
Front-paged by haukex
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others cooling their heels in the Monastery: (11)
As of 2018-07-16 12:54 GMT
Find Nodes?
    Voting Booth?
    It has been suggested to rename Perl 6 in order to boost its marketing potential. Which name would you prefer?

    Results (335 votes). Check out past polls.