use 5.006;
use strict;
use warnings;
-use Carp;
use File::Spec;
use Config;
our(@ISA, @EXPORT, @EXPORT_OK, $VERSION, $Too_Big, $Syscopy_is_copy);
# 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.05';
+$VERSION = '2.11';
require Exporter;
@ISA = qw(Exporter);
$Too_Big = 1024 * 1024 * 2;
+sub croak {
+ require Carp;
+ goto &Carp::croak;
+}
+
+sub carp {
+ require Carp;
+ goto &Carp::carp;
+}
+
+my $macfiles;
+if ($^O eq 'MacOS') {
+ $macfiles = eval { require Mac::MoreFiles };
+ warn 'Mac::MoreFiles could not be loaded; using non-native syscopy'
+ if $@ && $^W;
+}
+
sub _catname {
my($from, $to) = @_;
if (not defined &basename) {
return File::Spec->catfile($to, basename($from));
}
+# _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 "";
+}
+
sub copy {
croak("Usage: copy(FROM, TO [, BUFFERSIZE]) ")
unless(@_ == 2 || @_ == 3);
|| UNIVERSAL::isa($to, 'IO::Handle'))
: (ref(\$to) eq 'GLOB'));
- if ($from eq $to) { # works for references, too
- croak("'$from' and '$to' are identical (not copied)");
+ if (_eq($from, $to)) { # works for references, too
+ carp("'$from' and '$to' are identical (not copied)");
+ # The "copy" was a success as the source and destination contain
+ # the same data.
+ return 1;
}
- if ($Config{d_symlink} && $Config{d_readlink} &&
- !($^O eq 'Win32' || $^O eq 'os2' || $^O eq 'vms')) {
- if ((-e $from && -l $from) || (-e $to && -l $to)) {
- my @fs = stat($from);
+ if ((($Config{d_symlink} && $Config{d_readlink}) || $Config{d_link}) &&
+ !($^O eq 'MSWin32' || $^O eq 'os2')) {
+ my @fs = stat($from);
+ if (@fs) {
my @ts = stat($to);
- if (@fs && @ts && $fs[0] == $ts[0] && $fs[1] == $ts[1]) {
- croak("'$from' and '$to' are identical (not copied)");
+ if (@ts && $fs[0] == $ts[0] && $fs[1] == $ts[1]) {
+ carp("'$from' and '$to' are identical (not copied)");
+ return 0;
}
}
}
&& !($from_a_handle && $^O eq 'NetWare')
)
{
- return syscopy($from, $to);
+ my $copy_to = $to;
+
+ if ($^O eq 'VMS' && -e $from) {
+
+ if (! -d $to && ! -d $from) {
+
+ # VMS has sticky defaults on extensions, which means that
+ # if there is a null extension on the destination file, it
+ # will inherit the extension of the source file
+ # So add a '.' for a null extension.
+
+ $copy_to = VMS::Filespec::vmsify($to);
+ my ($vol, $dirs, $file) = File::Spec->splitpath($copy_to);
+ $file = $file . '.' unless ($file =~ /(?<!\^)\./);
+ $copy_to = File::Spec->catpath($vol, $dirs, $file);
+
+ # Get rid of the old versions to be like UNIX
+ 1 while unlink $copy_to;
+ }
+ }
+
+ return syscopy($from, $copy_to);
}
my $closefrom = 0;
}
sub move {
+ croak("Usage: move(FROM, TO) ") unless @_ == 2;
+
my($from,$to) = @_;
- my($copied,$fromsz,$tosz1,$tomt1,$tosz2,$tomt2,$sts,$ossts);
+
+ my($fromsz,$tosz1,$tomt1,$tosz2,$tomt2,$sts,$ossts);
if (-d $to && ! -d $from) {
$to = _catname($from, $to);
# will not rename with overwrite
unlink $to;
}
- return 1 if rename $from, $to;
- ($sts,$ossts) = ($! + 0, $^E + 0);
+ my $rename_to = $to;
+ if (-$^O eq 'VMS' && -e $from) {
+
+ if (! -d $to && ! -d $from) {
+ # VMS has sticky defaults on extensions, which means that
+ # if there is a null extension on the destination file, it
+ # will inherit the extension of the source file
+ # So add a '.' for a null extension.
+
+ $rename_to = VMS::Filespec::vmsify($to);
+ my ($vol, $dirs, $file) = File::Spec->splitpath($rename_to);
+ $file = $file . '.' unless ($file =~ /(?<!\^)\./);
+ $rename_to = File::Spec->catpath($vol, $dirs, $file);
+
+ # Get rid of the old versions to be like UNIX
+ 1 while unlink $rename_to;
+ }
+ }
+
+ return 1 if rename $from, $rename_to;
+
# Did rename return an error even though it succeeded, because $to
# is on a remote NFS file system, and NFS lost the server's ack?
return 1 if defined($fromsz) && !-e $from && # $from disappeared
(($tosz2,$tomt2) = (stat($to))[7,9]) && # $to's there
- ($tosz1 != $tosz2 or $tomt1 != $tomt2) && # and changed
+ ((!defined $tosz1) || # not before or
+ ($tosz1 != $tosz2 or $tomt1 != $tomt2)) && # was 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);
+
+ {
+ local $@;
+ eval {
+ local $SIG{__DIE__};
+ copy($from,$to) or die;
+ my($atime, $mtime) = (stat($from))[8,9];
+ utime($atime, $mtime, $to);
+ unlink($from) or die;
+ };
+ return 1 unless $@;
+ }
+ ($sts,$ossts) = ($! + 0, $^E + 0);
($tosz2,$tomt2) = ((stat($to))[7,9],0,0) if defined $tomt1;
unlink($to) if !defined($tomt1) or $tomt1 != $tomt2 or $tosz1 != $tosz2;
# preserve MPE file attributes.
return system('/bin/cp', '-f', $_[0], $_[1]) == 0;
};
- } elsif ($^O eq 'MSWin32') {
+ } elsif ($^O eq 'MSWin32' && defined &DynaLoader::boot_DynaLoader) {
+ # Win32::CopyFile() fill only work if we can load Win32.xs
*syscopy = sub {
return 0 unless @_ == 2;
return Win32::CopyFile(@_, 1);
};
- } elsif ($^O eq 'MacOS') {
- require Mac::MoreFiles;
+ } elsif ($macfiles) {
*syscopy = sub {
my($from, $to) = @_;
my($dir, $toname);
=head1 SYNOPSIS
- use File::Copy;
+ use File::Copy;
- copy("file1","file2");
- copy("Copy.pm",\*STDOUT);'
+ copy("file1","file2") or die "Copy failed: $!";
+ copy("Copy.pm",\*STDOUT);
move("/dev1/fileA","/dev2/fileB");
- use POSIX;
- use File::Copy cp;
+ use File::Copy "cp";
$n = FileHandle->new("/a/file","r");
- cp($n,"x");'
+ cp($n,"x");
=head1 DESCRIPTION
=over 4
-=item *
+=item copy
+X<copy> X<cp>
The C<copy> function takes two
parameters: a file to copy from and a file to copy to. Either
An optional third parameter can be used to specify the buffer
size used for copying. This is the number of bytes from the
-first file, that wil be held in memory at any given time, before
+first file, that will be held in memory at any given time, before
being written to the second file. The default buffer size depends
-upon the file, but will generally be the whole file (up to 2Mb), or
+upon the file, but will generally be the whole file (up to 2MB), or
1k for filehandles that do not reference files (eg. sockets).
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.
-=item *
+=item move
+X<move> X<mv> X<rename>
The C<move> function also takes two parameters: the current name
and the intended name of the file to be moved. If the destination
You may use the "mv" alias for this function in the same way that
you may use the "cp" alias for C<copy>.
-=back
+=item syscopy
+X<syscopy>
File::Copy also provides the C<syscopy> routine, which copies the
file specified in the first parameter to the file specified in the
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. For Win32 systems, this calls C<Win32::CopyFile>.
+C<copy> routine, which doesn't preserve OS-specific attributes. For
+VMS systems, this calls the C<rmscopy> routine (see below). For OS/2
+systems, this calls the C<syscopy> XSUB directly. For Win32 systems,
+this calls C<Win32::CopyFile>.
-=head2 Special behaviour if C<syscopy> is defined (OS/2, VMS and Win32)
+On Mac OS (Classic), C<syscopy> calls C<Mac::MoreFiles::FSpFileCopy>,
+if available.
+
+B<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
as C<File::Copy::syscopy> (or under VMS as C<File::Copy::rmscopy>, which
is the routine that does the actual work for syscopy).
-=over 4
-
=item rmscopy($from,$to[,$date_flag])
+X<rmscopy>
The first and second arguments may be strings, typeglobs, typeglob
references, or objects inheriting from IO::Handle;
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
+ 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
+
+ move("MacintoshHD:fileA", "DataHD:fileB"); # moves (doesn't copy) files from one
# volume to another
=back