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.
5 # Additions copyright 1996 by Charles Bailey. Permission is granted
6 # to distribute the revised code under the same terms as Perl itself.
13 our(@ISA, @EXPORT, @EXPORT_OK, $VERSION, $Too_Big, $Syscopy_is_copy);
19 # Note that this module implements only *part* of the API defined by
20 # the File/Copy.pm module of the File-Tools-2.0 package. However, that
21 # package has not yet been updated to work with Perl 5.004, and so it
22 # would be a Bad Thing for the CPAN module to grab it and replace this
23 # module. Therefore, we set this module's version higher than 2.0.
28 @EXPORT = qw(copy move);
29 @EXPORT_OK = qw(cp mv);
31 $Too_Big = 1024 * 1024 * 2;
33 sub _catname { # Will be replaced by File::Spec when it arrives
35 if (not defined &basename) {
36 require File::Basename;
37 import File::Basename 'basename';
39 if ($^O eq 'VMS') { $to = VMS::Filespec::vmspath($to) . basename($from); }
40 elsif ($^O eq 'MacOS') { $to =~ s/^([^:]+)$/:$1/; $to .= ':' . basename($from); }
41 elsif ($to =~ m|\\|) { $to .= '\\' . basename($from); }
42 else { $to .= '/' . basename($from); }
46 croak("Usage: copy(FROM, TO [, BUFFERSIZE]) ")
47 unless(@_ == 2 || @_ == 3);
52 my $from_a_handle = (ref($from)
53 ? (ref($from) eq 'GLOB'
54 || UNIVERSAL::isa($from, 'GLOB')
55 || UNIVERSAL::isa($from, 'IO::Handle'))
56 : (ref(\$from) eq 'GLOB'));
57 my $to_a_handle = (ref($to)
59 || UNIVERSAL::isa($to, 'GLOB')
60 || UNIVERSAL::isa($to, 'IO::Handle'))
61 : (ref(\$to) eq 'GLOB'));
63 if (!$from_a_handle && !$to_a_handle && -d $to && ! -d $from) {
64 $to = _catname($from, $to);
67 if (defined &syscopy && !$Syscopy_is_copy
69 && !($from_a_handle && $^O eq 'os2' ) # OS/2 cannot handle handles
70 && !($from_a_handle && $^O eq 'mpeix') # and neither can MPE/iX.
71 && !($from_a_handle && $^O eq 'MSWin32')
72 && !($from_a_handle && $^O eq 'MacOS')
75 return syscopy($from, $to);
80 my ($size, $status, $r, $buf);
85 *FROM = *$from{FILEHANDLE};
87 $from = _protect($from) if $from =~ /^\s/s;
88 open(FROM, "< $from\0") or goto fail_open1;
89 binmode FROM or die "($!,$^E)";
94 *TO = *$to{FILEHANDLE};
96 $to = _protect($to) if $to =~ /^\s/s;
97 open(TO,"> $to\0") or goto fail_open2;
98 binmode TO or die "($!,$^E)";
103 $size = shift(@_) + 0;
104 croak("Bad buffer size for copy: $size\n") unless ($size > 0);
107 $size = 1024 if ($size < 512);
108 $size = $Too_Big if ($size > $Too_Big);
114 defined($r = sysread(FROM, $buf, $size))
117 for ($w = 0; $w < $r; $w += $t) {
118 $t = syswrite(TO, $buf, $r - $w, $w)
123 close(TO) || goto fail_open2 if $closeto;
124 close(FROM) || goto fail_open1 if $closefrom;
126 # Use this idiom to avoid uninitialized value warning.
129 # All of these contortions try to preserve error messages...
135 $! = $status unless $!;
142 $! = $status unless $!;
150 my($copied,$fromsz,$tosz1,$tomt1,$tosz2,$tomt2,$sts,$ossts);
152 if (-d $to && ! -d $from) {
153 $to = _catname($from, $to);
156 ($tosz1,$tomt1) = (stat($to))[7,9];
158 if ($^O eq 'os2' and defined $tosz1 and defined $fromsz) {
159 # will not rename with overwrite
162 return 1 if rename $from, $to;
164 ($sts,$ossts) = ($! + 0, $^E + 0);
165 # Did rename return an error even though it succeeded, because $to
166 # is on a remote NFS file system, and NFS lost the server's ack?
167 return 1 if defined($fromsz) && !-e $from && # $from disappeared
168 (($tosz2,$tomt2) = (stat($to))[7,9]) && # $to's there
169 ($tosz1 != $tosz2 or $tomt1 != $tomt2) && # and changed
170 $tosz2 == $fromsz; # it's all there
172 ($tosz1,$tomt1) = (stat($to))[7,9]; # just in case rename did something
173 return 1 if ($copied = copy($from,$to)) && unlink($from);
175 ($tosz2,$tomt2) = ((stat($to))[7,9],0,0) if defined $tomt1;
176 unlink($to) if !defined($tomt1) or $tomt1 != $tomt2 or $tosz1 != $tosz2;
177 ($!,$^E) = ($sts,$ossts);
185 if ($^O eq 'MacOS') {
186 *_protect = sub { MacPerl::MakeFSSpec($_[0]) };
188 *_protect = sub { "./$_[0]" };
191 # &syscopy is an XSUB under OS/2
192 unless (defined &syscopy) {
194 *syscopy = \&rmscopy;
195 } elsif ($^O eq 'mpeix') {
197 return 0 unless @_ == 2;
198 # Use the MPE cp program in order to
199 # preserve MPE file attributes.
200 return system('/bin/cp', '-f', $_[0], $_[1]) == 0;
202 } elsif ($^O eq 'MSWin32') {
204 return 0 unless @_ == 2;
205 return Win32::CopyFile(@_, 1);
207 } elsif ($^O eq 'MacOS') {
208 require Mac::MoreFiles;
213 return 0 unless -e $from;
215 if ($to =~ /(.*:)([^:]+):?$/) {
216 ($dir, $toname) = ($1, $2);
218 ($dir, $toname) = (":", $to);
222 Mac::MoreFiles::FSpFileCopy($from, $dir, $toname, 1);
225 $Syscopy_is_copy = 1;
236 File::Copy - Copy files or filehandles
242 copy("file1","file2");
243 copy("Copy.pm",\*STDOUT);'
244 move("/dev1/fileA","/dev2/fileB");
249 $n = FileHandle->new("/a/file","r");
254 The File::Copy module provides two basic functions, C<copy> and
255 C<move>, which are useful for getting the contents of a file from
256 one place to another.
262 The C<copy> function takes two
263 parameters: a file to copy from and a file to copy to. Either
264 argument may be a string, a FileHandle reference or a FileHandle
265 glob. Obviously, if the first argument is a filehandle of some
266 sort, it will be read from, and if it is a file I<name> it will
267 be opened for reading. Likewise, the second argument will be
268 written to (and created if need be).
270 B<Note that passing in
271 files as handles instead of names may lead to loss of information
272 on some operating systems; it is recommended that you use file
273 names whenever possible.> Files are opened in binary mode where
274 applicable. To get a consistent behaviour when copying from a
275 filehandle to a file, use C<binmode> on the filehandle.
277 An optional third parameter can be used to specify the buffer
278 size used for copying. This is the number of bytes from the
279 first file, that wil be held in memory at any given time, before
280 being written to the second file. The default buffer size depends
281 upon the file, but will generally be the whole file (up to 2Mb), or
282 1k for filehandles that do not reference files (eg. sockets).
284 You may use the syntax C<use File::Copy "cp"> to get at the
285 "cp" alias for this function. The syntax is I<exactly> the same.
289 The C<move> function also takes two parameters: the current name
290 and the intended name of the file to be moved. If the destination
291 already exists and is a directory, and the source is not a
292 directory, then the source file will be renamed into the directory
293 specified by the destination.
295 If possible, move() will simply rename the file. Otherwise, it copies
296 the file to the new location and deletes the original. If an error occurs
297 during this copy-and-delete process, you may be left with a (possibly partial)
298 copy of the file under the destination name.
300 You may use the "mv" alias for this function in the same way that
301 you may use the "cp" alias for C<copy>.
305 File::Copy also provides the C<syscopy> routine, which copies the
306 file specified in the first parameter to the file specified in the
307 second parameter, preserving OS-specific attributes and file
308 structure. For Unix systems, this is equivalent to the simple
309 C<copy> routine. For VMS systems, this calls the C<rmscopy>
310 routine (see below). For OS/2 systems, this calls the C<syscopy>
311 XSUB directly. For Win32 systems, this calls C<Win32::CopyFile>.
313 =head2 Special behaviour if C<syscopy> is defined (OS/2, VMS and Win32)
315 If both arguments to C<copy> are not file handles,
316 then C<copy> will perform a "system copy" of
317 the input file to a new output file, in order to preserve file
318 attributes, indexed file structure, I<etc.> The buffer size
319 parameter is ignored. If either argument to C<copy> is a
320 handle to an opened file, then data is copied using Perl
321 operators, and no effort is made to preserve file attributes
324 The system copy routine may also be called directly under VMS and OS/2
325 as C<File::Copy::syscopy> (or under VMS as C<File::Copy::rmscopy>, which
326 is the routine that does the actual work for syscopy).
330 =item rmscopy($from,$to[,$date_flag])
332 The first and second arguments may be strings, typeglobs, typeglob
333 references, or objects inheriting from IO::Handle;
334 they are used in all cases to obtain the
335 I<filespec> of the input and output files, respectively. The
336 name and type of the input file are used as defaults for the
337 output file, if necessary.
339 A new version of the output file is always created, which
340 inherits the structure and RMS attributes of the input file,
341 except for owner and protections (and possibly timestamps;
342 see below). All data from the input file is copied to the
343 output file; if either of the first two parameters to C<rmscopy>
344 is a file handle, its position is unchanged. (Note that this
345 means a file handle pointing to the output file will be
346 associated with an old version of that file after C<rmscopy>
347 returns, not the newly created version.)
349 The third parameter is an integer flag, which tells C<rmscopy>
350 how to handle timestamps. If it is E<lt> 0, none of the input file's
351 timestamps are propagated to the output file. If it is E<gt> 0, then
352 it is interpreted as a bitmask: if bit 0 (the LSB) is set, then
353 timestamps other than the revision date are propagated; if bit 1
354 is set, the revision date is propagated. If the third parameter
355 to C<rmscopy> is 0, then it behaves much like the DCL COPY command:
356 if the name or type of the output file was explicitly specified,
357 then no timestamps are propagated, but if they were taken implicitly
358 from the input filespec, then all timestamps other than the
359 revision date are propagated. If this parameter is not supplied,
362 Like C<copy>, C<rmscopy> returns 1 on success. If an error occurs,
363 it sets C<$!>, deletes the output file, and returns 0.
369 All functions return 1 on success, 0 on failure.
370 $! will be set if an error was encountered.
374 File::Copy was written by Aaron Sherman I<E<lt>ajs@ajs.comE<gt>> in 1995,
375 and updated by Charles Bailey I<E<lt>bailey@newman.upenn.eduE<gt>> in 1996.