This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Missed a New() -> Newx().
[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;
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 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 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 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 60}
61
62sub copy {
71be2cbc 63 croak("Usage: copy(FROM, TO [, BUFFERSIZE]) ")
f716a1dd 64 unless(@_ == 2 || @_ == 3);
65
66 my $from = shift;
67 my $to = shift;
71be2cbc 68
69 my $from_a_handle = (ref($from)
70 ? (ref($from) eq 'GLOB'
d704f39a
MG
71 || UNIVERSAL::isa($from, 'GLOB')
72 || UNIVERSAL::isa($from, 'IO::Handle'))
71be2cbc 73 : (ref(\$from) eq 'GLOB'));
74 my $to_a_handle = (ref($to)
75 ? (ref($to) eq 'GLOB'
d704f39a
MG
76 || UNIVERSAL::isa($to, 'GLOB')
77 || UNIVERSAL::isa($to, 'IO::Handle'))
71be2cbc 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 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 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
DW
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
DW
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 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 145 }
146
71be2cbc 147 $! = 0;
148 for (;;) {
149 my ($r, $w, $t);
23ba2776 150 defined($r = sysread($from_h, $buf, $size))
71be2cbc 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 156 }
157 }
71be2cbc 158
23ba2776
DW
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 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 171 $! = $status unless $!;
172 }
173 fail_open2:
174 if ($closefrom) {
175 $status = $!;
176 $! = 0;
23ba2776 177 close $from_h;
f716a1dd 178 $! = $status unless $!;
179 }
180 fail_open1:
f716a1dd 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 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 198 return 1 if rename $from, $to;
199
71be2cbc 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
fa76202e
EA
208 return 1 if copy($from,$to) && unlink($from);
209 ($sts,$ossts) = ($! + 0, $^E + 0);
1a04d035 210
71be2cbc 211 ($tosz2,$tomt2) = ((stat($to))[7,9],0,0) if defined $tomt1;
212 unlink($to) if !defined($tomt1) or $tomt1 != $tomt2 or $tosz1 != $tosz2;
213 ($!,$^E) = ($sts,$ossts);
214 return 0;
441496b2 215}
9b957b78 216
71be2cbc 217*cp = \&copy;
218*mv = \&move;
219
fa648be5
CN
220
221if ($^O eq 'MacOS') {
222 *_protect = sub { MacPerl::MakeFSSpec($_[0]) };
223} else {
224 *_protect = sub { "./$_[0]" };
225}
226
9b957b78 227# &syscopy is an XSUB under OS/2
1d84e8df
JH
228unless (defined &syscopy) {
229 if ($^O eq 'VMS') {
230 *syscopy = \&rmscopy;
231 } elsif ($^O eq 'mpeix') {
232 *syscopy = sub {
3f5ee302 233 return 0 unless @_ == 2;
1d84e8df
JH
234 # Use the MPE cp program in order to
235 # preserve MPE file attributes.
236 return system('/bin/cp', '-f', $_[0], $_[1]) == 0;
237 };
7509b657
GS
238 } elsif ($^O eq 'MSWin32') {
239 *syscopy = sub {
240 return 0 unless @_ == 2;
241 return Win32::CopyFile(@_, 1);
242 };
bcdb689b 243 } elsif ($macfiles) {
fa648be5
CN
244 *syscopy = sub {
245 my($from, $to) = @_;
246 my($dir, $toname);
247
248 return 0 unless -e $from;
249
250 if ($to =~ /(.*:)([^:]+):?$/) {
251 ($dir, $toname) = ($1, $2);
252 } else {
253 ($dir, $toname) = (":", $to);
254 }
255
256 unlink($to);
257 Mac::MoreFiles::FSpFileCopy($from, $dir, $toname, 1);
258 };
1d84e8df 259 } else {
1a04d035 260 $Syscopy_is_copy = 1;
1d84e8df
JH
261 *syscopy = \&copy;
262 }
263}
f716a1dd 264
2651;
266
267__END__
a5f75d66 268
f716a1dd 269=head1 NAME
270
271File::Copy - Copy files or filehandles
272
a5f75d66 273=head1 SYNOPSIS
f716a1dd 274
5ce10329 275 use File::Copy;
f716a1dd 276
5ce10329
NC
277 copy("file1","file2") or die "Copy failed: $!";
278 copy("Copy.pm",\*STDOUT);
441496b2 279 move("/dev1/fileA","/dev2/fileB");
f716a1dd 280
78e38bb6 281 use File::Copy "cp";
f716a1dd 282
23f3aea0 283 $n = FileHandle->new("/a/file","r");
c6dfe06b 284 cp($n,"x");
f716a1dd 285
286=head1 DESCRIPTION
287
441496b2
CB
288The File::Copy module provides two basic functions, C<copy> and
289C<move>, which are useful for getting the contents of a file from
290one place to another.
291
292=over 4
293
294=item *
295
296The C<copy> function takes two
f716a1dd 297parameters: a file to copy from and a file to copy to. Either
298argument may be a string, a FileHandle reference or a FileHandle
299glob. Obviously, if the first argument is a filehandle of some
300sort, it will be read from, and if it is a file I<name> it will
301be opened for reading. Likewise, the second argument will be
96a91e01 302written to (and created if need be). Trying to copy a file on top
303of itself is a fatal error.
71be2cbc 304
305B<Note that passing in
9b957b78 306files as handles instead of names may lead to loss of information
307on some operating systems; it is recommended that you use file
e6434134 308names whenever possible.> Files are opened in binary mode where
8dcee03e 309applicable. To get a consistent behaviour when copying from a
e6434134 310filehandle to a file, use C<binmode> on the filehandle.
f716a1dd 311
312An optional third parameter can be used to specify the buffer
313size used for copying. This is the number of bytes from the
314first file, that wil be held in memory at any given time, before
315being written to the second file. The default buffer size depends
316upon the file, but will generally be the whole file (up to 2Mb), or
3171k for filehandles that do not reference files (eg. sockets).
318
319You may use the syntax C<use File::Copy "cp"> to get at the
320"cp" alias for this function. The syntax is I<exactly> the same.
321
441496b2
CB
322=item *
323
324The C<move> function also takes two parameters: the current name
71be2cbc 325and the intended name of the file to be moved. If the destination
326already exists and is a directory, and the source is not a
327directory, then the source file will be renamed into the directory
328specified by the destination.
329
330If possible, move() will simply rename the file. Otherwise, it copies
331the file to the new location and deletes the original. If an error occurs
332during this copy-and-delete process, you may be left with a (possibly partial)
441496b2
CB
333copy of the file under the destination name.
334
335You may use the "mv" alias for this function in the same way that
336you may use the "cp" alias for C<copy>.
337
338=back
339
9b957b78 340File::Copy also provides the C<syscopy> routine, which copies the
341file specified in the first parameter to the file specified in the
342second parameter, preserving OS-specific attributes and file
343structure. For Unix systems, this is equivalent to the simple
f1442e8b
SB
344C<copy> routine, which doesn't preserve OS-specific attributes. For
345VMS systems, this calls the C<rmscopy> routine (see below). For OS/2
346systems, this calls the C<syscopy> XSUB directly. For Win32 systems,
347this calls C<Win32::CopyFile>.
9b957b78 348
bcdb689b
JH
349On Mac OS (Classic), C<syscopy> calls C<Mac::MoreFiles::FSpFileCopy>,
350if available.
351
7509b657 352=head2 Special behaviour if C<syscopy> is defined (OS/2, VMS and Win32)
9b957b78 353
71be2cbc 354If both arguments to C<copy> are not file handles,
355then C<copy> will perform a "system copy" of
9b957b78 356the input file to a new output file, in order to preserve file
357attributes, indexed file structure, I<etc.> The buffer size
71be2cbc 358parameter is ignored. If either argument to C<copy> is a
359handle to an opened file, then data is copied using Perl
9b957b78 360operators, and no effort is made to preserve file attributes
361or record structure.
362
55497cff 363The system copy routine may also be called directly under VMS and OS/2
364as C<File::Copy::syscopy> (or under VMS as C<File::Copy::rmscopy>, which
71be2cbc 365is the routine that does the actual work for syscopy).
9b957b78 366
441496b2 367=over 4
55497cff 368
9b957b78 369=item rmscopy($from,$to[,$date_flag])
370
71be2cbc 371The first and second arguments may be strings, typeglobs, typeglob
372references, or objects inheriting from IO::Handle;
373they are used in all cases to obtain the
9b957b78 374I<filespec> of the input and output files, respectively. The
375name and type of the input file are used as defaults for the
376output file, if necessary.
377
378A new version of the output file is always created, which
379inherits the structure and RMS attributes of the input file,
380except for owner and protections (and possibly timestamps;
381see below). All data from the input file is copied to the
382output file; if either of the first two parameters to C<rmscopy>
383is a file handle, its position is unchanged. (Note that this
384means a file handle pointing to the output file will be
385associated with an old version of that file after C<rmscopy>
386returns, not the newly created version.)
387
388The third parameter is an integer flag, which tells C<rmscopy>
1fef88e7
JM
389how to handle timestamps. If it is E<lt> 0, none of the input file's
390timestamps are propagated to the output file. If it is E<gt> 0, then
9b957b78 391it is interpreted as a bitmask: if bit 0 (the LSB) is set, then
392timestamps other than the revision date are propagated; if bit 1
393is set, the revision date is propagated. If the third parameter
394to C<rmscopy> is 0, then it behaves much like the DCL COPY command:
395if the name or type of the output file was explicitly specified,
396then no timestamps are propagated, but if they were taken implicitly
397from the input filespec, then all timestamps other than the
398revision date are propagated. If this parameter is not supplied,
399it defaults to 0.
400
401Like C<copy>, C<rmscopy> returns 1 on success. If an error occurs,
402it sets C<$!>, deletes the output file, and returns 0.
403
55497cff 404=back
405
f716a1dd 406=head1 RETURN
407
441496b2
CB
408All functions return 1 on success, 0 on failure.
409$! will be set if an error was encountered.
f716a1dd 410
6c254d95
CN
411=head1 NOTES
412
413=over 4
414
415=item *
416
417On Mac OS (Classic), the path separator is ':', not '/', and the
418current directory is denoted as ':', not '.'. You should be careful
419about specifying relative pathnames. While a full path always begins
420with a volume name, a relative pathname should always begin with a
421':'. If specifying a volume name only, a trailing ':' is required.
422
423E.g.
424
425 copy("file1", "tmp"); # creates the file 'tmp' in the current directory
426 copy("file1", ":tmp:"); # creates :tmp:file1
427 copy("file1", ":tmp"); # same as above
428 copy("file1", "tmp"); # same as above, if 'tmp' is a directory (but don't do
429 # that, since it may cause confusion, see example #1)
430 copy("file1", "tmp:file1"); # error, since 'tmp:' is not a volume
431 copy("file1", ":tmp:file1"); # ok, partial path
432 copy("file1", "DataHD:"); # creates DataHD:file1
433
434 move("MacintoshHD:fileA", "DataHD:fileB"); # moves (don't copies) files from one
435 # volume to another
436
437=back
438
f716a1dd 439=head1 AUTHOR
440
441496b2 441File::Copy was written by Aaron Sherman I<E<lt>ajs@ajs.comE<gt>> in 1995,
bd3fa61c 442and updated by Charles Bailey I<E<lt>bailey@newman.upenn.eduE<gt>> in 1996.
f716a1dd 443
444=cut
441496b2 445