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