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