This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #5634] CPAN.pm v1.59 chdirs before looking for perl
[perl5.git] / lib / File / Copy.pm
CommitLineData
f716a1dd
PP
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
PP
5# Additions copyright 1996 by Charles Bailey. Permission is granted
6# to distribute the revised code under the same terms as Perl itself.
f716a1dd
PP
7
8package File::Copy;
9
3b825e41 10use 5.006;
71be2cbc 11use strict;
b395063c 12use warnings;
6c254d95 13use File::Spec;
96a91e01 14use Config;
17f410f9
GS
15our(@ISA, @EXPORT, @EXPORT_OK, $VERSION, $Too_Big, $Syscopy_is_copy);
16sub copy;
17sub syscopy;
18sub cp;
19sub mv;
71be2cbc
PP
20
21# Note that this module implements only *part* of the API defined by
22# the File/Copy.pm module of the File-Tools-2.0 package. However, that
23# package has not yet been updated to work with Perl 5.004, and so it
24# would be a Bad Thing for the CPAN module to grab it and replace this
25# module. Therefore, we set this module's version higher than 2.0.
8878f897 26$VERSION = '2.08_01';
f716a1dd 27
71be2cbc
PP
28require Exporter;
29@ISA = qw(Exporter);
30@EXPORT = qw(copy move);
31@EXPORT_OK = qw(cp mv);
f716a1dd 32
441496b2 33$Too_Big = 1024 * 1024 * 2;
f716a1dd 34
8878f897
T
35sub croak {
36 require Carp;
37 goto &Carp::croak;
38}
39
bcdb689b
JH
40my $macfiles;
41if ($^O eq 'MacOS') {
42 $macfiles = eval { require Mac::MoreFiles };
43 warn 'Mac::MoreFiles could not be loaded; using non-native syscopy'
3a2263fe 44 if $@ && $^W;
bcdb689b
JH
45}
46
6c254d95 47sub _catname {
71be2cbc
PP
48 my($from, $to) = @_;
49 if (not defined &basename) {
50 require File::Basename;
51 import File::Basename 'basename';
52 }
6c254d95
CN
53
54 if ($^O eq 'MacOS') {
55 # a partial dir name that's valid only in the cwd (e.g. 'tmp')
56 $to = ':' . $to if $to !~ /:/;
57 }
58
59 return File::Spec->catfile($to, basename($from));
f716a1dd
PP
60}
61
62sub copy {
71be2cbc 63 croak("Usage: copy(FROM, TO [, BUFFERSIZE]) ")
f716a1dd
PP
64 unless(@_ == 2 || @_ == 3);
65
66 my $from = shift;
67 my $to = shift;
71be2cbc
PP
68
69 my $from_a_handle = (ref($from)
70 ? (ref($from) eq 'GLOB'
d704f39a
G
71 || UNIVERSAL::isa($from, 'GLOB')
72 || UNIVERSAL::isa($from, 'IO::Handle'))
71be2cbc
PP
73 : (ref(\$from) eq 'GLOB'));
74 my $to_a_handle = (ref($to)
75 ? (ref($to) eq 'GLOB'
d704f39a
G
76 || UNIVERSAL::isa($to, 'GLOB')
77 || UNIVERSAL::isa($to, 'IO::Handle'))
71be2cbc
PP
78 : (ref(\$to) eq 'GLOB'));
79
96a91e01 80 if ($from eq $to) { # works for references, too
81 croak("'$from' and '$to' are identical (not copied)");
82 }
83
ac7b122d 84 if ((($Config{d_symlink} && $Config{d_readlink}) || $Config{d_link}) &&
b8ccb221 85 !($^O eq 'MSWin32' || $^O eq 'os2' || $^O eq 'vms')) {
ac7b122d
SR
86 my @fs = stat($from);
87 if (@fs) {
96a91e01 88 my @ts = stat($to);
ac7b122d 89 if (@ts && $fs[0] == $ts[0] && $fs[1] == $ts[1]) {
96a91e01 90 croak("'$from' and '$to' are identical (not copied)");
91 }
92 }
93 }
94
71be2cbc
PP
95 if (!$from_a_handle && !$to_a_handle && -d $to && ! -d $from) {
96 $to = _catname($from, $to);
97 }
98
1a04d035 99 if (defined &syscopy && !$Syscopy_is_copy
e6434134 100 && !$to_a_handle
1d84e8df
JH
101 && !($from_a_handle && $^O eq 'os2' ) # OS/2 cannot handle handles
102 && !($from_a_handle && $^O eq 'mpeix') # and neither can MPE/iX.
7509b657 103 && !($from_a_handle && $^O eq 'MSWin32')
fa648be5 104 && !($from_a_handle && $^O eq 'MacOS')
2986a63f 105 && !($from_a_handle && $^O eq 'NetWare')
1a04d035 106 )
71be2cbc
PP
107 {
108 return syscopy($from, $to);
109 }
110
111 my $closefrom = 0;
112 my $closeto = 0;
f716a1dd 113 my ($size, $status, $r, $buf);
48a5c399 114 local($\) = '';
f716a1dd 115
23ba2776 116 my $from_h;
71be2cbc 117 if ($from_a_handle) {
23ba2776 118 $from_h = $from;
f716a1dd 119 } else {
fa648be5 120 $from = _protect($from) if $from =~ /^\s/s;
23ba2776
WD
121 $from_h = \do { local *FH };
122 open($from_h, "< $from\0") or goto fail_open1;
123 binmode $from_h or die "($!,$^E)";
f716a1dd 124 $closefrom = 1;
1a04d035
A
125 }
126
23ba2776 127 my $to_h;
71be2cbc 128 if ($to_a_handle) {
23ba2776 129 $to_h = $to;
1a04d035 130 } else {
fa648be5 131 $to = _protect($to) if $to =~ /^\s/s;
23ba2776
WD
132 $to_h = \do { local *FH };
133 open($to_h,"> $to\0") or goto fail_open2;
134 binmode $to_h or die "($!,$^E)";
71be2cbc 135 $closeto = 1;
1a04d035 136 }
f716a1dd
PP
137
138 if (@_) {
139 $size = shift(@_) + 0;
140 croak("Bad buffer size for copy: $size\n") unless ($size > 0);
141 } else {
025a6ea3 142 $size = tied(*$from_h) ? 0 : -s $from_h || 0;
f716a1dd 143 $size = 1024 if ($size < 512);
441496b2 144 $size = $Too_Big if ($size > $Too_Big);
f716a1dd
PP
145 }
146
71be2cbc
PP
147 $! = 0;
148 for (;;) {
149 my ($r, $w, $t);
23ba2776 150 defined($r = sysread($from_h, $buf, $size))
71be2cbc
PP
151 or goto fail_inner;
152 last unless $r;
153 for ($w = 0; $w < $r; $w += $t) {
23ba2776 154 $t = syswrite($to_h, $buf, $r - $w, $w)
71be2cbc 155 or goto fail_inner;
f716a1dd
PP
156 }
157 }
71be2cbc 158
23ba2776
WD
159 close($to_h) || goto fail_open2 if $closeto;
160 close($from_h) || goto fail_open1 if $closefrom;
71be2cbc 161
48a5c399 162 # Use this idiom to avoid uninitialized value warning.
f716a1dd 163 return 1;
1a04d035 164
f716a1dd
PP
165 # All of these contortions try to preserve error messages...
166 fail_inner:
167 if ($closeto) {
168 $status = $!;
169 $! = 0;
23ba2776 170 close $to_h;
f716a1dd
PP
171 $! = $status unless $!;
172 }
173 fail_open2:
174 if ($closefrom) {
175 $status = $!;
176 $! = 0;
23ba2776 177 close $from_h;
f716a1dd
PP
178 $! = $status unless $!;
179 }
180 fail_open1:
f716a1dd
PP
181 return 0;
182}
9b957b78 183
441496b2 184sub move {
71be2cbc 185 my($from,$to) = @_;
fa76202e 186 my($fromsz,$tosz1,$tomt1,$tosz2,$tomt2,$sts,$ossts);
441496b2 187
71be2cbc
PP
188 if (-d $to && ! -d $from) {
189 $to = _catname($from, $to);
190 }
191
192 ($tosz1,$tomt1) = (stat($to))[7,9];
193 $fromsz = -s $from;
e6434134
IZ
194 if ($^O eq 'os2' and defined $tosz1 and defined $fromsz) {
195 # will not rename with overwrite
196 unlink $to;
197 }
71be2cbc
PP
198 return 1 if rename $from, $to;
199
71be2cbc
PP
200 # Did rename return an error even though it succeeded, because $to
201 # is on a remote NFS file system, and NFS lost the server's ack?
202 return 1 if defined($fromsz) && !-e $from && # $from disappeared
203 (($tosz2,$tomt2) = (stat($to))[7,9]) && # $to's there
204 ($tosz1 != $tosz2 or $tomt1 != $tomt2) && # and changed
205 $tosz2 == $fromsz; # it's all there
1a04d035 206
71be2cbc 207 ($tosz1,$tomt1) = (stat($to))[7,9]; # just in case rename did something
762548ba
MS
208
209 {
210 local $@;
211 eval {
212 copy($from,$to) or die;
213 my($atime, $mtime) = (stat($from))[8,9];
214 utime($atime, $mtime, $to);
215 unlink($from) or die;
216 };
217 return 1 unless $@;
218 }
fa76202e 219 ($sts,$ossts) = ($! + 0, $^E + 0);
1a04d035 220
71be2cbc
PP
221 ($tosz2,$tomt2) = ((stat($to))[7,9],0,0) if defined $tomt1;
222 unlink($to) if !defined($tomt1) or $tomt1 != $tomt2 or $tosz1 != $tosz2;
223 ($!,$^E) = ($sts,$ossts);
224 return 0;
441496b2 225}
9b957b78 226
71be2cbc
PP
227*cp = \&copy;
228*mv = \&move;
229
fa648be5
CN
230
231if ($^O eq 'MacOS') {
232 *_protect = sub { MacPerl::MakeFSSpec($_[0]) };
233} else {
234 *_protect = sub { "./$_[0]" };
235}
236
9b957b78 237# &syscopy is an XSUB under OS/2
1d84e8df
JH
238unless (defined &syscopy) {
239 if ($^O eq 'VMS') {
240 *syscopy = \&rmscopy;
241 } elsif ($^O eq 'mpeix') {
242 *syscopy = sub {
3f5ee302 243 return 0 unless @_ == 2;
1d84e8df
JH
244 # Use the MPE cp program in order to
245 # preserve MPE file attributes.
246 return system('/bin/cp', '-f', $_[0], $_[1]) == 0;
247 };
7509b657
GS
248 } elsif ($^O eq 'MSWin32') {
249 *syscopy = sub {
250 return 0 unless @_ == 2;
251 return Win32::CopyFile(@_, 1);
252 };
bcdb689b 253 } elsif ($macfiles) {
fa648be5
CN
254 *syscopy = sub {
255 my($from, $to) = @_;
256 my($dir, $toname);
257
258 return 0 unless -e $from;
259
260 if ($to =~ /(.*:)([^:]+):?$/) {
261 ($dir, $toname) = ($1, $2);
262 } else {
263 ($dir, $toname) = (":", $to);
264 }
265
266 unlink($to);
267 Mac::MoreFiles::FSpFileCopy($from, $dir, $toname, 1);
268 };
1d84e8df 269 } else {
1a04d035 270 $Syscopy_is_copy = 1;
1d84e8df
JH
271 *syscopy = \&copy;
272 }
273}
f716a1dd
PP
274
2751;
276
277__END__
a5f75d66 278
f716a1dd
PP
279=head1 NAME
280
281File::Copy - Copy files or filehandles
282
a5f75d66 283=head1 SYNOPSIS
f716a1dd 284
5ce10329 285 use File::Copy;
f716a1dd 286
5ce10329
NC
287 copy("file1","file2") or die "Copy failed: $!";
288 copy("Copy.pm",\*STDOUT);
441496b2 289 move("/dev1/fileA","/dev2/fileB");
f716a1dd 290
78e38bb6 291 use File::Copy "cp";
f716a1dd 292
23f3aea0 293 $n = FileHandle->new("/a/file","r");
c6dfe06b 294 cp($n,"x");
f716a1dd
PP
295
296=head1 DESCRIPTION
297
441496b2
CB
298The File::Copy module provides two basic functions, C<copy> and
299C<move>, which are useful for getting the contents of a file from
300one place to another.
301
302=over 4
303
304=item *
305
306The C<copy> function takes two
f716a1dd
PP
307parameters: a file to copy from and a file to copy to. Either
308argument may be a string, a FileHandle reference or a FileHandle
309glob. Obviously, if the first argument is a filehandle of some
310sort, it will be read from, and if it is a file I<name> it will
311be opened for reading. Likewise, the second argument will be
96a91e01 312written to (and created if need be). Trying to copy a file on top
313of itself is a fatal error.
71be2cbc
PP
314
315B<Note that passing in
9b957b78
PP
316files as handles instead of names may lead to loss of information
317on some operating systems; it is recommended that you use file
e6434134 318names whenever possible.> Files are opened in binary mode where
8dcee03e 319applicable. To get a consistent behaviour when copying from a
e6434134 320filehandle to a file, use C<binmode> on the filehandle.
f716a1dd
PP
321
322An optional third parameter can be used to specify the buffer
323size used for copying. This is the number of bytes from the
324first file, that wil be held in memory at any given time, before
325being written to the second file. The default buffer size depends
326upon the file, but will generally be the whole file (up to 2Mb), or
3271k for filehandles that do not reference files (eg. sockets).
328
329You may use the syntax C<use File::Copy "cp"> to get at the
330"cp" alias for this function. The syntax is I<exactly> the same.
331
441496b2
CB
332=item *
333
334The C<move> function also takes two parameters: the current name
71be2cbc
PP
335and the intended name of the file to be moved. If the destination
336already exists and is a directory, and the source is not a
337directory, then the source file will be renamed into the directory
338specified by the destination.
339
340If possible, move() will simply rename the file. Otherwise, it copies
341the file to the new location and deletes the original. If an error occurs
342during this copy-and-delete process, you may be left with a (possibly partial)
441496b2
CB
343copy of the file under the destination name.
344
345You may use the "mv" alias for this function in the same way that
346you may use the "cp" alias for C<copy>.
347
348=back
349
9b957b78
PP
350File::Copy also provides the C<syscopy> routine, which copies the
351file specified in the first parameter to the file specified in the
352second parameter, preserving OS-specific attributes and file
353structure. For Unix systems, this is equivalent to the simple
f1442e8b
SB
354C<copy> routine, which doesn't preserve OS-specific attributes. For
355VMS systems, this calls the C<rmscopy> routine (see below). For OS/2
356systems, this calls the C<syscopy> XSUB directly. For Win32 systems,
357this calls C<Win32::CopyFile>.
9b957b78 358
bcdb689b
JH
359On Mac OS (Classic), C<syscopy> calls C<Mac::MoreFiles::FSpFileCopy>,
360if available.
361
7509b657 362=head2 Special behaviour if C<syscopy> is defined (OS/2, VMS and Win32)
9b957b78 363
71be2cbc
PP
364If both arguments to C<copy> are not file handles,
365then C<copy> will perform a "system copy" of
9b957b78
PP
366the input file to a new output file, in order to preserve file
367attributes, indexed file structure, I<etc.> The buffer size
71be2cbc
PP
368parameter is ignored. If either argument to C<copy> is a
369handle to an opened file, then data is copied using Perl
9b957b78
PP
370operators, and no effort is made to preserve file attributes
371or record structure.
372
55497cff
PP
373The system copy routine may also be called directly under VMS and OS/2
374as C<File::Copy::syscopy> (or under VMS as C<File::Copy::rmscopy>, which
71be2cbc 375is the routine that does the actual work for syscopy).
9b957b78 376
441496b2 377=over 4
55497cff 378
9b957b78
PP
379=item rmscopy($from,$to[,$date_flag])
380
71be2cbc
PP
381The first and second arguments may be strings, typeglobs, typeglob
382references, or objects inheriting from IO::Handle;
383they are used in all cases to obtain the
9b957b78
PP
384I<filespec> of the input and output files, respectively. The
385name and type of the input file are used as defaults for the
386output file, if necessary.
387
388A new version of the output file is always created, which
389inherits the structure and RMS attributes of the input file,
390except for owner and protections (and possibly timestamps;
391see below). All data from the input file is copied to the
392output file; if either of the first two parameters to C<rmscopy>
393is a file handle, its position is unchanged. (Note that this
394means a file handle pointing to the output file will be
395associated with an old version of that file after C<rmscopy>
396returns, not the newly created version.)
397
398The third parameter is an integer flag, which tells C<rmscopy>
1fef88e7
JM
399how to handle timestamps. If it is E<lt> 0, none of the input file's
400timestamps are propagated to the output file. If it is E<gt> 0, then
9b957b78
PP
401it is interpreted as a bitmask: if bit 0 (the LSB) is set, then
402timestamps other than the revision date are propagated; if bit 1
403is set, the revision date is propagated. If the third parameter
404to C<rmscopy> is 0, then it behaves much like the DCL COPY command:
405if the name or type of the output file was explicitly specified,
406then no timestamps are propagated, but if they were taken implicitly
407from the input filespec, then all timestamps other than the
408revision date are propagated. If this parameter is not supplied,
409it defaults to 0.
410
411Like C<copy>, C<rmscopy> returns 1 on success. If an error occurs,
412it sets C<$!>, deletes the output file, and returns 0.
413
55497cff
PP
414=back
415
f716a1dd
PP
416=head1 RETURN
417
441496b2
CB
418All functions return 1 on success, 0 on failure.
419$! will be set if an error was encountered.
f716a1dd 420
6c254d95
CN
421=head1 NOTES
422
423=over 4
424
425=item *
426
427On Mac OS (Classic), the path separator is ':', not '/', and the
428current directory is denoted as ':', not '.'. You should be careful
429about specifying relative pathnames. While a full path always begins
430with a volume name, a relative pathname should always begin with a
431':'. If specifying a volume name only, a trailing ':' is required.
432
433E.g.
434
435 copy("file1", "tmp"); # creates the file 'tmp' in the current directory
436 copy("file1", ":tmp:"); # creates :tmp:file1
437 copy("file1", ":tmp"); # same as above
438 copy("file1", "tmp"); # same as above, if 'tmp' is a directory (but don't do
439 # that, since it may cause confusion, see example #1)
440 copy("file1", "tmp:file1"); # error, since 'tmp:' is not a volume
441 copy("file1", ":tmp:file1"); # ok, partial path
442 copy("file1", "DataHD:"); # creates DataHD:file1
443
444 move("MacintoshHD:fileA", "DataHD:fileB"); # moves (don't copies) files from one
445 # volume to another
446
447=back
448
f716a1dd
PP
449=head1 AUTHOR
450
441496b2 451File::Copy was written by Aaron Sherman I<E<lt>ajs@ajs.comE<gt>> in 1995,
bd3fa61c 452and updated by Charles Bailey I<E<lt>bailey@newman.upenn.eduE<gt>> in 1996.
f716a1dd
PP
453
454=cut
441496b2 455