[p5sagit/p5-mst-13.2.git] / lib / File / Copy.pm

# 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);

    if (($^O eq 'VMS' or $^O eq 'os2') && ref(\$to) ne 'GLOB' &&
        !(defined ref $to and (ref($to) eq 'GLOB' ||
          ref($to) eq 'FileHandle' || ref($to) eq 'VMS::Stdio')))
        { return File::Copy::syscopy($_[0],$_[1]) }

    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' ||
	      ref($from) eq 'VMS::Stdio')) {
	*FROM = *$from;
    } else {
	open(FROM,"<$from")||goto(fail_open1);
	binmode FROM;
	$closefrom = 1;
    }

    if (ref(\$to) eq 'GLOB') {
	*TO = $to;
    } elsif (defined ref $to and
	     (ref($to) eq 'GLOB' || ref($to) eq 'FileHandle' ||
	      ref($to) eq 'VMS::Stdio')) {
	*TO = *$to;
    } else {
	open(TO,">$to")||goto(fail_open2);
	binmode TO;
	$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;
# &syscopy is an XSUB under OS/2
*syscopy = ($^O eq 'VMS' ? \&rmscopy : \&copy) unless $^O eq 'os2';

1;

__END__

=head1 NAME

File::Copy - Copy files or filehandles

=head1 SYNOPSIS

  	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 File::Copy module provides a basic function C<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).  Note that passing in
files as handles instead of names may lead to loss of information
on some operating systems; it is recommended that you use file
names whenever possible.

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.

File::Copy also provides the C<syscopy> routine, which copies the
file specified in the first parameter to the file specified in the
second parameter, preserving OS-specific attributes and file
structure.  For Unix systems, this is equivalent to the simple
C<copy> routine.  For VMS systems, this calls the C<rmscopy>
routine (see below).  For OS/2 systems, this calls the C<syscopy>
XSUB directly.

=head2 Special behavior under VMS

If the second argument to C<copy> is not a file handle for an
already opened file, then C<copy> will perform an RMS copy of
the input file to a new output file, in order to preserve file
attributes, indexed file structure, I<etc.>  The buffer size
parameter is ignored.  If the second argument to C<copy> is a
Perl handle to an opened file, then data is copied using Perl
operators, and no effort is made to preserve file attributes
or record structure.

The RMS copy routine may also be called directly under VMS
as C<File::Copy::rmscopy> (or C<File::Copy::syscopy>, which
is just an alias for this routine).

=item rmscopy($from,$to[,$date_flag])

The first and second arguments may be strings, typeglobs, or
typeglob references; they are used in all cases to obtain the
I<filespec> of the input and output files, respectively.  The
name and type of the input file are used as defaults for the
output file, if necessary.

A new version of the output file is always created, which
inherits the structure and RMS attributes of the input file,
except for owner and protections (and possibly timestamps;
see below).  All data from the input file is copied to the
output file; if either of the first two parameters to C<rmscopy>
is a file handle, its position is unchanged.  (Note that this
means a file handle pointing to the output file will be
associated with an old version of that file after C<rmscopy>
returns, not the newly created version.)

The third parameter is an integer flag, which tells C<rmscopy>
how to handle timestamps.  If it is < 0, none of the input file's
timestamps are propagated to the output file.  If it is > 0, then
it is interpreted as a bitmask: if bit 0 (the LSB) is set, then
timestamps other than the revision date are propagated; if bit 1
is set, the revision date is propagated.  If the third parameter
to C<rmscopy> is 0, then it behaves much like the DCL COPY command:
if the name or type of the output file was explicitly specified,
then no timestamps are propagated, but if they were taken implicitly
from the input filespec, then all timestamps other than the
revision date are propagated.  If this parameter is not supplied,
it defaults to 0.

Like C<copy>, C<rmscopy> returns 1 on success.  If an error occurs,
it sets C<$!>, deletes the output file, and returns 0.

=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 I<E<lt>ajs@ajs.comE<gt>> in 1995.
The VMS-specific code was added by Charles Bailey
I<E<lt>bailey@genetics.upenn.eduE<gt>> in March 1996.

