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