X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FFile%2FCopy.pm;h=8df54e55a831460fbc14eebcb341b1eefd3cc2b5;hb=1a04d0358afc3470dd1c9e9fd30153615560bfc6;hp=fd812bc721490a2d870bd71ec0e4bd89bf3bcc93;hpb=e68cb0571e958719e0fd6ed56ffa112795b7c00f;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/File/Copy.pm b/lib/File/Copy.pm index fd812bc..8df54e5 100644 --- a/lib/File/Copy.pm +++ b/lib/File/Copy.pm @@ -10,14 +10,14 @@ package File::Copy; use strict; use Carp; use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION $Too_Big - © &syscopy &cp &mv); + © &syscopy &cp &mv $Syscopy_is_copy); # Note that this module implements only *part* of the API defined by # the File/Copy.pm module of the File-Tools-2.0 package. However, that # package has not yet been updated to work with Perl 5.004, and so it # would be a Bad Thing for the CPAN module to grab it and replace this # module. Therefore, we set this module's version higher than 2.0. -$VERSION = '2.02'; +$VERSION = '2.03'; require Exporter; @ISA = qw(Exporter); @@ -60,12 +60,12 @@ sub copy { $to = _catname($from, $to); } - if (defined &syscopy && \&syscopy != \© + if (defined &syscopy && !$Syscopy_is_copy && !$to_a_handle && !($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') - ) + ) { return syscopy($from, $to); } @@ -83,16 +83,16 @@ sub copy { open(FROM, "< $from\0") or goto fail_open1; binmode FROM or die "($!,$^E)"; $closefrom = 1; - } - + } + if ($to_a_handle) { *TO = *$to{FILEHANDLE}; - } else { + } else { $to = "./$to" if $to =~ /^\s/; open(TO,"> $to\0") or goto fail_open2; binmode TO or die "($!,$^E)"; $closeto = 1; - } + } if (@_) { $size = shift(@_) + 0; @@ -120,7 +120,7 @@ sub copy { # Use this idiom to avoid uninitialized value warning. return 1; - + # All of these contortions try to preserve error messages... fail_inner: if ($closeto) { @@ -163,10 +163,10 @@ sub move { (($tosz2,$tomt2) = (stat($to))[7,9]) && # $to's there ($tosz1 != $tosz2 or $tomt1 != $tomt2) && # and changed $tosz2 == $fromsz; # it's all there - + ($tosz1,$tomt1) = (stat($to))[7,9]; # just in case rename did something return 1 if ($copied = copy($from,$to)) && unlink($from); - + ($tosz2,$tomt2) = ((stat($to))[7,9],0,0) if defined $tomt1; unlink($to) if !defined($tomt1) or $tomt1 != $tomt2 or $tosz1 != $tosz2; ($!,$^E) = ($sts,$ossts); @@ -193,6 +193,7 @@ unless (defined &syscopy) { return Win32::CopyFile(@_, 1); }; } else { + $Syscopy_is_copy = 1; *syscopy = \© } }