diff options
author | Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> | 1996-12-14 00:27:29 -0500 |
---|---|---|
committer | Chip Salzenberg <chip@atlantic.net> | 1996-12-19 16:44:00 +1200 |
commit | 441496b2b4814536730a7c97d893a728a76c0c9d (patch) | |
tree | d45fde64b4d1bb477f362a6dca27143c9f18d809 /lib | |
parent | e1f0c0aa312112c4a139416a2dda63880ddd621a (diff) | |
download | perl-441496b2b4814536730a7c97d893a728a76c0c9d.tar.gz |
Re: Proposed addition to File::Copy: move
In article <1996Dec11.184718.1613163@hmivax>, bailey@genetics.upenn.edu (Charles Bailey) writes:
> It's been mentioned a couple times that a file renaming function with
> semantics similar to the Unix "mv" command (rename if possible, else
> copy) would be a nice addition to File::Copy. Here's a patch; what
> do people think of it? (It also includes changes to make File::Copy
> 'strict' and '-w' clean.)
Of course, seconds after I post the patch, I find a case where rename()
returns ENODEV instead of EXDEV for a cross-device copy. Appended is
a patch which allows this; if the target device really doesn't exist,
copy() will prompylt fail with the same error.
p5p-msgid: <1996Dec11.185807.1613164@hmivax.humgen.upenn.edu>
private-msgid: <01ICZBN0LRC8001A1D@hmivax.humgen.upenn.edu>
Diffstat (limited to 'lib')
-rw-r--r-- | lib/File/Copy.pm | 100 |
1 files changed, 70 insertions, 30 deletions
diff --git a/lib/File/Copy.pm b/lib/File/Copy.pm index 2e555590f7..6afbd393b3 100644 --- a/lib/File/Copy.pm +++ b/lib/File/Copy.pm @@ -5,20 +5,22 @@ package File::Copy; -require Exporter; +use Exporter; use Carp; use UNIVERSAL qw(isa); +use vars qw( @ISA @EXPORT @EXPORT_OK $VERSION $Too_Big); +use strict; @ISA=qw(Exporter); -@EXPORT=qw(copy); -@EXPORT_OK=qw(copy cp); +@EXPORT=qw(copy move); +@EXPORT_OK=qw(cp mv); -$File::Copy::VERSION = '1.5'; -$File::Copy::Too_Big = 1024 * 1024 * 2; +$VERSION = '1.6'; +$Too_Big = 1024 * 1024 * 2; sub VERSION { # Version of File::Copy - return $File::Copy::VERSION; + return $VERSION; } sub copy { @@ -39,26 +41,22 @@ sub copy { local(*FROM, *TO); local($\) = ''; - 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')) { + if (ref($from) && (isa($from,'GLOB') || isa($from,'IO::Handle'))) { *FROM = *$from; + } elsif (ref(\$from) eq 'GLOB') { + *FROM = $from; } else { - open(FROM,"<$from")||goto(fail_open1); + open(FROM,"<$from") or 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')) { + if (ref($to) && (isa($to,'GLOB') || isa($to,'IO::Handle'))) { *TO = *$to; + } elsif (ref(\$to) eq 'GLOB') { + *TO = $to; } else { - open(TO,">$to")||goto(fail_open2); + open(TO,">$to") or goto fail_open2; binmode TO; $closeto=1; } @@ -69,7 +67,7 @@ sub copy { } else { $size = -s FROM; $size = 1024 if ($size < 512); - $size = $File::Copy::Too_Big if ($size > $File::Copy::Too_Big); + $size = $Too_Big if ($size > $Too_Big); } $buf = ''; @@ -78,7 +76,7 @@ sub copy { goto fail_inner; } } - goto fail_inner unless(defined($r)); + goto fail_inner unless defined($r); close(TO) || goto fail_open2 if $closeto; close(FROM) || goto fail_open1 if $closefrom; # Use this idiom to avoid uninitialized value warning. @@ -103,10 +101,29 @@ sub copy { return 0; } +sub move { + my($from,$to) = @_; + my($copied,$tosz1,$tomt1,$tosz2,$tomt2,$sts,$ossts); + + return 1 if rename $from, $to; + + ($tosz1,$tomt1) = (stat($to))[7,9]; + return 1 if ($copied = copy($from,$to)) && unlink($from); + + ($sts,$ossts) = ($! + 0, $^E + 0); + ($tosz2,$tomt2) = ((stat($to))[7,9],0,0) if defined $tomt1; + unlink($to) if !defined($tomt1) || $tomt1 != $tomt2 || $tosz1 != $tosz2; + ($!,$^E) = ($sts,$ossts); + return 0; +} -*cp = \© +{ + local($^W) = 0; # Hush up used-once warning + *cp = \© + *mv = \&move; +} # &syscopy is an XSUB under OS/2 -*syscopy = ($^O eq 'VMS' ? \&rmscopy : \©) unless $^O eq 'os2'; +*syscopy = ($^O eq 'VMS' ? \&rmscopy : \©) unless defined &syscopy; 1; @@ -122,6 +139,7 @@ File::Copy - Copy files or filehandles copy("file1","file2"); copy("Copy.pm",\*STDOUT);' + move("/dev1/fileA","/dev2/fileB"); use POSIX; use File::Copy cp; @@ -131,7 +149,15 @@ File::Copy - Copy files or filehandles =head1 DESCRIPTION -The File::Copy module provides a basic function C<copy> which takes two +The File::Copy module provides two basic functions, C<copy> and +C<move>, which are useful for getting the contents of a file from +one place to another. + +=over 4 + +=item * + +The C<copy> function 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 @@ -152,6 +178,20 @@ upon the file, but will generally be the whole file (up to 2Mb), or 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. +=item * + +The C<move> function also takes two parameters: the current name +and the intended name of the file to be moved. If possible, it +will simply rename the file. Otherwise, it copies the file to +the new location and deletes the original. If an error occurs during +this copy-and-delete process, you may be left with a (possibly partial) +copy of the file under the destination name. + +You may use the "mv" alias for this function in the same way that +you may use the "cp" alias for C<copy>. + +=back + 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 @@ -163,7 +203,7 @@ XSUB directly. =head2 Special behavior if C<syscopy> is defined (VMS and OS/2) If the second argument to C<copy> is not a file handle for an -already opened file, then C<copy> will perform an "system copy" of +already opened file, then C<copy> will perform a "system 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 @@ -175,7 +215,7 @@ The system copy routine may also be called directly under VMS and OS/2 as C<File::Copy::syscopy> (or under VMS as C<File::Copy::rmscopy>, which is just an alias for this routine). -=over +=over 4 =item rmscopy($from,$to[,$date_flag]) @@ -215,13 +255,13 @@ 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. +All functions return 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. +File::Copy was written by Aaron Sherman I<E<lt>ajs@ajs.comE<gt>> in 1995, +and updated by Charles Bailey I<E<lt>bailey@genetics.upenn.eduE<gt>> in 1996. =cut + |