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