This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
use more descriptive examples in File::Copy
[perl5.git] / lib / File / Copy.pm
CommitLineData
f716a1dd 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.
4#
71be2cbc 5# Additions copyright 1996 by Charles Bailey. Permission is granted
6# to distribute the revised code under the same terms as Perl itself.
f716a1dd 7
8package File::Copy;
9
3b825e41 10use 5.006;
71be2cbc 11use strict;
32450e7f 12use warnings; no warnings 'newline';
6c254d95 13use File::Spec;
96a91e01 14use Config;
e63b3379 15# During perl build, we need File::Copy but Scalar::Util might not be built yet
e55c0a82
PR
16# And then we need these games to avoid loading overload, as that will
17# confuse miniperl during the bootstrap of perl.
18my $Scalar_Util_loaded = eval q{ require Scalar::Util; require overload; 1 };
17f410f9
GS
19our(@ISA, @EXPORT, @EXPORT_OK, $VERSION, $Too_Big, $Syscopy_is_copy);
20sub copy;
21sub syscopy;
22sub cp;
23sub mv;
71be2cbc 24
86e39d7d 25$VERSION = '2.27';
f716a1dd 26
71be2cbc 27require Exporter;
28@ISA = qw(Exporter);
29@EXPORT = qw(copy move);
30@EXPORT_OK = qw(cp mv);
f716a1dd 31
441496b2 32$Too_Big = 1024 * 1024 * 2;
f716a1dd 33
8878f897
T
34sub croak {
35 require Carp;
36 goto &Carp::croak;
37}
38
754f2cd0
MS
39sub carp {
40 require Carp;
41 goto &Carp::carp;
42}
43
fc06fdeb
JM
44# Look up the feature settings on VMS using VMS::Feature when available.
45
46my $use_vms_feature = 0;
47BEGIN {
48 if ($^O eq 'VMS') {
37930f0f 49 if (eval { local $SIG{__DIE__}; require VMS::Feature; }) {
fc06fdeb
JM
50 $use_vms_feature = 1;
51 }
52 }
53}
54
55# Need to look up the UNIX report mode. This may become a dynamic mode
56# in the future.
57sub _vms_unix_rpt {
58 my $unix_rpt;
59 if ($use_vms_feature) {
60 $unix_rpt = VMS::Feature::current("filename_unix_report");
61 } else {
62 my $env_unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || '';
5da2a9e6 63 $unix_rpt = $env_unix_rpt =~ /^[ET1]/i;
fc06fdeb
JM
64 }
65 return $unix_rpt;
66}
67
68# Need to look up the EFS character set mode. This may become a dynamic
69# mode in the future.
70sub _vms_efs {
71 my $efs;
72 if ($use_vms_feature) {
73 $efs = VMS::Feature::current("efs_charset");
74 } else {
75 my $env_efs = $ENV{'DECC$EFS_CHARSET'} || '';
5da2a9e6 76 $efs = $env_efs =~ /^[ET1]/i;
fc06fdeb
JM
77 }
78 return $efs;
79}
80
81
6c254d95 82sub _catname {
71be2cbc 83 my($from, $to) = @_;
84 if (not defined &basename) {
85 require File::Basename;
86 import File::Basename 'basename';
87 }
6c254d95 88
6c254d95 89 return File::Spec->catfile($to, basename($from));
f716a1dd 90}
91
236a0738 92# _eq($from, $to) tells whether $from and $to are identical
236a0738 93sub _eq {
e55c0a82
PR
94 my ($from, $to) = map {
95 $Scalar_Util_loaded && Scalar::Util::blessed($_)
96 && overload::Method($_, q{""})
97 ? "$_"
98 : $_
99 } (@_);
100 return '' if ( (ref $from) xor (ref $to) );
101 return $from == $to if ref $from;
102 return $from eq $to;
236a0738
AF
103}
104
f716a1dd 105sub copy {
71be2cbc 106 croak("Usage: copy(FROM, TO [, BUFFERSIZE]) ")
f716a1dd 107 unless(@_ == 2 || @_ == 3);
108
109 my $from = shift;
110 my $to = shift;
71be2cbc 111
671637fe
NC
112 my $size;
113 if (@_) {
114 $size = shift(@_) + 0;
115 croak("Bad buffer size for copy: $size\n") unless ($size > 0);
116 }
117
71be2cbc 118 my $from_a_handle = (ref($from)
119 ? (ref($from) eq 'GLOB'
d704f39a
MG
120 || UNIVERSAL::isa($from, 'GLOB')
121 || UNIVERSAL::isa($from, 'IO::Handle'))
71be2cbc 122 : (ref(\$from) eq 'GLOB'));
123 my $to_a_handle = (ref($to)
124 ? (ref($to) eq 'GLOB'
d704f39a
MG
125 || UNIVERSAL::isa($to, 'GLOB')
126 || UNIVERSAL::isa($to, 'IO::Handle'))
71be2cbc 127 : (ref(\$to) eq 'GLOB'));
128
236a0738 129 if (_eq($from, $to)) { # works for references, too
754f2cd0 130 carp("'$from' and '$to' are identical (not copied)");
39b80fd9 131 return 0;
96a91e01 132 }
133
43ddfa56
TC
134 if (!$from_a_handle && !$to_a_handle && -d $to && ! -d $from) {
135 $to = _catname($from, $to);
136 }
137
ac7b122d 138 if ((($Config{d_symlink} && $Config{d_readlink}) || $Config{d_link}) &&
4c38808d 139 !($^O eq 'MSWin32' || $^O eq 'os2')) {
ac7b122d
SR
140 my @fs = stat($from);
141 if (@fs) {
96a91e01 142 my @ts = stat($to);
16f708c9 143 if (@ts && $fs[0] == $ts[0] && $fs[1] == $ts[1] && !-p $from) {
754f2cd0
MS
144 carp("'$from' and '$to' are identical (not copied)");
145 return 0;
96a91e01 146 }
147 }
148 }
a0084943
SH
149 elsif (_eq($from, $to)) {
150 carp("'$from' and '$to' are identical (not copied)");
151 return 0;
152 }
96a91e01 153
1a04d035 154 if (defined &syscopy && !$Syscopy_is_copy
e6434134 155 && !$to_a_handle
1d84e8df 156 && !($from_a_handle && $^O eq 'os2' ) # OS/2 cannot handle handles
7509b657 157 && !($from_a_handle && $^O eq 'MSWin32')
2986a63f 158 && !($from_a_handle && $^O eq 'NetWare')
1a04d035 159 )
71be2cbc 160 {
4c38808d
JM
161 my $copy_to = $to;
162
163 if ($^O eq 'VMS' && -e $from) {
164
165 if (! -d $to && ! -d $from) {
166
fc06fdeb
JM
167 my $vms_efs = _vms_efs();
168 my $unix_rpt = _vms_unix_rpt();
169 my $unix_mode = 0;
170 my $from_unix = 0;
171 $from_unix = 1 if ($from =~ /^\.\.?$/);
172 my $from_vms = 0;
173 $from_vms = 1 if ($from =~ m#[\[<\]]#);
174
175 # Need to know if we are in Unix mode.
176 if ($from_vms == $from_unix) {
177 $unix_mode = $unix_rpt;
178 } else {
179 $unix_mode = $from_unix;
180 }
181
4c38808d
JM
182 # VMS has sticky defaults on extensions, which means that
183 # if there is a null extension on the destination file, it
184 # will inherit the extension of the source file
185 # So add a '.' for a null extension.
186
fc06fdeb
JM
187 # In unix_rpt mode, the trailing dot should not be added.
188
189 if ($vms_efs) {
190 $copy_to = $to;
191 } else {
192 $copy_to = VMS::Filespec::vmsify($to);
193 }
4c38808d 194 my ($vol, $dirs, $file) = File::Spec->splitpath($copy_to);
fc06fdeb
JM
195 $file = $file . '.'
196 unless (($file =~ /(?<!\^)\./) || $unix_rpt);
4c38808d
JM
197 $copy_to = File::Spec->catpath($vol, $dirs, $file);
198
199 # Get rid of the old versions to be like UNIX
200 1 while unlink $copy_to;
201 }
202 }
203
079cb8cc 204 return syscopy($from, $copy_to) || 0;
71be2cbc 205 }
206
207 my $closefrom = 0;
208 my $closeto = 0;
671637fe 209 my ($status, $r, $buf);
48a5c399 210 local($\) = '';
f716a1dd 211
23ba2776 212 my $from_h;
71be2cbc 213 if ($from_a_handle) {
23ba2776 214 $from_h = $from;
f716a1dd 215 } else {
cfa308ca 216 open $from_h, "<", $from or goto fail_open1;
23ba2776 217 binmode $from_h or die "($!,$^E)";
e63b3379 218 $closefrom = 1;
1a04d035
A
219 }
220
671637fe
NC
221 # Seems most logical to do this here, in case future changes would want to
222 # make this croak for some reason.
223 unless (defined $size) {
224 $size = tied(*$from_h) ? 0 : -s $from_h || 0;
225 $size = 1024 if ($size < 512);
226 $size = $Too_Big if ($size > $Too_Big);
227 }
228
23ba2776 229 my $to_h;
71be2cbc 230 if ($to_a_handle) {
23ba2776 231 $to_h = $to;
1a04d035 232 } else {
fff5c6e2 233 $to_h = \do { local *FH }; # XXX is this line obsolete?
e63b3379 234 open $to_h, ">", $to or goto fail_open2;
91ca337e 235 binmode $to_h or die "($!,$^E)";
71be2cbc 236 $closeto = 1;
1a04d035 237 }
f716a1dd 238
71be2cbc 239 $! = 0;
240 for (;;) {
241 my ($r, $w, $t);
23ba2776 242 defined($r = sysread($from_h, $buf, $size))
71be2cbc 243 or goto fail_inner;
244 last unless $r;
245 for ($w = 0; $w < $r; $w += $t) {
23ba2776 246 $t = syswrite($to_h, $buf, $r - $w, $w)
71be2cbc 247 or goto fail_inner;
f716a1dd 248 }
249 }
71be2cbc 250
23ba2776
DW
251 close($to_h) || goto fail_open2 if $closeto;
252 close($from_h) || goto fail_open1 if $closefrom;
71be2cbc 253
48a5c399 254 # Use this idiom to avoid uninitialized value warning.
f716a1dd 255 return 1;
1a04d035 256
f716a1dd 257 # All of these contortions try to preserve error messages...
258 fail_inner:
259 if ($closeto) {
260 $status = $!;
261 $! = 0;
23ba2776 262 close $to_h;
f716a1dd 263 $! = $status unless $!;
264 }
265 fail_open2:
266 if ($closefrom) {
267 $status = $!;
268 $! = 0;
23ba2776 269 close $from_h;
f716a1dd 270 $! = $status unless $!;
271 }
272 fail_open1:
f716a1dd 273 return 0;
274}
9b957b78 275
e63b3379 276sub cp {
71be2cbc 277 my($from,$to) = @_;
e63b3379
CB
278 my(@fromstat) = stat $from;
279 my(@tostat) = stat $to;
280 my $perm;
281
282 return 0 unless copy(@_) and @fromstat;
283
284 if (@tostat) {
285 $perm = $tostat[2];
286 } else {
287 $perm = $fromstat[2] & ~(umask || 0);
288 @tostat = stat $to;
289 }
290 # Might be more robust to look for S_I* in Fcntl, but we're
291 # trying to avoid dependence on any XS-containing modules,
292 # since File::Copy is used during the Perl build.
293 $perm &= 07777;
294 if ($perm & 06000) {
295 croak("Unable to check setuid/setgid permissions for $to: $!")
296 unless @tostat;
297
298 if ($perm & 04000 and # setuid
299 $fromstat[4] != $tostat[4]) { # owner must match
300 $perm &= ~06000;
301 }
302
ed62bc33 303 if ($perm & 02000 && $> != 0) { # if not root, setgid
e63b3379
CB
304 my $ok = $fromstat[5] == $tostat[5]; # group must match
305 if ($ok) { # and we must be in group
ed62bc33 306 $ok = grep { $_ == $fromstat[5] } split /\s+/, $)
e63b3379
CB
307 }
308 $perm &= ~06000 unless $ok;
309 }
310 }
311 return 0 unless @tostat;
312 return 1 if $perm == ($tostat[2] & 07777);
313 return eval { chmod $perm, $to; } ? 1 : 0;
314}
315
316sub _move {
317 croak("Usage: move(FROM, TO) ") unless @_ == 3;
318
319 my($from,$to,$fallback) = @_;
754f2cd0 320
fa76202e 321 my($fromsz,$tosz1,$tomt1,$tosz2,$tomt2,$sts,$ossts);
441496b2 322
71be2cbc 323 if (-d $to && ! -d $from) {
324 $to = _catname($from, $to);
325 }
326
327 ($tosz1,$tomt1) = (stat($to))[7,9];
328 $fromsz = -s $from;
e6434134
IZ
329 if ($^O eq 'os2' and defined $tosz1 and defined $fromsz) {
330 # will not rename with overwrite
331 unlink $to;
332 }
4c38808d
JM
333
334 my $rename_to = $to;
335 if (-$^O eq 'VMS' && -e $from) {
336
337 if (! -d $to && ! -d $from) {
fc06fdeb
JM
338
339 my $vms_efs = _vms_efs();
340 my $unix_rpt = _vms_unix_rpt();
341 my $unix_mode = 0;
342 my $from_unix = 0;
343 $from_unix = 1 if ($from =~ /^\.\.?$/);
344 my $from_vms = 0;
345 $from_vms = 1 if ($from =~ m#[\[<\]]#);
346
347 # Need to know if we are in Unix mode.
348 if ($from_vms == $from_unix) {
349 $unix_mode = $unix_rpt;
350 } else {
351 $unix_mode = $from_unix;
352 }
353
4c38808d
JM
354 # VMS has sticky defaults on extensions, which means that
355 # if there is a null extension on the destination file, it
356 # will inherit the extension of the source file
357 # So add a '.' for a null extension.
358
fc06fdeb
JM
359 # In unix_rpt mode, the trailing dot should not be added.
360
361 if ($vms_efs) {
362 $rename_to = $to;
363 } else {
364 $rename_to = VMS::Filespec::vmsify($to);
365 }
4c38808d 366 my ($vol, $dirs, $file) = File::Spec->splitpath($rename_to);
fc06fdeb
JM
367 $file = $file . '.'
368 unless (($file =~ /(?<!\^)\./) || $unix_rpt);
4c38808d
JM
369 $rename_to = File::Spec->catpath($vol, $dirs, $file);
370
371 # Get rid of the old versions to be like UNIX
372 1 while unlink $rename_to;
373 }
374 }
375
376 return 1 if rename $from, $rename_to;
71be2cbc 377
71be2cbc 378 # Did rename return an error even though it succeeded, because $to
379 # is on a remote NFS file system, and NFS lost the server's ack?
380 return 1 if defined($fromsz) && !-e $from && # $from disappeared
381 (($tosz2,$tomt2) = (stat($to))[7,9]) && # $to's there
c9fbd0c8
JM
382 ((!defined $tosz1) || # not before or
383 ($tosz1 != $tosz2 or $tomt1 != $tomt2)) && # was changed
71be2cbc 384 $tosz2 == $fromsz; # it's all there
1a04d035 385
71be2cbc 386 ($tosz1,$tomt1) = (stat($to))[7,9]; # just in case rename did something
762548ba
MS
387
388 {
389 local $@;
390 eval {
754f2cd0 391 local $SIG{__DIE__};
e63b3379 392 $fallback->($from,$to) or die;
762548ba
MS
393 my($atime, $mtime) = (stat($from))[8,9];
394 utime($atime, $mtime, $to);
395 unlink($from) or die;
396 };
397 return 1 unless $@;
398 }
fa76202e 399 ($sts,$ossts) = ($! + 0, $^E + 0);
1a04d035 400
71be2cbc 401 ($tosz2,$tomt2) = ((stat($to))[7,9],0,0) if defined $tomt1;
402 unlink($to) if !defined($tomt1) or $tomt1 != $tomt2 or $tosz1 != $tosz2;
403 ($!,$^E) = ($sts,$ossts);
404 return 0;
441496b2 405}
9b957b78 406
e63b3379
CB
407sub move { _move(@_,\&copy); }
408sub mv { _move(@_,\&cp); }
71be2cbc 409
9b957b78 410# &syscopy is an XSUB under OS/2
1d84e8df
JH
411unless (defined &syscopy) {
412 if ($^O eq 'VMS') {
413 *syscopy = \&rmscopy;
cf2f24a4
JD
414 } elsif ($^O eq 'MSWin32' && defined &DynaLoader::boot_DynaLoader) {
415 # Win32::CopyFile() fill only work if we can load Win32.xs
7509b657
GS
416 *syscopy = sub {
417 return 0 unless @_ == 2;
418 return Win32::CopyFile(@_, 1);
419 };
1d84e8df 420 } else {
1a04d035 421 $Syscopy_is_copy = 1;
1d84e8df
JH
422 *syscopy = \&copy;
423 }
424}
f716a1dd 425
4261;
427
428__END__
a5f75d66 429
f716a1dd 430=head1 NAME
431
432File::Copy - Copy files or filehandles
433
a5f75d66 434=head1 SYNOPSIS
f716a1dd 435
5ce10329 436 use File::Copy;
f716a1dd 437
86e39d7d 438 copy("sourcefile","destinationfile") or die "Copy failed: $!";
5ce10329 439 copy("Copy.pm",\*STDOUT);
86e39d7d 440 move("/dev1/sourcefile","/dev2/destinationfile");
f716a1dd 441
78e38bb6 442 use File::Copy "cp";
f716a1dd 443
23f3aea0 444 $n = FileHandle->new("/a/file","r");
c6dfe06b 445 cp($n,"x");
f716a1dd 446
447=head1 DESCRIPTION
448
441496b2
CB
449The File::Copy module provides two basic functions, C<copy> and
450C<move>, which are useful for getting the contents of a file from
451one place to another.
452
453=over 4
454
0cdecedb
GS
455=item copy
456X<copy> X<cp>
441496b2
CB
457
458The C<copy> function takes two
f716a1dd 459parameters: a file to copy from and a file to copy to. Either
460argument may be a string, a FileHandle reference or a FileHandle
461glob. Obviously, if the first argument is a filehandle of some
462sort, it will be read from, and if it is a file I<name> it will
463be opened for reading. Likewise, the second argument will be
96a91e01 464written to (and created if need be). Trying to copy a file on top
39b80fd9 465of itself is an error.
71be2cbc 466
1f3ebc3b
A
467If the destination (second argument) already exists and is a directory,
468and the source (first argument) is not a filehandle, then the source
469file will be copied into the directory specified by the destination,
470using the same base name as the source file. It's a failure to have a
471filehandle as the source when the destination is a directory.
472
71be2cbc 473B<Note that passing in
9b957b78 474files as handles instead of names may lead to loss of information
475on some operating systems; it is recommended that you use file
e6434134 476names whenever possible.> Files are opened in binary mode where
8dcee03e 477applicable. To get a consistent behaviour when copying from a
e6434134 478filehandle to a file, use C<binmode> on the filehandle.
f716a1dd 479
480An optional third parameter can be used to specify the buffer
481size used for copying. This is the number of bytes from the
3a964d77 482first file, that will be held in memory at any given time, before
f716a1dd 483being written to the second file. The default buffer size depends
338de517 484upon the file, but will generally be the whole file (up to 2MB), or
f716a1dd 4851k for filehandles that do not reference files (eg. sockets).
486
e63b3379
CB
487You may use the syntax C<use File::Copy "cp"> to get at the C<cp>
488alias for this function. The syntax is I<exactly> the same. The
402c5d17 489behavior is nearly the same as well: as of version 2.15, C<cp> will
e63b3379
CB
490preserve the source file's permission bits like the shell utility
491C<cp(1)> would do, while C<copy> uses the default permissions for the
492target file (which may depend on the process' C<umask>, file
493ownership, inherited ACLs, etc.). If an error occurs in setting
494permissions, C<cp> will return 0, regardless of whether the file was
495successfully copied.
9c76cba2 496
0cdecedb
GS
497=item move
498X<move> X<mv> X<rename>
441496b2
CB
499
500The C<move> function also takes two parameters: the current name
71be2cbc 501and the intended name of the file to be moved. If the destination
502already exists and is a directory, and the source is not a
503directory, then the source file will be renamed into the directory
504specified by the destination.
505
506If possible, move() will simply rename the file. Otherwise, it copies
507the file to the new location and deletes the original. If an error occurs
508during this copy-and-delete process, you may be left with a (possibly partial)
441496b2
CB
509copy of the file under the destination name.
510
e63b3379 511You may use the C<mv> alias for this function in the same way that
402c5d17 512you may use the C<cp> alias for C<copy>.
441496b2 513
0cdecedb
GS
514=item syscopy
515X<syscopy>
441496b2 516
9b957b78 517File::Copy also provides the C<syscopy> routine, which copies the
518file specified in the first parameter to the file specified in the
519second parameter, preserving OS-specific attributes and file
520structure. For Unix systems, this is equivalent to the simple
f1442e8b
SB
521C<copy> routine, which doesn't preserve OS-specific attributes. For
522VMS systems, this calls the C<rmscopy> routine (see below). For OS/2
523systems, this calls the C<syscopy> XSUB directly. For Win32 systems,
524this calls C<Win32::CopyFile>.
9b957b78 525
338de517 526B<Special behaviour if C<syscopy> is defined (OS/2, VMS and Win32)>:
9b957b78 527
71be2cbc 528If both arguments to C<copy> are not file handles,
529then C<copy> will perform a "system copy" of
9b957b78 530the input file to a new output file, in order to preserve file
531attributes, indexed file structure, I<etc.> The buffer size
71be2cbc 532parameter is ignored. If either argument to C<copy> is a
533handle to an opened file, then data is copied using Perl
9b957b78 534operators, and no effort is made to preserve file attributes
535or record structure.
536
55497cff 537The system copy routine may also be called directly under VMS and OS/2
538as C<File::Copy::syscopy> (or under VMS as C<File::Copy::rmscopy>, which
71be2cbc 539is the routine that does the actual work for syscopy).
9b957b78 540
541=item rmscopy($from,$to[,$date_flag])
0cdecedb 542X<rmscopy>
9b957b78 543
71be2cbc 544The first and second arguments may be strings, typeglobs, typeglob
545references, or objects inheriting from IO::Handle;
546they are used in all cases to obtain the
9b957b78 547I<filespec> of the input and output files, respectively. The
548name and type of the input file are used as defaults for the
549output file, if necessary.
550
551A new version of the output file is always created, which
552inherits the structure and RMS attributes of the input file,
553except for owner and protections (and possibly timestamps;
554see below). All data from the input file is copied to the
555output file; if either of the first two parameters to C<rmscopy>
556is a file handle, its position is unchanged. (Note that this
557means a file handle pointing to the output file will be
558associated with an old version of that file after C<rmscopy>
559returns, not the newly created version.)
560
561The third parameter is an integer flag, which tells C<rmscopy>
1fef88e7
JM
562how to handle timestamps. If it is E<lt> 0, none of the input file's
563timestamps are propagated to the output file. If it is E<gt> 0, then
9b957b78 564it is interpreted as a bitmask: if bit 0 (the LSB) is set, then
565timestamps other than the revision date are propagated; if bit 1
566is set, the revision date is propagated. If the third parameter
567to C<rmscopy> is 0, then it behaves much like the DCL COPY command:
568if the name or type of the output file was explicitly specified,
569then no timestamps are propagated, but if they were taken implicitly
570from the input filespec, then all timestamps other than the
571revision date are propagated. If this parameter is not supplied,
572it defaults to 0.
573
574Like C<copy>, C<rmscopy> returns 1 on success. If an error occurs,
575it sets C<$!>, deletes the output file, and returns 0.
576
55497cff 577=back
578
f716a1dd 579=head1 RETURN
580
441496b2
CB
581All functions return 1 on success, 0 on failure.
582$! will be set if an error was encountered.
f716a1dd 583
584=head1 AUTHOR
585
441496b2 586File::Copy was written by Aaron Sherman I<E<lt>ajs@ajs.comE<gt>> in 1995,
bd3fa61c 587and updated by Charles Bailey I<E<lt>bailey@newman.upenn.eduE<gt>> in 1996.
f716a1dd 588
589=cut
441496b2 590