summaryrefslogtreecommitdiff
path: root/lib/File
diff options
context:
space:
mode:
authorCraig A. Berry <craigberry@mac.com>2013-12-21 09:48:29 -0600
committerCraig A. Berry <craigberry@mac.com>2013-12-21 09:48:29 -0600
commit6865d65a30583594300bab3f935822ed6cae3376 (patch)
tree43e98c2dd379ceb61a426f9325865381131a59be /lib/File
parentad8daf7e3967e5416cfed8688a8eb5a05178414c (diff)
downloadperl-6865d65a30583594300bab3f935822ed6cae3376.tar.gz
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.
Diffstat (limited to 'lib/File')
-rw-r--r--lib/File/Copy.pm52
1 files changed, 19 insertions, 33 deletions
diff --git a/lib/File/Copy.pm b/lib/File/Copy.pm
index afc30b91ae..62d1eea860 100644
--- a/lib/File/Copy.pm
+++ b/lib/File/Copy.pm
@@ -120,29 +120,21 @@ sub copy {
&& !($from_a_handle && $^O eq 'NetWare')
)
{
- my $copy_to = $to;
+ if ($^O eq 'VMS' && -e $from
+ && ! -d $to && ! -d $from) {
- if ($^O eq 'VMS' && -e $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.
- if (! -d $to && ! -d $from) {
+ $to = VMS::Filespec::rmsexpand(VMS::Filespec::vmsify($to), '.');
- # 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.
-
- $copy_to = VMS::Filespec::vmsify($to);
-
- my ($vol, $dirs, $file) = File::Spec->splitpath($copy_to);
- $file = $file . '.' unless ($file =~ /(?<!\^)\./);
- $copy_to = File::Spec->catpath($vol, $dirs, $file);
-
- # Get rid of the old versions to be like UNIX
- 1 while unlink $copy_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;
@@ -272,27 +264,21 @@ sub _move {
unlink $to;
}
- my $rename_to = $to;
- if ($^O eq 'VMS' && -e $from) {
-
- if (! -d $to && ! -d $from) {
+ if ($^O eq 'VMS' && -e $from
+ && ! -d $to && ! -d $from) {
- # 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.
+ # 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.
- $rename_to = VMS::Filespec::vmsify($to);
- my ($vol, $dirs, $file) = File::Spec->splitpath($rename_to);
- $file = $file . '.' unless ($file =~ /(?<!\^)\./);
- $rename_to = File::Spec->catpath($vol, $dirs, $file);
+ $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?