1 # File/Copy.pm. Written in 1994 by Aaron Sherman <ajs@ajs.com>. This
2 # source code has been placed in the public domain by the author.
3 # Please be kind and preserve the documentation.
5 # Additions copyright 1996 by Charles Bailey. Permission is granted
6 # to distribute the revised code under the same terms as Perl itself.
15 # During perl build, we need File::Copy but Scalar::Util might not be built yet
16 # And then we need these games to avoid loading overload, as that will
17 # confuse miniperl during the bootstrap of perl.
18 my $Scalar_Util_loaded = eval q{ require Scalar::Util; require overload; 1 };
19 our(@ISA, @EXPORT, @EXPORT_OK, $VERSION, $Too_Big, $Syscopy_is_copy);
29 @EXPORT = qw(copy move);
30 @EXPORT_OK = qw(cp mv);
32 $Too_Big = 1024 * 1024 * 2;
46 $macfiles = eval { require Mac::MoreFiles };
47 warn 'Mac::MoreFiles could not be loaded; using non-native syscopy'
51 # Look up the feature settings on VMS using VMS::Feature when available.
53 my $use_vms_feature = 0;
56 if (eval { local $SIG{__DIE__}; require VMS::Feature; }) {
62 # Need to look up the UNIX report mode. This may become a dynamic mode
66 if ($use_vms_feature) {
67 $unix_rpt = VMS::Feature::current("filename_unix_report");
69 my $env_unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || '';
70 $unix_rpt = $env_unix_rpt =~ /^[ET1]/i;
75 # Need to look up the EFS character set mode. This may become a dynamic
79 if ($use_vms_feature) {
80 $efs = VMS::Feature::current("efs_charset");
82 my $env_efs = $ENV{'DECC$EFS_CHARSET'} || '';
83 $efs = $env_efs =~ /^[ET1]/i;
91 if (not defined &basename) {
92 require File::Basename;
93 import File::Basename 'basename';
97 # a partial dir name that's valid only in the cwd (e.g. 'tmp')
98 $to = ':' . $to if $to !~ /:/;
101 return File::Spec->catfile($to, basename($from));
104 # _eq($from, $to) tells whether $from and $to are identical
106 my ($from, $to) = map {
107 $Scalar_Util_loaded && Scalar::Util::blessed($_)
108 && overload::Method($_, q{""})
112 return '' if ( (ref $from) xor (ref $to) );
113 return $from == $to if ref $from;
118 croak("Usage: copy(FROM, TO [, BUFFERSIZE]) ")
119 unless(@_ == 2 || @_ == 3);
126 $size = shift(@_) + 0;
127 croak("Bad buffer size for copy: $size\n") unless ($size > 0);
130 my $from_a_handle = (ref($from)
131 ? (ref($from) eq 'GLOB'
132 || UNIVERSAL::isa($from, 'GLOB')
133 || UNIVERSAL::isa($from, 'IO::Handle'))
134 : (ref(\$from) eq 'GLOB'));
135 my $to_a_handle = (ref($to)
136 ? (ref($to) eq 'GLOB'
137 || UNIVERSAL::isa($to, 'GLOB')
138 || UNIVERSAL::isa($to, 'IO::Handle'))
139 : (ref(\$to) eq 'GLOB'));
141 if (_eq($from, $to)) { # works for references, too
142 carp("'$from' and '$to' are identical (not copied)");
143 # The "copy" was a success as the source and destination contain
148 if ((($Config{d_symlink} && $Config{d_readlink}) || $Config{d_link}) &&
149 !($^O eq 'MSWin32' || $^O eq 'os2')) {
150 my @fs = stat($from);
153 if (@ts && $fs[0] == $ts[0] && $fs[1] == $ts[1]) {
154 carp("'$from' and '$to' are identical (not copied)");
160 if (!$from_a_handle && !$to_a_handle && -d $to && ! -d $from) {
161 $to = _catname($from, $to);
164 if (defined &syscopy && !$Syscopy_is_copy
166 && !($from_a_handle && $^O eq 'os2' ) # OS/2 cannot handle handles
167 && !($from_a_handle && $^O eq 'mpeix') # and neither can MPE/iX.
168 && !($from_a_handle && $^O eq 'MSWin32')
169 && !($from_a_handle && $^O eq 'MacOS')
170 && !($from_a_handle && $^O eq 'NetWare')
175 if ($^O eq 'VMS' && -e $from) {
177 if (! -d $to && ! -d $from) {
179 my $vms_efs = _vms_efs();
180 my $unix_rpt = _vms_unix_rpt();
183 $from_unix = 1 if ($from =~ /^\.\.?$/);
185 $from_vms = 1 if ($from =~ m#[\[<\]]#);
187 # Need to know if we are in Unix mode.
188 if ($from_vms == $from_unix) {
189 $unix_mode = $unix_rpt;
191 $unix_mode = $from_unix;
194 # VMS has sticky defaults on extensions, which means that
195 # if there is a null extension on the destination file, it
196 # will inherit the extension of the source file
197 # So add a '.' for a null extension.
199 # In unix_rpt mode, the trailing dot should not be added.
204 $copy_to = VMS::Filespec::vmsify($to);
206 my ($vol, $dirs, $file) = File::Spec->splitpath($copy_to);
208 unless (($file =~ /(?<!\^)\./) || $unix_rpt);
209 $copy_to = File::Spec->catpath($vol, $dirs, $file);
211 # Get rid of the old versions to be like UNIX
212 1 while unlink $copy_to;
216 return syscopy($from, $copy_to) || 0;
221 my ($status, $r, $buf);
225 if ($from_a_handle) {
228 open $from_h, "<", $from or goto fail_open1;
229 binmode $from_h or die "($!,$^E)";
233 # Seems most logical to do this here, in case future changes would want to
234 # make this croak for some reason.
235 unless (defined $size) {
236 $size = tied(*$from_h) ? 0 : -s $from_h || 0;
237 $size = 1024 if ($size < 512);
238 $size = $Too_Big if ($size > $Too_Big);
245 $to = _protect($to) if $to =~ /^\s/s;
246 $to_h = \do { local *FH };
247 open $to_h, ">", $to or goto fail_open2;
248 binmode $to_h or die "($!,$^E)";
255 defined($r = sysread($from_h, $buf, $size))
258 for ($w = 0; $w < $r; $w += $t) {
259 $t = syswrite($to_h, $buf, $r - $w, $w)
264 close($to_h) || goto fail_open2 if $closeto;
265 close($from_h) || goto fail_open1 if $closefrom;
267 # Use this idiom to avoid uninitialized value warning.
270 # All of these contortions try to preserve error messages...
276 $! = $status unless $!;
283 $! = $status unless $!;
291 my(@fromstat) = stat $from;
292 my(@tostat) = stat $to;
295 return 0 unless copy(@_) and @fromstat;
300 $perm = $fromstat[2] & ~(umask || 0);
303 # Might be more robust to look for S_I* in Fcntl, but we're
304 # trying to avoid dependence on any XS-containing modules,
305 # since File::Copy is used during the Perl build.
308 croak("Unable to check setuid/setgid permissions for $to: $!")
311 if ($perm & 04000 and # setuid
312 $fromstat[4] != $tostat[4]) { # owner must match
316 if ($perm & 02000) { # setgid
317 my $ok = $fromstat[5] == $tostat[5]; # group must match
318 if ($ok) { # and we must be in group
319 my $uname = (getpwuid($>))[0] || '';
320 my $group = (getpwuid($>))[3];
321 $ok = $group && $group == $fromstat[5] ||
322 grep { $_ eq $uname }
323 split /\s+/, (getgrgid($fromstat[5]))[3];
325 $perm &= ~06000 unless $ok;
328 return 0 unless @tostat;
329 return 1 if $perm == ($tostat[2] & 07777);
330 return eval { chmod $perm, $to; } ? 1 : 0;
334 croak("Usage: move(FROM, TO) ") unless @_ == 3;
336 my($from,$to,$fallback) = @_;
338 my($fromsz,$tosz1,$tomt1,$tosz2,$tomt2,$sts,$ossts);
340 if (-d $to && ! -d $from) {
341 $to = _catname($from, $to);
344 ($tosz1,$tomt1) = (stat($to))[7,9];
346 if ($^O eq 'os2' and defined $tosz1 and defined $fromsz) {
347 # will not rename with overwrite
352 if (-$^O eq 'VMS' && -e $from) {
354 if (! -d $to && ! -d $from) {
356 my $vms_efs = _vms_efs();
357 my $unix_rpt = _vms_unix_rpt();
360 $from_unix = 1 if ($from =~ /^\.\.?$/);
362 $from_vms = 1 if ($from =~ m#[\[<\]]#);
364 # Need to know if we are in Unix mode.
365 if ($from_vms == $from_unix) {
366 $unix_mode = $unix_rpt;
368 $unix_mode = $from_unix;
371 # VMS has sticky defaults on extensions, which means that
372 # if there is a null extension on the destination file, it
373 # will inherit the extension of the source file
374 # So add a '.' for a null extension.
376 # In unix_rpt mode, the trailing dot should not be added.
381 $rename_to = VMS::Filespec::vmsify($to);
383 my ($vol, $dirs, $file) = File::Spec->splitpath($rename_to);
385 unless (($file =~ /(?<!\^)\./) || $unix_rpt);
386 $rename_to = File::Spec->catpath($vol, $dirs, $file);
388 # Get rid of the old versions to be like UNIX
389 1 while unlink $rename_to;
393 return 1 if rename $from, $rename_to;
395 # Did rename return an error even though it succeeded, because $to
396 # is on a remote NFS file system, and NFS lost the server's ack?
397 return 1 if defined($fromsz) && !-e $from && # $from disappeared
398 (($tosz2,$tomt2) = (stat($to))[7,9]) && # $to's there
399 ((!defined $tosz1) || # not before or
400 ($tosz1 != $tosz2 or $tomt1 != $tomt2)) && # was changed
401 $tosz2 == $fromsz; # it's all there
403 ($tosz1,$tomt1) = (stat($to))[7,9]; # just in case rename did something
409 $fallback->($from,$to) or die;
410 my($atime, $mtime) = (stat($from))[8,9];
411 utime($atime, $mtime, $to);
412 unlink($from) or die;
416 ($sts,$ossts) = ($! + 0, $^E + 0);
418 ($tosz2,$tomt2) = ((stat($to))[7,9],0,0) if defined $tomt1;
419 unlink($to) if !defined($tomt1) or $tomt1 != $tomt2 or $tosz1 != $tosz2;
420 ($!,$^E) = ($sts,$ossts);
424 sub move { _move(@_,\©); }
425 sub mv { _move(@_,\&cp); }
427 # &syscopy is an XSUB under OS/2
428 unless (defined &syscopy) {
430 *syscopy = \&rmscopy;
431 } elsif ($^O eq 'mpeix') {
433 return 0 unless @_ == 2;
434 # Use the MPE cp program in order to
435 # preserve MPE file attributes.
436 return system('/bin/cp', '-f', $_[0], $_[1]) == 0;
438 } elsif ($^O eq 'MSWin32' && defined &DynaLoader::boot_DynaLoader) {
439 # Win32::CopyFile() fill only work if we can load Win32.xs
441 return 0 unless @_ == 2;
442 return Win32::CopyFile(@_, 1);
444 } elsif ($macfiles) {
449 return 0 unless -e $from;
451 if ($to =~ /(.*:)([^:]+):?$/) {
452 ($dir, $toname) = ($1, $2);
454 ($dir, $toname) = (":", $to);
458 Mac::MoreFiles::FSpFileCopy($from, $dir, $toname, 1);
461 $Syscopy_is_copy = 1;
472 File::Copy - Copy files or filehandles
478 copy("file1","file2") or die "Copy failed: $!";
479 copy("Copy.pm",\*STDOUT);
480 move("/dev1/fileA","/dev2/fileB");
484 $n = FileHandle->new("/a/file","r");
489 The File::Copy module provides two basic functions, C<copy> and
490 C<move>, which are useful for getting the contents of a file from
491 one place to another.
498 The C<copy> function takes two
499 parameters: a file to copy from and a file to copy to. Either
500 argument may be a string, a FileHandle reference or a FileHandle
501 glob. Obviously, if the first argument is a filehandle of some
502 sort, it will be read from, and if it is a file I<name> it will
503 be opened for reading. Likewise, the second argument will be
504 written to (and created if need be). Trying to copy a file on top
505 of itself is a fatal error.
507 B<Note that passing in
508 files as handles instead of names may lead to loss of information
509 on some operating systems; it is recommended that you use file
510 names whenever possible.> Files are opened in binary mode where
511 applicable. To get a consistent behaviour when copying from a
512 filehandle to a file, use C<binmode> on the filehandle.
514 An optional third parameter can be used to specify the buffer
515 size used for copying. This is the number of bytes from the
516 first file, that will be held in memory at any given time, before
517 being written to the second file. The default buffer size depends
518 upon the file, but will generally be the whole file (up to 2MB), or
519 1k for filehandles that do not reference files (eg. sockets).
521 You may use the syntax C<use File::Copy "cp"> to get at the C<cp>
522 alias for this function. The syntax is I<exactly> the same. The
523 behavior is nearly the same as well: as of version 2.15, <cp> will
524 preserve the source file's permission bits like the shell utility
525 C<cp(1)> would do, while C<copy> uses the default permissions for the
526 target file (which may depend on the process' C<umask>, file
527 ownership, inherited ACLs, etc.). If an error occurs in setting
528 permissions, C<cp> will return 0, regardless of whether the file was
532 X<move> X<mv> X<rename>
534 The C<move> function also takes two parameters: the current name
535 and the intended name of the file to be moved. If the destination
536 already exists and is a directory, and the source is not a
537 directory, then the source file will be renamed into the directory
538 specified by the destination.
540 If possible, move() will simply rename the file. Otherwise, it copies
541 the file to the new location and deletes the original. If an error occurs
542 during this copy-and-delete process, you may be left with a (possibly partial)
543 copy of the file under the destination name.
545 You may use the C<mv> alias for this function in the same way that
546 you may use the <cp> alias for C<copy>.
551 File::Copy also provides the C<syscopy> routine, which copies the
552 file specified in the first parameter to the file specified in the
553 second parameter, preserving OS-specific attributes and file
554 structure. For Unix systems, this is equivalent to the simple
555 C<copy> routine, which doesn't preserve OS-specific attributes. For
556 VMS systems, this calls the C<rmscopy> routine (see below). For OS/2
557 systems, this calls the C<syscopy> XSUB directly. For Win32 systems,
558 this calls C<Win32::CopyFile>.
560 On Mac OS (Classic), C<syscopy> calls C<Mac::MoreFiles::FSpFileCopy>,
563 B<Special behaviour if C<syscopy> is defined (OS/2, VMS and Win32)>:
565 If both arguments to C<copy> are not file handles,
566 then C<copy> will perform a "system copy" of
567 the input file to a new output file, in order to preserve file
568 attributes, indexed file structure, I<etc.> The buffer size
569 parameter is ignored. If either argument to C<copy> is a
570 handle to an opened file, then data is copied using Perl
571 operators, and no effort is made to preserve file attributes
574 The system copy routine may also be called directly under VMS and OS/2
575 as C<File::Copy::syscopy> (or under VMS as C<File::Copy::rmscopy>, which
576 is the routine that does the actual work for syscopy).
578 =item rmscopy($from,$to[,$date_flag])
581 The first and second arguments may be strings, typeglobs, typeglob
582 references, or objects inheriting from IO::Handle;
583 they are used in all cases to obtain the
584 I<filespec> of the input and output files, respectively. The
585 name and type of the input file are used as defaults for the
586 output file, if necessary.
588 A new version of the output file is always created, which
589 inherits the structure and RMS attributes of the input file,
590 except for owner and protections (and possibly timestamps;
591 see below). All data from the input file is copied to the
592 output file; if either of the first two parameters to C<rmscopy>
593 is a file handle, its position is unchanged. (Note that this
594 means a file handle pointing to the output file will be
595 associated with an old version of that file after C<rmscopy>
596 returns, not the newly created version.)
598 The third parameter is an integer flag, which tells C<rmscopy>
599 how to handle timestamps. If it is E<lt> 0, none of the input file's
600 timestamps are propagated to the output file. If it is E<gt> 0, then
601 it is interpreted as a bitmask: if bit 0 (the LSB) is set, then
602 timestamps other than the revision date are propagated; if bit 1
603 is set, the revision date is propagated. If the third parameter
604 to C<rmscopy> is 0, then it behaves much like the DCL COPY command:
605 if the name or type of the output file was explicitly specified,
606 then no timestamps are propagated, but if they were taken implicitly
607 from the input filespec, then all timestamps other than the
608 revision date are propagated. If this parameter is not supplied,
611 Like C<copy>, C<rmscopy> returns 1 on success. If an error occurs,
612 it sets C<$!>, deletes the output file, and returns 0.
618 All functions return 1 on success, 0 on failure.
619 $! will be set if an error was encountered.
627 On Mac OS (Classic), the path separator is ':', not '/', and the
628 current directory is denoted as ':', not '.'. You should be careful
629 about specifying relative pathnames. While a full path always begins
630 with a volume name, a relative pathname should always begin with a
631 ':'. If specifying a volume name only, a trailing ':' is required.
635 copy("file1", "tmp"); # creates the file 'tmp' in the current directory
636 copy("file1", ":tmp:"); # creates :tmp:file1
637 copy("file1", ":tmp"); # same as above
638 copy("file1", "tmp"); # same as above, if 'tmp' is a directory (but don't do
639 # that, since it may cause confusion, see example #1)
640 copy("file1", "tmp:file1"); # error, since 'tmp:' is not a volume
641 copy("file1", ":tmp:file1"); # ok, partial path
642 copy("file1", "DataHD:"); # creates DataHD:file1
644 move("MacintoshHD:fileA", "DataHD:fileB"); # moves (doesn't copy) files from one
651 File::Copy was written by Aaron Sherman I<E<lt>ajs@ajs.comE<gt>> in 1995,
652 and updated by Charles Bailey I<E<lt>bailey@newman.upenn.eduE<gt>> in 1996.