=cut
Commit	Line	Data
f716a1dd	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
9b957b78	27	if (($^O eq 'VMS' or $^O eq 'os2') && ref(\$to) ne 'GLOB' &&
	28	!(defined ref $to and (ref($to) eq 'GLOB' \|\|
	29	ref($to) eq 'FileHandle' \|\| ref($to) eq 'VMS::Stdio')))
	30	{ return File::Copy::syscopy($_[0],$_[1]) }
a5f75d66	31
f716a1dd	32	my $from = shift;
	33	my $to = shift;
	34	my $recsep = $\;
	35	my $closefrom=0;
	36	my $closeto=0;
	37	my ($size, $status, $r, $buf);
	38	local(FROM, TO);
	39
	40	$\ = '';
	41
	42	if (ref(\$from) eq 'GLOB') {
	43	*FROM = $from;
	44	} elsif (defined ref $from and
9b957b78	45	(ref($from) eq 'GLOB' \|\| ref($from) eq 'FileHandle' \|\|
9b957b78	46	ref($from) eq 'VMS::Stdio')) {
f716a1dd	47	FROM = $from;
	48	} else {
	49	open(FROM,"<$from")\|\|goto(fail_open1);
9b957b78	50	binmode FROM;
f716a1dd	51	$closefrom = 1;
	52	}
	53
	54	if (ref(\$to) eq 'GLOB') {
	55	*TO = $to;
	56	} elsif (defined ref $to and
9b957b78	57	(ref($to) eq 'GLOB' \|\| ref($to) eq 'FileHandle' \|\|
9b957b78	58	ref($to) eq 'VMS::Stdio')) {
f716a1dd	59	TO = $to;
	60	} else {
	61	open(TO,">$to")\|\|goto(fail_open2);
9b957b78	62	binmode TO;
f716a1dd	63	$closeto=1;
	64	}
	65
	66	if (@_) {
	67	$size = shift(@_) + 0;
	68	croak("Bad buffer size for copy: $size\n") unless ($size > 0);
	69	} else {
	70	$size = -s FROM;
	71	$size = 1024 if ($size < 512);
	72	$size = $File::Copy::Too_Big if ($size > $File::Copy::Too_Big);
	73	}
	74
	75	$buf = '';
	76	while(defined($r = read(FROM,$buf,$size)) && $r > 0) {
	77	if (syswrite (TO,$buf,$r) != $r) {
	78	goto fail_inner;
	79	}
	80	}
	81	goto fail_inner unless(defined($r));
	82	close(TO) \|\| goto fail_open2 if $closeto;
	83	close(FROM) \|\| goto fail_open1 if $closefrom;
	84	$\ = $recsep;
	85	return 1;
	86
	87	# All of these contortions try to preserve error messages...
	88	fail_inner:
	89	if ($closeto) {
	90	$status = $!;
	91	$! = 0;
	92	close TO;
	93	$! = $status unless $!;
	94	}
	95	fail_open2:
	96	if ($closefrom) {
	97	$status = $!;
	98	$! = 0;
	99	close FROM;
	100	$! = $status unless $!;
	101	}
	102	fail_open1:
	103	$\ = $recsep;
	104	return 0;
	105	}
9b957b78	106
9b957b78	107
f716a1dd	108	*cp = \©
9b957b78	109	# &syscopy is an XSUB under OS/2
9b957b78	110	*syscopy = ($^O eq 'VMS' ? \&rmscopy : \&copy) unless $^O eq 'os2';
f716a1dd	111
	112	1;
	113
	114	__END__
a5f75d66	115
f716a1dd	116	=head1 NAME
	117
	118	File::Copy - Copy files or filehandles
	119
a5f75d66	120	=head1 SYNOPSIS
f716a1dd	121
	122	use File::Copy;
	123
	124	copy("file1","file2");
	125	copy("Copy.pm",\*STDOUT);'
	126
	127	use POSIX;
	128	use File::Copy cp;
	129
	130	$n=FileHandle->new("/dev/null","r");
	131	cp($n,"x");'
	132
	133	=head1 DESCRIPTION
	134
9b957b78	135	The File::Copy module provides a basic function C<copy> which takes two
f716a1dd	136	parameters: a file to copy from and a file to copy to. Either
	137	argument may be a string, a FileHandle reference or a FileHandle
	138	glob. Obviously, if the first argument is a filehandle of some
	139	sort, it will be read from, and if it is a file I<name> it will
	140	be opened for reading. Likewise, the second argument will be
