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