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