summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorCraig A. Berry <craigberry@mac.com>2013-12-21 08:33:36 -0600
committerCraig A. Berry <craigberry@mac.com>2013-12-21 08:33:36 -0600
commitad8daf7e3967e5416cfed8688a8eb5a05178414c (patch)
tree190d95364a70f20ad7ab28ccf2d0048f6eca202d
parent3f79341b652b57aef7d15dfcdd013485fc9b23a6 (diff)
downloadperl-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.pm89
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