home *** CD-ROM | disk | FTP | other *** search
/ Amiga Tools 5 / Amiga Tools 5.iso / tools / developer-tools / andere sprachen / perl5 / perl5.002 / lib / file / copy.pm < prev    next >
Encoding:
Perl POD Document  |  1996-02-27  |  3.8 KB  |  158 lines
  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. require Exporter;
  9. use Carp;
  10.  
  11. @ISA=qw(Exporter);
  12. @EXPORT=qw(copy);
  13. @EXPORT_OK=qw(copy cp);
  14.  
  15. $File::Copy::VERSION = '1.5';
  16. $File::Copy::Too_Big = 1024 * 1024 * 2;
  17.  
  18. sub VERSION {
  19.     # Version of File::Copy
  20.     return $File::Copy::VERSION;
  21. }
  22.  
  23. sub copy {
  24.     croak("Usage: copy( file1, file2 [, buffersize]) ")
  25.       unless(@_ == 2 || @_ == 3);
  26.  
  27.     # VMS: perform RMS copy to preserve file attributes, indices, etc.
  28.     # This function is always defined under VMS, even in miniperl
  29.     if (defined(&File::Copy::rmscopy)) { return File::Copy::rmscopy($_[0],$_[1]) }
  30.  
  31.     my $from = shift;
  32.     my $to = shift;
  33.     my $recsep = $\;
  34.     my $closefrom=0;
  35.     my $closeto=0;
  36.     my ($size, $status, $r, $buf);
  37.     local(*FROM, *TO);
  38.  
  39.     $\ = '';
  40.  
  41.     if (ref(\$from) eq 'GLOB') {
  42.     *FROM = $from;
  43.     } elsif (defined ref $from and
  44.          (ref($from) eq 'GLOB' || ref($from) eq 'FileHandle')) {
  45.     *FROM = *$from;
  46.     } else {
  47.     open(FROM,"<$from")||goto(fail_open1);
  48.     $closefrom = 1;
  49.     }
  50.  
  51.     if (ref(\$to) eq 'GLOB') {
  52.     *TO = $to;
  53.     } elsif (defined ref $to and
  54.          (ref($to) eq 'GLOB' || ref($to) eq 'FileHandle')) {
  55.     *TO = *$to;
  56.     } else {
  57.     open(TO,">$to")||goto(fail_open2);
  58.     $closeto=1;
  59.     }
  60.  
  61.     if (@_) {
  62.     $size = shift(@_) + 0;
  63.     croak("Bad buffer size for copy: $size\n") unless ($size > 0);
  64.     } else {
  65.     $size = -s FROM;
  66.     $size = 1024 if ($size < 512);
  67.     $size = $File::Copy::Too_Big if ($size > $File::Copy::Too_Big);
  68.     }
  69.  
  70.     $buf = '';
  71.     while(defined($r = read(FROM,$buf,$size)) && $r > 0) {
  72.     if (syswrite (TO,$buf,$r) != $r) {
  73.         goto fail_inner;    
  74.     }
  75.     }
  76.     goto fail_inner unless(defined($r));
  77.     close(TO) || goto fail_open2 if $closeto;
  78.     close(FROM) || goto fail_open1 if $closefrom;
  79.     $\ = $recsep;
  80.     return 1;
  81.     
  82.     # All of these contortions try to preserve error messages...
  83.   fail_inner:
  84.     if ($closeto) {
  85.     $status = $!;
  86.     $! = 0;
  87.     close TO;
  88.     $! = $status unless $!;
  89.     }
  90.   fail_open2:
  91.     if ($closefrom) {
  92.     $status = $!;
  93.     $! = 0;
  94.     close FROM;
  95.     $! = $status unless $!;
  96.     }
  97.   fail_open1:
  98.     $\ = $recsep;
  99.     return 0;
  100. }
  101. *cp = \©
  102.  
  103. 1;
  104.  
  105. __END__
  106.  
  107. =head1 NAME
  108.  
  109. File::Copy - Copy files or filehandles
  110.  
  111. =head1 SYNOPSIS
  112.  
  113.       use File::Copy;
  114.  
  115.     copy("file1","file2");
  116.       copy("Copy.pm",\*STDOUT);'
  117.  
  118.       use POSIX;
  119.     use File::Copy cp;
  120.  
  121.     $n=FileHandle->new("/dev/null","r");
  122.     cp($n,"x");'
  123.  
  124. =head1 DESCRIPTION
  125.  
  126. The Copy module provides one function (copy) which takes two
  127. parameters: a file to copy from and a file to copy to. Either
  128. argument may be a string, a FileHandle reference or a FileHandle
  129. glob. Obviously, if the first argument is a filehandle of some
  130. sort, it will be read from, and if it is a file I<name> it will
  131. be opened for reading. Likewise, the second argument will be
  132. written to (and created if need be).
  133.  
  134. An optional third parameter can be used to specify the buffer
  135. size used for copying. This is the number of bytes from the
  136. first file, that wil be held in memory at any given time, before
  137. being written to the second file. The default buffer size depends
  138. upon the file, but will generally be the whole file (up to 2Mb), or
  139. 1k for filehandles that do not reference files (eg. sockets).
  140.  
  141. When running under VMS, this routine performs an RMS copy of
  142. the file, in order to preserve file attributed, indexed file
  143. structure, I<etc.>  The buffer size parameter is ignored.
  144.  
  145. You may use the syntax C<use File::Copy "cp"> to get at the
  146. "cp" alias for this function. The syntax is I<exactly> the same.
  147.  
  148. =head1 RETURN
  149.  
  150. Returns 1 on success, 0 on failure. $! will be set if an error was
  151. encountered.
  152.  
  153. =head1 AUTHOR
  154.  
  155. File::Copy was written by Aaron Sherman <ajs@ajs.com> in 1995.
  156.  
  157. =cut
  158.