This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
New file, part of MakeMaker-5.21 upgrade.
[perl5.git] / lib / File / Copy.pm
CommitLineData
f716a1dd
PP
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
6package File::Copy;
7
8require Exporter;
9use 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
18sub VERSION {
19 # Version of File::Copy
20 return $File::Copy::VERSION;
21}
22
23sub copy {
24 croak("Usage: copy( file1, file2 [, buffersize]) ")
25 unless(@_ == 2 || @_ == 3);
26
27 my $from = shift;
28 my $to = shift;
29 my $recsep = $\;
30 my $closefrom=0;
31 my $closeto=0;
32 my ($size, $status, $r, $buf);
33 local(*FROM, *TO);
34
35 $\ = '';
36
37 if (ref(\$from) eq 'GLOB') {
38 *FROM = $from;
39 } elsif (defined ref $from and
40 (ref($from) eq 'GLOB' || ref($from) eq 'FileHandle')) {
41 *FROM = *$from;
42 } else {
43 open(FROM,"<$from")||goto(fail_open1);
44 $closefrom = 1;
45 }
46
47 if (ref(\$to) eq 'GLOB') {
48 *TO = $to;
49 } elsif (defined ref $to and
50 (ref($to) eq 'GLOB' || ref($to) eq 'FileHandle')) {
51 *TO = *$to;
52 } else {
53 open(TO,">$to")||goto(fail_open2);
54 $closeto=1;
55 }
56
57 if (@_) {
58 $size = shift(@_) + 0;
59 croak("Bad buffer size for copy: $size\n") unless ($size > 0);
60 } else {
61 $size = -s FROM;
62 $size = 1024 if ($size < 512);
63 $size = $File::Copy::Too_Big if ($size > $File::Copy::Too_Big);
64 }
65
66 $buf = '';
67 while(defined($r = read(FROM,$buf,$size)) && $r > 0) {
68 if (syswrite (TO,$buf,$r) != $r) {
69 goto fail_inner;
70 }
71 }
72 goto fail_inner unless(defined($r));
73 close(TO) || goto fail_open2 if $closeto;
74 close(FROM) || goto fail_open1 if $closefrom;
75 $\ = $recsep;
76 return 1;
77
78 # All of these contortions try to preserve error messages...
79 fail_inner:
80 if ($closeto) {
81 $status = $!;
82 $! = 0;
83 close TO;
84 $! = $status unless $!;
85 }
86 fail_open2:
87 if ($closefrom) {
88 $status = $!;
89 $! = 0;
90 close FROM;
91 $! = $status unless $!;
92 }
93 fail_open1:
94 $\ = $recsep;
95 return 0;
96}
97*cp = \&copy;
98
991;
100
101__END__
102=head1 NAME
103
104File::Copy - Copy files or filehandles
105
106=head1 USAGE
107
108 use File::Copy;
109
110 copy("file1","file2");
111 copy("Copy.pm",\*STDOUT);'
112
113 use POSIX;
114 use File::Copy cp;
115
116 $n=FileHandle->new("/dev/null","r");
117 cp($n,"x");'
118
119=head1 DESCRIPTION
120
121The Copy module provides one function (copy) which takes two
122parameters: a file to copy from and a file to copy to. Either
123argument may be a string, a FileHandle reference or a FileHandle
124glob. Obviously, if the first argument is a filehandle of some
125sort, it will be read from, and if it is a file I<name> it will
126be opened for reading. Likewise, the second argument will be
127written to (and created if need be).
128
129An optional third parameter can be used to specify the buffer
130size used for copying. This is the number of bytes from the
131first file, that wil be held in memory at any given time, before
132being written to the second file. The default buffer size depends
133upon the file, but will generally be the whole file (up to 2Mb), or
1341k for filehandles that do not reference files (eg. sockets).
135
136You may use the syntax C<use File::Copy "cp"> to get at the
137"cp" alias for this function. The syntax is I<exactly> the same.
138
139=head1 RETURN
140
141Returns 1 on success, 0 on failure. $! will be set if an error was
142encountered.
143
144=head1 AUTHOR
145
146File::Copy was written by Aaron Sherman <ajs@ajs.com> in 1995.
147
148=cut