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