Upgrade to File::Path 2.07

[p5sagit/p5-mst-13.2.git] / lib / File / Copy.pm

diff --git a/lib/File/Copy.pm b/lib/File/Copy.pm
index caf8262..bff6e88 100644 (file)
--- a/lib/File/Copy.pm
+++ b/lib/File/Copy.pm
@@ -12,18 +12,19 @@ use strict;
 use warnings;
 use File::Spec;
 use Config;
+# During perl build, we need File::Copy but Fcntl might not be built yet
+my $Fcntl_loaded = eval q{ use Fcntl qw [O_CREAT O_WRONLY O_TRUNC]; 1 };
+# Similarly Scalar::Util
+# And then we need these games to avoid loading overload, as that will
+# confuse miniperl during the bootstrap of perl.
+my $Scalar_Util_loaded = eval q{ require Scalar::Util; require overload; 1 };
 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.12';
+$VERSION = '2.14';
 
 require Exporter;
 @ISA = qw(Exporter);
@@ -65,11 +66,16 @@ sub _catname {
 }
 
 # _eq($from, $to) tells whether $from and $to are identical
-# works for strings and references
 sub _eq {
-    return $_[0] == $_[1] if ref $_[0] && ref $_[1];
-    return $_[0] eq $_[1] if !ref $_[0] && !ref $_[1];
-    return "";
+    my ($from, $to) = map {
+        $Scalar_Util_loaded && Scalar::Util::blessed($_)
+           && overload::Method($_, q{""})
+            ? "$_"
+            : $_
+    } (@_);
+    return '' if ( (ref $from) xor (ref $to) );
+    return $from == $to if ref $from;
+    return $from eq $to;
 }
 
 sub copy {
@@ -161,8 +167,6 @@ sub copy {
     if ($from_a_handle) {
        $from_h = $from;
     } else {
-       $from = _protect($from) if $from =~ /^\s/s;
-       $from_h = \do { local *FH };
        open $from_h, "<", $from or goto fail_open1;
        binmode $from_h or die "($!,$^E)";
        $closefrom = 1;
@@ -181,9 +185,16 @@ sub copy {
        $to_h = $to;
     } else {
        $to = _protect($to) if $to =~ /^\s/s;
-       $to_h = \do { local *FH };
-       open $to_h, ">", $to or goto fail_open2;
-       binmode $to_h or die "($!,$^E)";
+       if ($Fcntl_loaded) {
+           my $perm = (stat $from_h) [2] & 0xFFF;
+           sysopen $to_h, $to, O_CREAT() | O_TRUNC() | O_WRONLY(), $perm
+               or goto fail_open2;
+       }
+       else {
+           $to_h = \do { local *FH };
+           open $to_h, ">", $to or goto fail_open2;
+       }
+       binmode $to_h or die "($!,$^E)";
        $closeto = 1;
     }
 
@@ -295,13 +306,6 @@ sub move {
 *cp = \&copy;
 *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') {
@@ -399,6 +403,9 @@ upon the file, but will generally be the whole file (up to 2MB), or
 You may use the syntax C<use File::Copy "cp"> to get at the
 "cp" alias for this function. The syntax is I<exactly> the same.
 
+As of version 2.14, on UNIX systems, "copy" will preserve permission
+bits like the shell utility C<cp> would do.
+
 =item move
 X<move> X<mv> X<rename>