In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/7a8a0b0b53636efbb1534b0e2fa49db8e2fcb670?hp=365f8c3e9d04802accfb3922fb8ab94c3d17c8d9>
- Log ----------------------------------------------------------------- commit 7a8a0b0b53636efbb1534b0e2fa49db8e2fcb670 Author: Craig A. Berry <[email protected]> Date: Sat Dec 21 09:59:09 2013 -0600 Bump File::Copy to version 2.29. M lib/File/Copy.pm commit 6865d65a30583594300bab3f935822ed6cae3376 Author: Craig A. Berry <[email protected]> Date: Sat Dec 21 09:48:29 2013 -0600 Simplify and clarify VMS specifics in File::Copy. 4c38808d92b95 added some logic to make a "to" path with no directory component inherit from the current working directory rather than the directory portion of the "from" path. It also added a trailing dot to make null file types unambiguous. But the comments emphasized the latter and made no mentin of the former, and the implementation was unnecessarily complex. M lib/File/Copy.pm commit ad8daf7e3967e5416cfed8688a8eb5a05178414c Author: Craig A. Berry <[email protected]> Date: Sat Dec 21 08:33:36 2013 -0600 Revert "Unix compatibility mode" in File::Copy on VMS. This backs out the changes introduced in fc06fdeb76c89. On reflection, it doesn't make any sense to support what is actually a Unix *report* mode in an API that does not report filenames. File::Copy just needs to supply names to the underlying copy functions that they can operate on. How those names are presented is of no concern here as we don't present them to the caller. M lib/File/Copy.pm commit 3f79341b652b57aef7d15dfcdd013485fc9b23a6 Author: Craig A. Berry <[email protected]> Date: Sat Dec 21 08:28:23 2013 -0600 Fix typo introduced in 4c38808d92b95. The variable name is '$^O' not '-$^O'. This meant File::Copy::move didn't put the file in the current working directory when the to argument had no path component. M lib/File/Copy.pm ----------------------------------------------------------------------- Summary of changes: lib/File/Copy.pm | 145 ++++++++++--------------------------------------------- 1 file changed, 25 insertions(+), 120 deletions(-) diff --git a/lib/File/Copy.pm b/lib/File/Copy.pm index 71601f3..a20a964 100644 --- a/lib/File/Copy.pm +++ b/lib/File/Copy.pm @@ -22,7 +22,7 @@ sub syscopy; sub cp; sub mv; -$VERSION = '2.28'; +$VERSION = '2.29'; require Exporter; @ISA = qw(Exporter); @@ -41,44 +41,6 @@ sub carp { goto &Carp::carp; } -# Look up the feature settings on VMS using VMS::Feature when available. - -my $use_vms_feature = 0; -BEGIN { - if ($^O eq 'VMS') { - if (eval { local $SIG{__DIE__}; require VMS::Feature; }) { - $use_vms_feature = 1; - } - } -} - -# Need to look up the UNIX report mode. This may become a dynamic mode -# in the future. -sub _vms_unix_rpt { - my $unix_rpt; - if ($use_vms_feature) { - $unix_rpt = VMS::Feature::current("filename_unix_report"); - } else { - my $env_unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || ''; - $unix_rpt = $env_unix_rpt =~ /^[ET1]/i; - } - return $unix_rpt; -} - -# Need to look up the EFS character set mode. This may become a dynamic -# mode in the future. -sub _vms_efs { - my $efs; - if ($use_vms_feature) { - $efs = VMS::Feature::current("efs_charset"); - } else { - my $env_efs = $ENV{'DECC$EFS_CHARSET'} || ''; - $efs = $env_efs =~ /^[ET1]/i; - } - return $efs; -} - - sub _catname { my($from, $to) = @_; if (not defined &basename) { @@ -158,50 +120,21 @@ sub copy { && !($from_a_handle && $^O eq 'NetWare') ) { - my $copy_to = $to; - - if ($^O eq 'VMS' && -e $from) { - - if (! -d $to && ! -d $from) { - - my $vms_efs = _vms_efs(); - my $unix_rpt = _vms_unix_rpt(); - my $unix_mode = 0; - my $from_unix = 0; - $from_unix = 1 if ($from =~ /^\.\.?$/); - my $from_vms = 0; - $from_vms = 1 if ($from =~ m#[\[<\]]#); - - # Need to know if we are in Unix mode. - if ($from_vms == $from_unix) { - $unix_mode = $unix_rpt; - } else { - $unix_mode = $from_unix; - } - - # VMS has sticky defaults on extensions, which means that - # if there is a null extension on the destination file, it - # will inherit the extension of the source file - # So add a '.' for a null extension. - - # In unix_rpt mode, the trailing dot should not be added. - - if ($vms_efs) { - $copy_to = $to; - } else { - $copy_to = VMS::Filespec::vmsify($to); - } - my ($vol, $dirs, $file) = File::Spec->splitpath($copy_to); - $file = $file . '.' - unless (($file =~ /(?<!\^)\./) || $unix_rpt); - $copy_to = File::Spec->catpath($vol, $dirs, $file); - - # Get rid of the old versions to be like UNIX - 1 while unlink $copy_to; - } + if ($^O eq 'VMS' && -e $from + && ! -d $to && ! -d $from) { + + # VMS natively inherits path components from the source of a + # copy, but we want the Unixy behavior of inheriting from + # the current working directory. Also, default in a trailing + # dot for null file types. + + $to = VMS::Filespec::rmsexpand(VMS::Filespec::vmsify($to), '.'); + + # Get rid of the old versions to be like UNIX + 1 while unlink $to; } - return syscopy($from, $copy_to) || 0; + return syscopy($from, $to) || 0; } my $closefrom = 0; @@ -331,49 +264,21 @@ sub _move { unlink $to; } - my $rename_to = $to; - if (-$^O eq 'VMS' && -e $from) { - - if (! -d $to && ! -d $from) { - - my $vms_efs = _vms_efs(); - my $unix_rpt = _vms_unix_rpt(); - my $unix_mode = 0; - my $from_unix = 0; - $from_unix = 1 if ($from =~ /^\.\.?$/); - my $from_vms = 0; - $from_vms = 1 if ($from =~ m#[\[<\]]#); - - # Need to know if we are in Unix mode. - if ($from_vms == $from_unix) { - $unix_mode = $unix_rpt; - } else { - $unix_mode = $from_unix; - } - - # VMS has sticky defaults on extensions, which means that - # if there is a null extension on the destination file, it - # will inherit the extension of the source file - # So add a '.' for a null extension. - - # In unix_rpt mode, the trailing dot should not be added. - - if ($vms_efs) { - $rename_to = $to; - } else { - $rename_to = VMS::Filespec::vmsify($to); - } - my ($vol, $dirs, $file) = File::Spec->splitpath($rename_to); - $file = $file . '.' - unless (($file =~ /(?<!\^)\./) || $unix_rpt); - $rename_to = File::Spec->catpath($vol, $dirs, $file); + if ($^O eq 'VMS' && -e $from + && ! -d $to && ! -d $from) { + + # VMS natively inherits path components from the source of a + # copy, but we want the Unixy behavior of inheriting from + # the current working directory. Also, default in a trailing + # dot for null file types. + + $to = VMS::Filespec::rmsexpand(VMS::Filespec::vmsify($to), '.'); # Get rid of the old versions to be like UNIX - 1 while unlink $rename_to; - } + 1 while unlink $to; } - return 1 if rename $from, $rename_to; + return 1 if rename $from, $to; # Did rename return an error even though it succeeded, because $to # is on a remote NFS file system, and NFS lost the server's ack? -- Perl5 Master Repository
