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