diff options
Diffstat (limited to 'contrib/perl5/lib/File/Copy.pm')
| -rw-r--r-- | contrib/perl5/lib/File/Copy.pm | 43 |
1 files changed, 27 insertions, 16 deletions
diff --git a/contrib/perl5/lib/File/Copy.pm b/contrib/perl5/lib/File/Copy.pm index e1da6b6e59c0..e6cf78603423 100644 --- a/contrib/perl5/lib/File/Copy.pm +++ b/contrib/perl5/lib/File/Copy.pm @@ -7,17 +7,21 @@ package File::Copy; +use 5.005_64; use strict; use Carp; -use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION $Too_Big - © &syscopy &cp &mv); +our(@ISA, @EXPORT, @EXPORT_OK, $VERSION, $Too_Big, $Syscopy_is_copy); +sub copy; +sub syscopy; +sub cp; +sub mv; # 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,11 +64,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); } @@ -78,20 +83,20 @@ sub copy { if ($from_a_handle) { *FROM = *$from{FILEHANDLE}; } else { - $from = "./$from" if $from =~ /^\s/; + $from = "./$from" if $from =~ /^\s/s; open(FROM, "< $from\0") or goto fail_open1; binmode FROM or die "($!,$^E)"; $closefrom = 1; - } - + } + if ($to_a_handle) { *TO = *$to{FILEHANDLE}; - } else { - $to = "./$to" if $to =~ /^\s/; + } else { + $to = "./$to" if $to =~ /^\s/s; open(TO,"> $to\0") or goto fail_open2; binmode TO or die "($!,$^E)"; $closeto = 1; - } + } if (@_) { $size = shift(@_) + 0; @@ -119,7 +124,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) { @@ -162,10 +167,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); @@ -186,7 +191,13 @@ unless (defined &syscopy) { # preserve MPE file attributes. return system('/bin/cp', '-f', $_[0], $_[1]) == 0; }; + } elsif ($^O eq 'MSWin32') { + *syscopy = sub { + return 0 unless @_ == 2; + return Win32::CopyFile(@_, 1); + }; } else { + $Syscopy_is_copy = 1; *syscopy = \© } } @@ -272,9 +283,9 @@ second parameter, preserving OS-specific attributes and file structure. For Unix systems, this is equivalent to the simple C<copy> routine. For VMS systems, this calls the C<rmscopy> routine (see below). For OS/2 systems, this calls the C<syscopy> -XSUB directly. +XSUB directly. For Win32 systems, this calls C<Win32::CopyFile>. -=head2 Special behaviour if C<syscopy> is defined (VMS and OS/2) +=head2 Special behaviour if C<syscopy> is defined (OS/2, VMS and Win32) If both arguments to C<copy> are not file handles, then C<copy> will perform a "system copy" of |