source: trunk/essentials/dev-lang/perl/lib/File/Copy.pm

Last change on this file was 3209, checked in by bird, 18 years ago

kLIBC has inode and dev that are pretty much reliable.

File size: 13.8 KB
Line 
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# Additions copyright 1996 by Charles Bailey. Permission is granted
6# to distribute the revised code under the same terms as Perl itself.
7
8package File::Copy;
9
10use 5.006;
11use strict;
12use warnings;
13use Carp;
14use File::Spec;
15use Config;
16our(@ISA, @EXPORT, @EXPORT_OK, $VERSION, $Too_Big, $Syscopy_is_copy);
17sub copy;
18sub syscopy;
19sub cp;
20sub mv;
21
22# Note that this module implements only *part* of the API defined by
23# the File/Copy.pm module of the File-Tools-2.0 package. However, that
24# package has not yet been updated to work with Perl 5.004, and so it
25# would be a Bad Thing for the CPAN module to grab it and replace this
26# module. Therefore, we set this module's version higher than 2.0.
27$VERSION = '2.09';
28
29require Exporter;
30@ISA = qw(Exporter);
31@EXPORT = qw(copy move);
32@EXPORT_OK = qw(cp mv);
33
34$Too_Big = 1024 * 1024 * 2;
35
36my $macfiles;
37if ($^O eq 'MacOS') {
38 $macfiles = eval { require Mac::MoreFiles };
39 warn 'Mac::MoreFiles could not be loaded; using non-native syscopy'
40 if $@ && $^W;
41}
42
43sub _catname {
44 my($from, $to) = @_;
45 if (not defined &basename) {
46 require File::Basename;
47 import File::Basename 'basename';
48 }
49
50 if ($^O eq 'MacOS') {
51 # a partial dir name that's valid only in the cwd (e.g. 'tmp')
52 $to = ':' . $to if $to !~ /:/;
53 }
54
55 return File::Spec->catfile($to, basename($from));
56}
57
58sub copy {
59 croak("Usage: copy(FROM, TO [, BUFFERSIZE]) ")
60 unless(@_ == 2 || @_ == 3);
61
62 my $from = shift;
63 my $to = shift;
64
65 my $from_a_handle = (ref($from)
66 ? (ref($from) eq 'GLOB'
67 || UNIVERSAL::isa($from, 'GLOB')
68 || UNIVERSAL::isa($from, 'IO::Handle'))
69 : (ref(\$from) eq 'GLOB'));
70 my $to_a_handle = (ref($to)
71 ? (ref($to) eq 'GLOB'
72 || UNIVERSAL::isa($to, 'GLOB')
73 || UNIVERSAL::isa($to, 'IO::Handle'))
74 : (ref(\$to) eq 'GLOB'));
75
76 if ($from eq $to) { # works for references, too
77 carp("'$from' and '$to' are identical (not copied)");
78 # The "copy" was a success as the source and destination contain
79 # the same data.
80 return 1;
81 }
82
83 if ((($Config{d_symlink} && $Config{d_readlink}) || $Config{d_link}) &&
84 !($^O eq 'MSWin32' || $^O eq 'vms')) {
85 my @fs = stat($from);
86 if (@fs) {
87 my @ts = stat($to);
88 if (@ts && $fs[0] == $ts[0] && $fs[1] == $ts[1] &&
89 ($^O ne 'os2' || ($fs[0] != 0 && $fs[1] != 0))) {
90 carp("'$from' and '$to' are identical (not copied)");
91 return 0;
92 }
93 }
94 }
95
96 if (!$from_a_handle && !$to_a_handle && -d $to && ! -d $from) {
97 $to = _catname($from, $to);
98 }
99
100 if (defined &syscopy && !$Syscopy_is_copy
101 && !$to_a_handle
102 && !($from_a_handle && $^O eq 'os2' ) # OS/2 cannot handle handles
103 && !($from_a_handle && $^O eq 'mpeix') # and neither can MPE/iX.
104 && !($from_a_handle && $^O eq 'MSWin32')
105 && !($from_a_handle && $^O eq 'MacOS')
106 && !($from_a_handle && $^O eq 'NetWare')
107 )
108 {
109 return syscopy($from, $to);
110 }
111
112 my $closefrom = 0;
113 my $closeto = 0;
114 my ($size, $status, $r, $buf);
115 local($\) = '';
116
117 my $from_h;
118 if ($from_a_handle) {
119 $from_h = $from;
120 } else {
121 $from = _protect($from) if $from =~ /^\s/s;
122 $from_h = \do { local *FH };
123 open($from_h, "< $from\0") or goto fail_open1;
124 binmode $from_h or die "($!,$^E)";
125 $closefrom = 1;
126 }
127
128 my $to_h;
129 if ($to_a_handle) {
130 $to_h = $to;
131 } else {
132 $to = _protect($to) if $to =~ /^\s/s;
133 $to_h = \do { local *FH };
134 open($to_h,"> $to\0") or goto fail_open2;
135 binmode $to_h or die "($!,$^E)";
136 $closeto = 1;
137 }
138
139 if (@_) {
140 $size = shift(@_) + 0;
141 croak("Bad buffer size for copy: $size\n") unless ($size > 0);
142 } else {
143 $size = tied(*$from_h) ? 0 : -s $from_h || 0;
144 $size = 1024 if ($size < 512);
145 $size = $Too_Big if ($size > $Too_Big);
146 }
147
148 $! = 0;
149 for (;;) {
150 my ($r, $w, $t);
151 defined($r = sysread($from_h, $buf, $size))
152 or goto fail_inner;
153 last unless $r;
154 for ($w = 0; $w < $r; $w += $t) {
155 $t = syswrite($to_h, $buf, $r - $w, $w)
156 or goto fail_inner;
157 }
158 }
159
160 close($to_h) || goto fail_open2 if $closeto;
161 close($from_h) || goto fail_open1 if $closefrom;
162
163 # Use this idiom to avoid uninitialized value warning.
164 return 1;
165
166 # All of these contortions try to preserve error messages...
167 fail_inner:
168 if ($closeto) {
169 $status = $!;
170 $! = 0;
171 close $to_h;
172 $! = $status unless $!;
173 }
174 fail_open2:
175 if ($closefrom) {
176 $status = $!;
177 $! = 0;
178 close $from_h;
179 $! = $status unless $!;
180 }
181 fail_open1:
182 return 0;
183}
184
185sub move {
186 croak("Usage: move(FROM, TO) ") unless @_ == 2;
187
188 my($from,$to) = @_;
189
190 my($fromsz,$tosz1,$tomt1,$tosz2,$tomt2,$sts,$ossts);
191
192 if (-d $to && ! -d $from) {
193 $to = _catname($from, $to);
194 }
195
196 ($tosz1,$tomt1) = (stat($to))[7,9];
197 $fromsz = -s $from;
198 if ($^O eq 'os2' and defined $tosz1 and defined $fromsz) {
199 # will not rename with overwrite
200 unlink $to;
201 }
202 return 1 if rename $from, $to;
203
204 # Did rename return an error even though it succeeded, because $to
205 # is on a remote NFS file system, and NFS lost the server's ack?
206 return 1 if defined($fromsz) && !-e $from && # $from disappeared
207 (($tosz2,$tomt2) = (stat($to))[7,9]) && # $to's there
208 ($tosz1 != $tosz2 or $tomt1 != $tomt2) && # and changed
209 $tosz2 == $fromsz; # it's all there
210
211 ($tosz1,$tomt1) = (stat($to))[7,9]; # just in case rename did something
212
213 {
214 local $@;
215 eval {
216 local $SIG{__DIE__};
217 copy($from,$to) or die;
218 my($atime, $mtime) = (stat($from))[8,9];
219 utime($atime, $mtime, $to);
220 unlink($from) or die;
221 };
222 return 1 unless $@;
223 }
224 ($sts,$ossts) = ($! + 0, $^E + 0);
225
226 ($tosz2,$tomt2) = ((stat($to))[7,9],0,0) if defined $tomt1;
227 unlink($to) if !defined($tomt1) or $tomt1 != $tomt2 or $tosz1 != $tosz2;
228 ($!,$^E) = ($sts,$ossts);
229 return 0;
230}
231
232*cp = \&copy;
233*mv = \&move;
234
235
236if ($^O eq 'MacOS') {
237 *_protect = sub { MacPerl::MakeFSSpec($_[0]) };
238} else {
239 *_protect = sub { "./$_[0]" };
240}
241
242# &syscopy is an XSUB under OS/2
243unless (defined &syscopy) {
244 if ($^O eq 'VMS') {
245 *syscopy = \&rmscopy;
246 } elsif ($^O eq 'mpeix') {
247 *syscopy = sub {
248 return 0 unless @_ == 2;
249 # Use the MPE cp program in order to
250 # preserve MPE file attributes.
251 return system('/bin/cp', '-f', $_[0], $_[1]) == 0;
252 };
253 } elsif ($^O eq 'MSWin32') {
254 *syscopy = sub {
255 return 0 unless @_ == 2;
256 return Win32::CopyFile(@_, 1);
257 };
258 } elsif ($macfiles) {
259 *syscopy = sub {
260 my($from, $to) = @_;
261 my($dir, $toname);
262
263 return 0 unless -e $from;
264
265 if ($to =~ /(.*:)([^:]+):?$/) {
266 ($dir, $toname) = ($1, $2);
267 } else {
268 ($dir, $toname) = (":", $to);
269 }
270
271 unlink($to);
272 Mac::MoreFiles::FSpFileCopy($from, $dir, $toname, 1);
273 };
274 } else {
275 $Syscopy_is_copy = 1;
276 *syscopy = \&copy;
277 }
278}
279
2801;
281
282__END__
283
284=head1 NAME
285
286File::Copy - Copy files or filehandles
287
288=head1 SYNOPSIS
289
290 use File::Copy;
291
292 copy("file1","file2") or die "Copy failed: $!";
293 copy("Copy.pm",\*STDOUT);
294 move("/dev1/fileA","/dev2/fileB");
295
296 use File::Copy "cp";
297
298 $n = FileHandle->new("/a/file","r");
299 cp($n,"x");
300
301=head1 DESCRIPTION
302
303The File::Copy module provides two basic functions, C<copy> and
304C<move>, which are useful for getting the contents of a file from
305one place to another.
306
307=over 4
308
309=item *
310
311The C<copy> function takes two
312parameters: a file to copy from and a file to copy to. Either
313argument may be a string, a FileHandle reference or a FileHandle
314glob. Obviously, if the first argument is a filehandle of some
315sort, it will be read from, and if it is a file I<name> it will
316be opened for reading. Likewise, the second argument will be
317written to (and created if need be). Trying to copy a file on top
318of itself is a fatal error.
319
320B<Note that passing in
321files as handles instead of names may lead to loss of information
322on some operating systems; it is recommended that you use file
323names whenever possible.> Files are opened in binary mode where
324applicable. To get a consistent behaviour when copying from a
325filehandle to a file, use C<binmode> on the filehandle.
326
327An optional third parameter can be used to specify the buffer
328size used for copying. This is the number of bytes from the
329first file, that wil be held in memory at any given time, before
330being written to the second file. The default buffer size depends
331upon the file, but will generally be the whole file (up to 2Mb), or
3321k for filehandles that do not reference files (eg. sockets).
333
334You may use the syntax C<use File::Copy "cp"> to get at the
335"cp" alias for this function. The syntax is I<exactly> the same.
336
337=item *
338
339The C<move> function also takes two parameters: the current name
340and the intended name of the file to be moved. If the destination
341already exists and is a directory, and the source is not a
342directory, then the source file will be renamed into the directory
343specified by the destination.
344
345If possible, move() will simply rename the file. Otherwise, it copies
346the file to the new location and deletes the original. If an error occurs
347during this copy-and-delete process, you may be left with a (possibly partial)
348copy of the file under the destination name.
349
350You may use the "mv" alias for this function in the same way that
351you may use the "cp" alias for C<copy>.
352
353=back
354
355File::Copy also provides the C<syscopy> routine, which copies the
356file specified in the first parameter to the file specified in the
357second parameter, preserving OS-specific attributes and file
358structure. For Unix systems, this is equivalent to the simple
359C<copy> routine, which doesn't preserve OS-specific attributes. For
360VMS systems, this calls the C<rmscopy> routine (see below). For OS/2
361systems, this calls the C<syscopy> XSUB directly. For Win32 systems,
362this calls C<Win32::CopyFile>.
363
364On Mac OS (Classic), C<syscopy> calls C<Mac::MoreFiles::FSpFileCopy>,
365if available.
366
367=head2 Special behaviour if C<syscopy> is defined (OS/2, VMS and Win32)
368
369If both arguments to C<copy> are not file handles,
370then C<copy> will perform a "system copy" of
371the input file to a new output file, in order to preserve file
372attributes, indexed file structure, I<etc.> The buffer size
373parameter is ignored. If either argument to C<copy> is a
374handle to an opened file, then data is copied using Perl
375operators, and no effort is made to preserve file attributes
376or record structure.
377
378The system copy routine may also be called directly under VMS and OS/2
379as C<File::Copy::syscopy> (or under VMS as C<File::Copy::rmscopy>, which
380is the routine that does the actual work for syscopy).
381
382=over 4
383
384=item rmscopy($from,$to[,$date_flag])
385
386The first and second arguments may be strings, typeglobs, typeglob
387references, or objects inheriting from IO::Handle;
388they are used in all cases to obtain the
389I<filespec> of the input and output files, respectively. The
390name and type of the input file are used as defaults for the
391output file, if necessary.
392
393A new version of the output file is always created, which
394inherits the structure and RMS attributes of the input file,
395except for owner and protections (and possibly timestamps;
396see below). All data from the input file is copied to the
397output file; if either of the first two parameters to C<rmscopy>
398is a file handle, its position is unchanged. (Note that this
399means a file handle pointing to the output file will be
400associated with an old version of that file after C<rmscopy>
401returns, not the newly created version.)
402
403The third parameter is an integer flag, which tells C<rmscopy>
404how to handle timestamps. If it is E<lt> 0, none of the input file's
405timestamps are propagated to the output file. If it is E<gt> 0, then
406it is interpreted as a bitmask: if bit 0 (the LSB) is set, then
407timestamps other than the revision date are propagated; if bit 1
408is set, the revision date is propagated. If the third parameter
409to C<rmscopy> is 0, then it behaves much like the DCL COPY command:
410if the name or type of the output file was explicitly specified,
411then no timestamps are propagated, but if they were taken implicitly
412from the input filespec, then all timestamps other than the
413revision date are propagated. If this parameter is not supplied,
414it defaults to 0.
415
416Like C<copy>, C<rmscopy> returns 1 on success. If an error occurs,
417it sets C<$!>, deletes the output file, and returns 0.
418
419=back
420
421=head1 RETURN
422
423All functions return 1 on success, 0 on failure.
424$! will be set if an error was encountered.
425
426=head1 NOTES
427
428=over 4
429
430=item *
431
432On Mac OS (Classic), the path separator is ':', not '/', and the
433current directory is denoted as ':', not '.'. You should be careful
434about specifying relative pathnames. While a full path always begins
435with a volume name, a relative pathname should always begin with a
436':'. If specifying a volume name only, a trailing ':' is required.
437
438E.g.
439
440 copy("file1", "tmp"); # creates the file 'tmp' in the current directory
441 copy("file1", ":tmp:"); # creates :tmp:file1
442 copy("file1", ":tmp"); # same as above
443 copy("file1", "tmp"); # same as above, if 'tmp' is a directory (but don't do
444 # that, since it may cause confusion, see example #1)
445 copy("file1", "tmp:file1"); # error, since 'tmp:' is not a volume
446 copy("file1", ":tmp:file1"); # ok, partial path
447 copy("file1", "DataHD:"); # creates DataHD:file1
448
449 move("MacintoshHD:fileA", "DataHD:fileB"); # moves (don't copies) files from one
450 # volume to another
451
452=back
453
454=head1 AUTHOR
455
456File::Copy was written by Aaron Sherman I<E<lt>ajs@ajs.comE<gt>> in 1995,
457and updated by Charles Bailey I<E<lt>bailey@newman.upenn.eduE<gt>> in 1996.
458
459=cut
460
Note: See TracBrowser for help on using the repository browser.