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