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 Fcntl might not be built yet
16 my $Fcntl_loaded = eval q{ use Fcntl qw [O_CREAT O_WRONLY O_TRUNC]; 1 };
17 # Similarly Scalar::Util
18 # And then we need these games to avoid loading overload, as that will
19 # confuse miniperl during the bootstrap of perl.
20 my $Scalar_Util_loaded = eval q{ require Scalar::Util; require overload; 1 };
21 our(@ISA, @EXPORT, @EXPORT_OK, $VERSION, $Too_Big, $Syscopy_is_copy);
31 @EXPORT = qw(copy move);
32 @EXPORT_OK = qw(cp mv);
34 $Too_Big = 1024 * 1024 * 2;
48 $macfiles = eval { require Mac::MoreFiles };
49 warn 'Mac::MoreFiles could not be loaded; using non-native syscopy'
55 if (not defined &basename) {
56 require File::Basename;
57 import File::Basename 'basename';
61 # a partial dir name that's valid only in the cwd (e.g. 'tmp')
62 $to = ':' . $to if $to !~ /:/;
65 return File::Spec->catfile($to, basename($from));
68 # _eq($from, $to) tells whether $from and $to are identical
70 my ($from, $to) = map {
71 $Scalar_Util_loaded && Scalar::Util::blessed($_)
72 && overload::Method($_, q{""})
76 return '' if ( (ref $from) xor (ref $to) );
77 return $from == $to if ref $from;
82 croak("Usage: copy(FROM, TO [, BUFFERSIZE]) ")
83 unless(@_ == 2 || @_ == 3);
90 $size = shift(@_) + 0;
91 croak("Bad buffer size for copy: $size\n") unless ($size > 0);
94 my $from_a_handle = (ref($from)
95 ? (ref($from) eq 'GLOB'
96 || UNIVERSAL::isa($from, 'GLOB')
97 || UNIVERSAL::isa($from, 'IO::Handle'))
98 : (ref(\$from) eq 'GLOB'));
99 my $to_a_handle = (ref($to)
100 ? (ref($to) eq 'GLOB'
101 || UNIVERSAL::isa($to, 'GLOB')
102 || UNIVERSAL::isa($to, 'IO::Handle'))
103 : (ref(\$to) eq 'GLOB'));
105 if (_eq($from, $to)) { # works for references, too
106 carp("'$from' and '$to' are identical (not copied)");
107 # The "copy" was a success as the source and destination contain
112 if ((($Config{d_symlink} && $Config{d_readlink}) || $Config{d_link}) &&
113 !($^O eq 'MSWin32' || $^O eq 'os2')) {
114 my @fs = stat($from);
117 if (@ts && $fs[0] == $ts[0] && $fs[1] == $ts[1]) {
118 carp("'$from' and '$to' are identical (not copied)");
124 if (!$from_a_handle && !$to_a_handle && -d $to && ! -d $from) {
125 $to = _catname($from, $to);
128 if (defined &syscopy && !$Syscopy_is_copy
130 && !($from_a_handle && $^O eq 'os2' ) # OS/2 cannot handle handles
131 && !($from_a_handle && $^O eq 'mpeix') # and neither can MPE/iX.
132 && !($from_a_handle && $^O eq 'MSWin32')
133 && !($from_a_handle && $^O eq 'MacOS')
134 && !($from_a_handle && $^O eq 'NetWare')
139 if ($^O eq 'VMS' && -e $from) {
141 if (! -d $to && ! -d $from) {
143 # VMS has sticky defaults on extensions, which means that
144 # if there is a null extension on the destination file, it
145 # will inherit the extension of the source file
146 # So add a '.' for a null extension.
148 $copy_to = VMS::Filespec::vmsify($to);
149 my ($vol, $dirs, $file) = File::Spec->splitpath($copy_to);
150 $file = $file . '.' unless ($file =~ /(?<!\^)\./);
151 $copy_to = File::Spec->catpath($vol, $dirs, $file);
153 # Get rid of the old versions to be like UNIX
154 1 while unlink $copy_to;
158 return syscopy($from, $copy_to);
163 my ($status, $r, $buf);
167 if ($from_a_handle) {
170 open $from_h, "<", $from or goto fail_open1;
171 binmode $from_h or die "($!,$^E)";
175 # Seems most logical to do this here, in case future changes would want to
176 # make this croak for some reason.
177 unless (defined $size) {
178 $size = tied(*$from_h) ? 0 : -s $from_h || 0;
179 $size = 1024 if ($size < 512);
180 $size = $Too_Big if ($size > $Too_Big);
187 $to = _protect($to) if $to =~ /^\s/s;
189 my $perm = (stat $from_h) [2] & 0xFFF;
190 sysopen $to_h, $to, O_CREAT() | O_TRUNC() | O_WRONLY(), $perm
194 $to_h = \do { local *FH };
195 open $to_h, ">", $to or goto fail_open2;
197 binmode $to_h or die "($!,$^E)";
204 defined($r = sysread($from_h, $buf, $size))
207 for ($w = 0; $w < $r; $w += $t) {
208 $t = syswrite($to_h, $buf, $r - $w, $w)
213 close($to_h) || goto fail_open2 if $closeto;
214 close($from_h) || goto fail_open1 if $closefrom;
216 # Use this idiom to avoid uninitialized value warning.
219 # All of these contortions try to preserve error messages...
225 $! = $status unless $!;
232 $! = $status unless $!;
239 croak("Usage: move(FROM, TO) ") unless @_ == 2;
243 my($fromsz,$tosz1,$tomt1,$tosz2,$tomt2,$sts,$ossts);
245 if (-d $to && ! -d $from) {
246 $to = _catname($from, $to);
249 ($tosz1,$tomt1) = (stat($to))[7,9];
251 if ($^O eq 'os2' and defined $tosz1 and defined $fromsz) {
252 # will not rename with overwrite
257 if (-$^O eq 'VMS' && -e $from) {
259 if (! -d $to && ! -d $from) {
260 # VMS has sticky defaults on extensions, which means that
261 # if there is a null extension on the destination file, it
262 # will inherit the extension of the source file
263 # So add a '.' for a null extension.
265 $rename_to = VMS::Filespec::vmsify($to);
266 my ($vol, $dirs, $file) = File::Spec->splitpath($rename_to);
267 $file = $file . '.' unless ($file =~ /(?<!\^)\./);
268 $rename_to = File::Spec->catpath($vol, $dirs, $file);
270 # Get rid of the old versions to be like UNIX
271 1 while unlink $rename_to;
275 return 1 if rename $from, $rename_to;
277 # Did rename return an error even though it succeeded, because $to
278 # is on a remote NFS file system, and NFS lost the server's ack?
279 return 1 if defined($fromsz) && !-e $from && # $from disappeared
280 (($tosz2,$tomt2) = (stat($to))[7,9]) && # $to's there
281 ((!defined $tosz1) || # not before or
282 ($tosz1 != $tosz2 or $tomt1 != $tomt2)) && # was changed
283 $tosz2 == $fromsz; # it's all there
285 ($tosz1,$tomt1) = (stat($to))[7,9]; # just in case rename did something
291 copy($from,$to) or die;
292 my($atime, $mtime) = (stat($from))[8,9];
293 utime($atime, $mtime, $to);
294 unlink($from) or die;
298 ($sts,$ossts) = ($! + 0, $^E + 0);
300 ($tosz2,$tomt2) = ((stat($to))[7,9],0,0) if defined $tomt1;
301 unlink($to) if !defined($tomt1) or $tomt1 != $tomt2 or $tosz1 != $tosz2;
302 ($!,$^E) = ($sts,$ossts);
309 # &syscopy is an XSUB under OS/2
310 unless (defined &syscopy) {
312 *syscopy = \&rmscopy;
313 } elsif ($^O eq 'mpeix') {
315 return 0 unless @_ == 2;
316 # Use the MPE cp program in order to
317 # preserve MPE file attributes.
318 return system('/bin/cp', '-f', $_[0], $_[1]) == 0;
320 } elsif ($^O eq 'MSWin32' && defined &DynaLoader::boot_DynaLoader) {
321 # Win32::CopyFile() fill only work if we can load Win32.xs
323 return 0 unless @_ == 2;
324 return Win32::CopyFile(@_, 1);
326 } elsif ($macfiles) {
331 return 0 unless -e $from;
333 if ($to =~ /(.*:)([^:]+):?$/) {
334 ($dir, $toname) = ($1, $2);
336 ($dir, $toname) = (":", $to);
340 Mac::MoreFiles::FSpFileCopy($from, $dir, $toname, 1);
343 $Syscopy_is_copy = 1;
354 File::Copy - Copy files or filehandles
360 copy("file1","file2") or die "Copy failed: $!";
361 copy("Copy.pm",\*STDOUT);
362 move("/dev1/fileA","/dev2/fileB");
366 $n = FileHandle->new("/a/file","r");
371 The File::Copy module provides two basic functions, C<copy> and
372 C<move>, which are useful for getting the contents of a file from
373 one place to another.
380 The C<copy> function takes two
381 parameters: a file to copy from and a file to copy to. Either
382 argument may be a string, a FileHandle reference or a FileHandle
383 glob. Obviously, if the first argument is a filehandle of some
384 sort, it will be read from, and if it is a file I<name> it will
385 be opened for reading. Likewise, the second argument will be
386 written to (and created if need be). Trying to copy a file on top
387 of itself is a fatal error.
389 B<Note that passing in
390 files as handles instead of names may lead to loss of information
391 on some operating systems; it is recommended that you use file
392 names whenever possible.> Files are opened in binary mode where
393 applicable. To get a consistent behaviour when copying from a
394 filehandle to a file, use C<binmode> on the filehandle.
396 An optional third parameter can be used to specify the buffer
397 size used for copying. This is the number of bytes from the
398 first file, that will be held in memory at any given time, before
399 being written to the second file. The default buffer size depends
400 upon the file, but will generally be the whole file (up to 2MB), or
401 1k for filehandles that do not reference files (eg. sockets).
403 You may use the syntax C<use File::Copy "cp"> to get at the
404 "cp" alias for this function. The syntax is I<exactly> the same.
406 As of version 2.14, on UNIX systems, "copy" will preserve permission
407 bits like the shell utility C<cp> would do.
410 X<move> X<mv> X<rename>
412 The C<move> function also takes two parameters: the current name
413 and the intended name of the file to be moved. If the destination
414 already exists and is a directory, and the source is not a
415 directory, then the source file will be renamed into the directory
416 specified by the destination.
418 If possible, move() will simply rename the file. Otherwise, it copies
419 the file to the new location and deletes the original. If an error occurs
420 during this copy-and-delete process, you may be left with a (possibly partial)
421 copy of the file under the destination name.
423 You may use the "mv" alias for this function in the same way that
424 you may use the "cp" alias for C<copy>.
429 File::Copy also provides the C<syscopy> routine, which copies the
430 file specified in the first parameter to the file specified in the
431 second parameter, preserving OS-specific attributes and file
432 structure. For Unix systems, this is equivalent to the simple
433 C<copy> routine, which doesn't preserve OS-specific attributes. For
434 VMS systems, this calls the C<rmscopy> routine (see below). For OS/2
435 systems, this calls the C<syscopy> XSUB directly. For Win32 systems,
436 this calls C<Win32::CopyFile>.
438 On Mac OS (Classic), C<syscopy> calls C<Mac::MoreFiles::FSpFileCopy>,
441 B<Special behaviour if C<syscopy> is defined (OS/2, VMS and Win32)>:
443 If both arguments to C<copy> are not file handles,
444 then C<copy> will perform a "system copy" of
445 the input file to a new output file, in order to preserve file
446 attributes, indexed file structure, I<etc.> The buffer size
447 parameter is ignored. If either argument to C<copy> is a
448 handle to an opened file, then data is copied using Perl
449 operators, and no effort is made to preserve file attributes
452 The system copy routine may also be called directly under VMS and OS/2
453 as C<File::Copy::syscopy> (or under VMS as C<File::Copy::rmscopy>, which
454 is the routine that does the actual work for syscopy).
456 =item rmscopy($from,$to[,$date_flag])
459 The first and second arguments may be strings, typeglobs, typeglob
460 references, or objects inheriting from IO::Handle;
461 they are used in all cases to obtain the
462 I<filespec> of the input and output files, respectively. The
463 name and type of the input file are used as defaults for the
464 output file, if necessary.
466 A new version of the output file is always created, which
467 inherits the structure and RMS attributes of the input file,
468 except for owner and protections (and possibly timestamps;
469 see below). All data from the input file is copied to the
470 output file; if either of the first two parameters to C<rmscopy>
471 is a file handle, its position is unchanged. (Note that this
472 means a file handle pointing to the output file will be
473 associated with an old version of that file after C<rmscopy>
474 returns, not the newly created version.)
476 The third parameter is an integer flag, which tells C<rmscopy>
477 how to handle timestamps. If it is E<lt> 0, none of the input file's
478 timestamps are propagated to the output file. If it is E<gt> 0, then
479 it is interpreted as a bitmask: if bit 0 (the LSB) is set, then
480 timestamps other than the revision date are propagated; if bit 1
481 is set, the revision date is propagated. If the third parameter
482 to C<rmscopy> is 0, then it behaves much like the DCL COPY command:
483 if the name or type of the output file was explicitly specified,
484 then no timestamps are propagated, but if they were taken implicitly
485 from the input filespec, then all timestamps other than the
486 revision date are propagated. If this parameter is not supplied,
489 Like C<copy>, C<rmscopy> returns 1 on success. If an error occurs,
490 it sets C<$!>, deletes the output file, and returns 0.
496 All functions return 1 on success, 0 on failure.
497 $! will be set if an error was encountered.
505 On Mac OS (Classic), the path separator is ':', not '/', and the
506 current directory is denoted as ':', not '.'. You should be careful
507 about specifying relative pathnames. While a full path always begins
508 with a volume name, a relative pathname should always begin with a
509 ':'. If specifying a volume name only, a trailing ':' is required.
513 copy("file1", "tmp"); # creates the file 'tmp' in the current directory
514 copy("file1", ":tmp:"); # creates :tmp:file1
515 copy("file1", ":tmp"); # same as above
516 copy("file1", "tmp"); # same as above, if 'tmp' is a directory (but don't do
517 # that, since it may cause confusion, see example #1)
518 copy("file1", "tmp:file1"); # error, since 'tmp:' is not a volume
519 copy("file1", ":tmp:file1"); # ok, partial path
520 copy("file1", "DataHD:"); # creates DataHD:file1
522 move("MacintoshHD:fileA", "DataHD:fileB"); # moves (doesn't copy) files from one
529 File::Copy was written by Aaron Sherman I<E<lt>ajs@ajs.comE<gt>> in 1995,
530 and updated by Charles Bailey I<E<lt>bailey@newman.upenn.eduE<gt>> in 1996.