for QNX

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

diff --git a/lib/File/Copy.pm b/lib/File/Copy.pm
index 8d1d783..d5f44f8 100644 (file)
--- a/lib/File/Copy.pm
+++ b/lib/File/Copy.pm
@@ -7,9 +7,11 @@
 
 package File::Copy;
 
-use 5.005_64;
+use 5.6.0;
 use strict;
+use warnings;
 use Carp;
+use File::Spec;
 our(@ISA, @EXPORT, @EXPORT_OK, $VERSION, $Too_Big, $Syscopy_is_copy);
 sub copy;
 sub syscopy;
@@ -21,7 +23,7 @@ sub mv;
 # 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.03';
+$VERSION = '2.04';
 
 require Exporter;
 @ISA = qw(Exporter);
@@ -30,16 +32,19 @@ require Exporter;
 
 $Too_Big = 1024 * 1024 * 2;
 
-sub _catname { #  Will be replaced by File::Spec when it arrives
+sub _catname {
     my($from, $to) = @_;
     if (not defined &basename) {
        require File::Basename;
        import  File::Basename 'basename';
     }
-    if ($^O eq 'VMS')  { $to = VMS::Filespec::vmspath($to) . basename($from); }
-    elsif ($^O eq 'MacOS') { $to .= ':' . basename($from); }
-    elsif ($to =~ m|\\|)   { $to .= '\\' . basename($from); }
-    else                   { $to .= '/' . basename($from); }
+
+    if ($^O eq 'MacOS') {
+       # a partial dir name that's valid only in the cwd (e.g. 'tmp')
+       $to = ':' . $to if $to !~ /:/;
+    }
+
+    return File::Spec->catfile($to, basename($from));
 }
 
 sub copy {
@@ -69,6 +74,8 @@ 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')
+       && !($from_a_handle && $^O eq 'NetWare')
        )
     {
        return syscopy($from, $to);
@@ -83,7 +90,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 +99,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 +187,13 @@ 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') {
@@ -196,6 +210,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 = \&copy;
@@ -344,6 +375,34 @@ it sets C<$!>, deletes the output file, and returns 0.
 All functions return 1 on success, 0 on failure.
 $! will be set if an error was encountered.
 
+=head1 NOTES
+
+=over 4
+
+=item *
+
+On Mac OS (Classic), the path separator is ':', not '/', and the 
+current directory is denoted as ':', not '.'. You should be careful 
+about specifying relative pathnames. While a full path always begins 
+with a volume name, a relative pathname should always begin with a 
+':'.  If specifying a volume name only, a trailing ':' is required.
+
+E.g.
+
+  copy("file1", "tmp");        # creates the file 'tmp' in the current directory
+  copy("file1", ":tmp:");      # creates :tmp:file1
+  copy("file1", ":tmp");       # same as above
+  copy("file1", "tmp");        # same as above, if 'tmp' is a directory (but don't do   
+                               # that, since it may cause confusion, see example #1)
+  copy("file1", "tmp:file1");  # error, since 'tmp:' is not a volume
+  copy("file1", ":tmp:file1"); # ok, partial path
+  copy("file1", "DataHD:");    # creates DataHD:file1
+  
+  move("MacintoshHD:fileA", "DataHD:fileB"); # moves (don't copies) files from one 
+                                             # volume to another
+
+=back
+
 =head1 AUTHOR
 
 File::Copy was written by Aaron Sherman I<E<lt>ajs@ajs.comE<gt>> in 1995,