New file, part of MakeMaker-5.21 upgrade.

1 files changed, 148 insertions, 0 deletions

diff --git a/lib/File/Copy.pm b/lib/File/Copy.pm
new file mode 100644
index 0000000000..b4a075dbe1
--- /dev/null
+++ b/lib/File/Copy.pm
@@ -0,0 +1,148 @@
+# File/Copy.pm. Written in 1994 by Aaron Sherman <ajs@ajs.com>. This
+# source code has been placed in the public domain by the author.
+# Please be kind and preserve the documentation.
+#
+
+package File::Copy;
+
+require Exporter;
+use Carp;
+
+@ISA=qw(Exporter);
+@EXPORT=qw(copy);
+@EXPORT_OK=qw(copy cp);
+
+$File::Copy::VERSION = '1.5';
+$File::Copy::Too_Big = 1024 * 1024 * 2;
+
+sub VERSION {
+    # Version of File::Copy
+    return $File::Copy::VERSION;
+}
+
+sub copy {
+    croak("Usage: copy( file1, file2 [, buffersize]) ")
+      unless(@_ == 2 || @_ == 3);
+
+    my $from = shift;
+    my $to = shift;
+    my $recsep = $\;
+    my $closefrom=0;
+    my $closeto=0;
+    my ($size, $status, $r, $buf);
+    local(*FROM, *TO);
+
+    $\ = '';
+
+    if (ref(\$from) eq 'GLOB') {
+	*FROM = $from;
+    } elsif (defined ref $from and
+	     (ref($from) eq 'GLOB' || ref($from) eq 'FileHandle')) {
+	*FROM = *$from;
+    } else {
+	open(FROM,"<$from")||goto(fail_open1);
+	$closefrom = 1;
+    }
+
+    if (ref(\$to) eq 'GLOB') {
+	*TO = $to;
+    } elsif (defined ref $to and
+	     (ref($to) eq 'GLOB' || ref($to) eq 'FileHandle')) {
+	*TO = *$to;
+    } else {
+	open(TO,">$to")||goto(fail_open2);
+	$closeto=1;
+    }
+
+    if (@_) {
+	$size = shift(@_) + 0;
+	croak("Bad buffer size for copy: $size\n") unless ($size > 0);
+    } else {
+	$size = -s FROM;
+	$size = 1024 if ($size < 512);
+	$size = $File::Copy::Too_Big if ($size > $File::Copy::Too_Big);
+    }
+
+    $buf = '';
+    while(defined($r = read(FROM,$buf,$size)) && $r > 0) {
+	if (syswrite (TO,$buf,$r) != $r) {
+	    goto fail_inner;    
+	}
+    }
+    goto fail_inner unless(defined($r));
+    close(TO) || goto fail_open2 if $closeto;
+    close(FROM) || goto fail_open1 if $closefrom;
+    $\ = $recsep;
+    return 1;
+    
+    # All of these contortions try to preserve error messages...
+  fail_inner:
+    if ($closeto) {
+	$status = $!;
+	$! = 0;
+	close TO;
+	$! = $status unless $!;
+    }
+  fail_open2:
+    if ($closefrom) {
+	$status = $!;
+	$! = 0;
+	close FROM;
+	$! = $status unless $!;
+    }
+  fail_open1:
+    $\ = $recsep;
+    return 0;
+}
+*cp = \&copy;
+
+1;
+
+__END__
+=head1 NAME
+
+File::Copy - Copy files or filehandles
+
+=head1 USAGE
+
+  	use File::Copy;
+
+	copy("file1","file2");
+  	copy("Copy.pm",\*STDOUT);'
+
+  	use POSIX;
+	use File::Copy cp;
+
+	$n=FileHandle->new("/dev/null","r");
+	cp($n,"x");'
+
+=head1 DESCRIPTION
+
+The Copy module provides one function (copy) which takes two
+parameters: a file to copy from and a file to copy to. Either
+argument may be a string, a FileHandle reference or a FileHandle
+glob. Obviously, if the first argument is a filehandle of some
+sort, it will be read from, and if it is a file I<name> it will
+be opened for reading. Likewise, the second argument will be
+written to (and created if need be).
+
+An optional third parameter can be used to specify the buffer
+size used for copying. This is the number of bytes from the
+first file, that wil be held in memory at any given time, before
+being written to the second file. The default buffer size depends
+upon the file, but will generally be the whole file (up to 2Mb), or
+1k for filehandles that do not reference files (eg. sockets).
+
+You may use the syntax C<use File::Copy "cp"> to get at the
+"cp" alias for this function. The syntax is I<exactly> the same.
+
+=head1 RETURN
+
+Returns 1 on success, 0 on failure. $! will be set if an error was
+encountered.
+
+=head1 AUTHOR
+
+File::Copy was written by Aaron Sherman <ajs@ajs.com> in 1995.
+
+=cut