From: Charles Bailey Date: Sat, 14 Dec 1996 05:27:29 +0000 (-0500) Subject: Re: Proposed addition to File::Copy: move X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=441496b2b4814536730a7c97d893a728a76c0c9d;p=p5sagit%2Fp5-mst-13.2.git 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> --- diff --git a/lib/File/Copy.pm b/lib/File/Copy.pm index 2e55559..6afbd39 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 which takes two +The File::Copy module provides two basic functions, C and +C, which are useful for getting the contents of a file from +one place to another. + +=over 4 + +=item * + +The C 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 to get at the "cp" alias for this function. The syntax is I the same. +=item * + +The C 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. + +=back + File::Copy also provides the C 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 is defined (VMS and OS/2) If the second argument to C is not a file handle for an -already opened file, then C will perform an "system copy" of +already opened file, then C will perform a "system copy" of the input file to a new output file, in order to preserve file attributes, indexed file structure, I The buffer size parameter is ignored. If the second argument to C is a @@ -175,7 +215,7 @@ The system copy routine may also be called directly under VMS and OS/2 as C (or under VMS as C, 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 Iajs@ajs.comE> in 1995. -The VMS-specific code was added by Charles Bailey -Ibailey@genetics.upenn.eduE> in March 1996. +File::Copy was written by Aaron Sherman Iajs@ajs.comE> in 1995, +and updated by Charles Bailey Ibailey@genetics.upenn.eduE> in 1996. =cut + diff --git a/t/lib/filecopy.t b/t/lib/filecopy.t index 4a5d1d7..8c64be1 100755 --- a/t/lib/filecopy.t +++ b/t/lib/filecopy.t @@ -5,7 +5,7 @@ BEGIN { @INC = '../lib'; } -print "1..3\n"; +print "1..5\n"; $| = 1; @@ -31,4 +31,13 @@ print "ok 2\n"; copy "copy-$$", \*STDOUT; unlink "file-$$"; -unlink "copy-$$"; + +print "not " if move("file-$$", "copy-$$") or not -e "copy-$$"; +print "ok 4\n"; + +move "copy-$$", "file-$$"; + +print "not " unless -e "file-$$" and not -e "copy-$$"; +print "ok 5\n"; + +unlink "file-$$";