diff options
author | Craig A. Berry <craigberry@mac.com> | 2013-12-21 08:33:36 -0600 |
---|---|---|
committer | Craig A. Berry <craigberry@mac.com> | 2013-12-21 08:33:36 -0600 |
commit | ad8daf7e3967e5416cfed8688a8eb5a05178414c (patch) | |
tree | 190d95364a70f20ad7ab28ccf2d0048f6eca202d | |
parent | 3f79341b652b57aef7d15dfcdd013485fc9b23a6 (diff) | |
download | perl-ad8daf7e3967e5416cfed8688a8eb5a05178414c.tar.gz |
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.
-rw-r--r-- | lib/File/Copy.pm | 89 |
1 files changed, 4 insertions, 85 deletions
diff --git a/lib/File/Copy.pm b/lib/File/Copy.pm index 520752c5ed..afc30b91ae 100644 --- a/lib/File/Copy.pm +++ b/lib/File/Copy.pm @@ -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) { @@ -164,36 +126,15 @@ sub copy { 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. + $copy_to = VMS::Filespec::vmsify($to); - 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); + $file = $file . '.' unless ($file =~ /(?<!\^)\./); $copy_to = File::Spec->catpath($vol, $dirs, $file); # Get rid of the old versions to be like UNIX @@ -336,36 +277,14 @@ sub _move { 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); - } + $rename_to = VMS::Filespec::vmsify($to); my ($vol, $dirs, $file) = File::Spec->splitpath($rename_to); - $file = $file . '.' - unless (($file =~ /(?<!\^)\./) || $unix_rpt); + $file = $file . '.' unless ($file =~ /(?<!\^)\./); $rename_to = File::Spec->catpath($vol, $dirs, $file); # Get rid of the old versions to be like UNIX |