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 .= ':' . 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')
74 return syscopy($from, $to);
79 my ($size, $status, $r, $buf);
84 *FROM = *$from{FILEHANDLE};
86 $from = "./$from" if $from =~ /^\s/s;
87 open(FROM, "< $from\0") or goto fail_open1;
88 binmode FROM or die "($!,$^E)";
93 *TO = *$to{FILEHANDLE};
95 $to = "./$to" if $to =~ /^\s/s;
96 open(TO,"> $to\0") or goto fail_open2;
97 binmode TO or die "($!,$^E)";
102 $size = shift(@_) + 0;
103 croak("Bad buffer size for copy: $size\n") unless ($size > 0);
106 $size = 1024 if ($size < 512);
107 $size = $Too_Big if ($size > $Too_Big);
113 defined($r = sysread(FROM, $buf, $size))
116 for ($w = 0; $w < $r; $w += $t) {
117 $t = syswrite(TO, $buf, $r - $w, $w)
122 close(TO) || goto fail_open2 if $closeto;
123 close(FROM) || goto fail_open1 if $closefrom;
125 # Use this idiom to avoid uninitialized value warning.
128 # All of these contortions try to preserve error messages...
134 $! = $status unless $!;
141 $! = $status unless $!;
149 my($copied,$fromsz,$tosz1,$tomt1,$tosz2,$tomt2,$sts,$ossts);
151 if (-d $to && ! -d $from) {
152 $to = _catname($from, $to);
155 ($tosz1,$tomt1) = (stat($to))[7,9];
157 if ($^O eq 'os2' and defined $tosz1 and defined $fromsz) {
158 # will not rename with overwrite
161 return 1 if rename $from, $to;
163 ($sts,$ossts) = ($! + 0, $^E + 0);
164 # Did rename return an error even though it succeeded, because $to
165 # is on a remote NFS file system, and NFS lost the server's ack?
166 return 1 if defined($fromsz) && !-e $from && # $from disappeared
167 (($tosz2,$tomt2) = (stat($to))[7,9]) && # $to's there
168 ($tosz1 != $tosz2 or $tomt1 != $tomt2) && # and changed
169 $tosz2 == $fromsz; # it's all there
171 ($tosz1,$tomt1) = (stat($to))[7,9]; # just in case rename did something
172 return 1 if ($copied = copy($from,$to)) && unlink($from);
174 ($tosz2,$tomt2) = ((stat($to))[7,9],0,0) if defined $tomt1;
175 unlink($to) if !defined($tomt1) or $tomt1 != $tomt2 or $tosz1 != $tosz2;
176 ($!,$^E) = ($sts,$ossts);
183 # &syscopy is an XSUB under OS/2
184 unless (defined &syscopy) {
186 *syscopy = \&rmscopy;
187 } elsif ($^O eq 'mpeix') {
189 return 0 unless @_ == 2;
190 # Use the MPE cp program in order to
191 # preserve MPE file attributes.
192 return system('/bin/cp', '-f', $_[0], $_[1]) == 0;
194 } elsif ($^O eq 'MSWin32') {
196 return 0 unless @_ == 2;
197 return Win32::CopyFile(@_, 1);
200 $Syscopy_is_copy = 1;
211 File::Copy - Copy files or filehandles
217 copy("file1","file2");
218 copy("Copy.pm",\*STDOUT);'
219 move("/dev1/fileA","/dev2/fileB");
224 $n=FileHandle->new("/dev/null","r");
229 The File::Copy module provides two basic functions, C<copy> and
230 C<move>, which are useful for getting the contents of a file from
231 one place to another.
237 The C<copy> function takes two
238 parameters: a file to copy from and a file to copy to. Either
239 argument may be a string, a FileHandle reference or a FileHandle
240 glob. Obviously, if the first argument is a filehandle of some
241 sort, it will be read from, and if it is a file I<name> it will
242 be opened for reading. Likewise, the second argument will be
243 written to (and created if need be).
245 B<Note that passing in
246 files as handles instead of names may lead to loss of information
247 on some operating systems; it is recommended that you use file
248 names whenever possible.> Files are opened in binary mode where
249 applicable. To get a consistent behaviour when copying from a
250 filehandle to a file, use C<binmode> on the filehandle.
252 An optional third parameter can be used to specify the buffer
253 size used for copying. This is the number of bytes from the
254 first file, that wil be held in memory at any given time, before
255 being written to the second file. The default buffer size depends
256 upon the file, but will generally be the whole file (up to 2Mb), or
257 1k for filehandles that do not reference files (eg. sockets).
259 You may use the syntax C<use File::Copy "cp"> to get at the
260 "cp" alias for this function. The syntax is I<exactly> the same.
264 The C<move> function also takes two parameters: the current name
265 and the intended name of the file to be moved. If the destination
266 already exists and is a directory, and the source is not a
267 directory, then the source file will be renamed into the directory
268 specified by the destination.
270 If possible, move() will simply rename the file. Otherwise, it copies
271 the file to the new location and deletes the original. If an error occurs
272 during this copy-and-delete process, you may be left with a (possibly partial)
273 copy of the file under the destination name.
275 You may use the "mv" alias for this function in the same way that
276 you may use the "cp" alias for C<copy>.
280 File::Copy also provides the C<syscopy> routine, which copies the
281 file specified in the first parameter to the file specified in the
282 second parameter, preserving OS-specific attributes and file
283 structure. For Unix systems, this is equivalent to the simple
284 C<copy> routine. For VMS systems, this calls the C<rmscopy>
285 routine (see below). For OS/2 systems, this calls the C<syscopy>
286 XSUB directly. For Win32 systems, this calls C<Win32::CopyFile>.
288 =head2 Special behaviour if C<syscopy> is defined (OS/2, VMS and Win32)
290 If both arguments to C<copy> are not file handles,
291 then C<copy> will perform a "system copy" of
292 the input file to a new output file, in order to preserve file
293 attributes, indexed file structure, I<etc.> The buffer size
294 parameter is ignored. If either argument to C<copy> is a
295 handle to an opened file, then data is copied using Perl
296 operators, and no effort is made to preserve file attributes
299 The system copy routine may also be called directly under VMS and OS/2
300 as C<File::Copy::syscopy> (or under VMS as C<File::Copy::rmscopy>, which
301 is the routine that does the actual work for syscopy).
305 =item rmscopy($from,$to[,$date_flag])
307 The first and second arguments may be strings, typeglobs, typeglob
308 references, or objects inheriting from IO::Handle;
309 they are used in all cases to obtain the
310 I<filespec> of the input and output files, respectively. The
311 name and type of the input file are used as defaults for the
312 output file, if necessary.
314 A new version of the output file is always created, which
315 inherits the structure and RMS attributes of the input file,
316 except for owner and protections (and possibly timestamps;
317 see below). All data from the input file is copied to the
318 output file; if either of the first two parameters to C<rmscopy>
319 is a file handle, its position is unchanged. (Note that this
320 means a file handle pointing to the output file will be
321 associated with an old version of that file after C<rmscopy>
322 returns, not the newly created version.)
324 The third parameter is an integer flag, which tells C<rmscopy>
325 how to handle timestamps. If it is E<lt> 0, none of the input file's
326 timestamps are propagated to the output file. If it is E<gt> 0, then
327 it is interpreted as a bitmask: if bit 0 (the LSB) is set, then
328 timestamps other than the revision date are propagated; if bit 1
329 is set, the revision date is propagated. If the third parameter
330 to C<rmscopy> is 0, then it behaves much like the DCL COPY command:
331 if the name or type of the output file was explicitly specified,
332 then no timestamps are propagated, but if they were taken implicitly
333 from the input filespec, then all timestamps other than the
334 revision date are propagated. If this parameter is not supplied,
337 Like C<copy>, C<rmscopy> returns 1 on success. If an error occurs,
338 it sets C<$!>, deletes the output file, and returns 0.
344 All functions return 1 on success, 0 on failure.
345 $! will be set if an error was encountered.
349 File::Copy was written by Aaron Sherman I<E<lt>ajs@ajs.comE<gt>> in 1995,
350 and updated by Charles Bailey I<E<lt>bailey@newman.upenn.eduE<gt>> in 1996.