From fa648be5b5a2a3bc8c29254f11129f525db48032 Mon Sep 17 00:00:00 2001 From: Chris Nandor Date: Wed, 28 Feb 2001 17:10:15 -0500 Subject: File::Copy for bleadperl, maintperl Message-Id: p4raw-id: //depot/perl@8980 --- lib/File/Copy.pm | 31 ++++++++++++++++++++++++++++--- 1 file changed, 28 insertions(+), 3 deletions(-) (limited to 'lib') diff --git a/lib/File/Copy.pm b/lib/File/Copy.pm index 8d1d7834c9..24d1ffdf63 100644 --- a/lib/File/Copy.pm +++ b/lib/File/Copy.pm @@ -37,7 +37,7 @@ sub _catname { # Will be replaced by File::Spec when it arrives import File::Basename 'basename'; } if ($^O eq 'VMS') { $to = VMS::Filespec::vmspath($to) . basename($from); } - elsif ($^O eq 'MacOS') { $to .= ':' . basename($from); } + elsif ($^O eq 'MacOS') { $to =~ s/^([^:]+)$/:$1/; $to .= ':' . basename($from); } elsif ($to =~ m|\\|) { $to .= '\\' . basename($from); } else { $to .= '/' . basename($from); } } @@ -69,6 +69,7 @@ sub copy { && !($from_a_handle && $^O eq 'os2' ) # OS/2 cannot handle handles && !($from_a_handle && $^O eq 'mpeix') # and neither can MPE/iX. && !($from_a_handle && $^O eq 'MSWin32') + && !($from_a_handle && $^O eq 'MacOS') ) { return syscopy($from, $to); @@ -83,7 +84,7 @@ sub copy { if ($from_a_handle) { *FROM = *$from{FILEHANDLE}; } else { - $from = "./$from" if $from =~ /^\s/s; + $from = _protect($from) if $from =~ /^\s/s; open(FROM, "< $from\0") or goto fail_open1; binmode FROM or die "($!,$^E)"; $closefrom = 1; @@ -92,7 +93,7 @@ sub copy { if ($to_a_handle) { *TO = *$to{FILEHANDLE}; } else { - $to = "./$to" if $to =~ /^\s/s; + $to = _protect($to) if $to =~ /^\s/s; open(TO,"> $to\0") or goto fail_open2; binmode TO or die "($!,$^E)"; $closeto = 1; @@ -180,6 +181,13 @@ sub move { *cp = \© *mv = \&move; + +if ($^O eq 'MacOS') { + *_protect = sub { MacPerl::MakeFSSpec($_[0]) }; +} else { + *_protect = sub { "./$_[0]" }; +} + # &syscopy is an XSUB under OS/2 unless (defined &syscopy) { if ($^O eq 'VMS') { @@ -196,6 +204,23 @@ unless (defined &syscopy) { return 0 unless @_ == 2; return Win32::CopyFile(@_, 1); }; + } elsif ($^O eq 'MacOS') { + require Mac::MoreFiles; + *syscopy = sub { + my($from, $to) = @_; + my($dir, $toname); + + return 0 unless -e $from; + + if ($to =~ /(.*:)([^:]+):?$/) { + ($dir, $toname) = ($1, $2); + } else { + ($dir, $toname) = (":", $to); + } + + unlink($to); + Mac::MoreFiles::FSpFileCopy($from, $dir, $toname, 1); + }; } else { $Syscopy_is_copy = 1; *syscopy = \© -- cgit v1.2.1