9b957b78	141	written to (and created if need be). Note that passing in
	142	files as handles instead of names may lead to loss of information
	143	on some operating systems; it is recommended that you use file
	144	names whenever possible.
f716a1dd	145
	146	An optional third parameter can be used to specify the buffer
	147	size used for copying. This is the number of bytes from the
	148	first file, that wil be held in memory at any given time, before
	149	being written to the second file. The default buffer size depends
	150	upon the file, but will generally be the whole file (up to 2Mb), or
	151	1k for filehandles that do not reference files (eg. sockets).
	152
	153	You may use the syntax C<use File::Copy "cp"> to get at the
	154	"cp" alias for this function. The syntax is I<exactly> the same.
	155
9b957b78	156	File::Copy also provides the C<syscopy> routine, which copies the
	157	file specified in the first parameter to the file specified in the
	158	second parameter, preserving OS-specific attributes and file
	159	structure. For Unix systems, this is equivalent to the simple
	160	C<copy> routine. For VMS systems, this calls the C<rmscopy>
	161	routine (see below). For OS/2 systems, this calls the C<syscopy>
	162	XSUB directly.
	163
	164	=head2 Special behavior under VMS
	165
	166	If the second argument to C<copy> is not a file handle for an
	167	already opened file, then C<copy> will perform an RMS copy of
	168	the input file to a new output file, in order to preserve file
	169	attributes, indexed file structure, I<etc.> The buffer size
	170	parameter is ignored. If the second argument to C<copy> is a
	171	Perl handle to an opened file, then data is copied using Perl
	172	operators, and no effort is made to preserve file attributes
	173	or record structure.
	174
	175	The RMS copy routine may also be called directly under VMS
	176	as C<File::Copy::rmscopy> (or C<File::Copy::syscopy>, which
	177	is just an alias for this routine).
	178
	179	=item rmscopy($from,$to[,$date_flag])
	180
	181	The first and second arguments may be strings, typeglobs, or
	182	typeglob references; they are used in all cases to obtain the
	183	I<filespec> of the input and output files, respectively. The
	184	name and type of the input file are used as defaults for the
	185	output file, if necessary.
	186
	187	A new version of the output file is always created, which
	188	inherits the structure and RMS attributes of the input file,
	189	except for owner and protections (and possibly timestamps;
	190	see below). All data from the input file is copied to the
	191	output file; if either of the first two parameters to C<rmscopy>
	192	is a file handle, its position is unchanged. (Note that this
	193	means a file handle pointing to the output file will be
	194	associated with an old version of that file after C<rmscopy>
	195	returns, not the newly created version.)
	196
	197	The third parameter is an integer flag, which tells C<rmscopy>
	198	how to handle timestamps. If it is < 0, none of the input file's
	199	timestamps are propagated to the output file. If it is > 0, then
	200	it is interpreted as a bitmask: if bit 0 (the LSB) is set, then
	201	timestamps other than the revision date are propagated; if bit 1
	202	is set, the revision date is propagated. If the third parameter
	203	to C<rmscopy> is 0, then it behaves much like the DCL COPY command:
	204	if the name or type of the output file was explicitly specified,
	205	then no timestamps are propagated, but if they were taken implicitly
	206	from the input filespec, then all timestamps other than the
	207	revision date are propagated. If this parameter is not supplied,
	208	it defaults to 0.
	209
	210	Like C<copy>, C<rmscopy> returns 1 on success. If an error occurs,
	211	it sets C<$!>, deletes the output file, and returns 0.
	212
f716a1dd	213	=head1 RETURN
	214
	215	Returns 1 on success, 0 on failure. $! will be set if an error was
	216	encountered.
	217
	218	=head1 AUTHOR
	219
9b957b78	220	File::Copy was written by Aaron Sherman I<E<lt>ajs@ajs.comE<gt>> in 1995.
	221	The VMS-specific code was added by Charles Bailey
	222	I<E<lt>bailey@genetics.upenn.eduE<gt>> in March 1996.
f716a1dd	223
f716a1dd	224	=cut