lib/File/Copy.pm

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