Change 30174 by [EMAIL PROTECTED] on 2007/02/08 16:02:24
Integrate:
[ 28659]
Subject: [PATCH] File::Copy pod updated adding X<>
From: "Gabor Szabo" <[EMAIL PROTECTED]>
Date: Tue, 1 Aug 2006 08:55:37 +0200
Message-ID: <[EMAIL PROTECTED]>
[ 28869]
Subject: Re: [PATCH] lib/File/Copy.t - test descriptions and minor fixes
From: "Adriano Ferreira" <[EMAIL PROTECTED]>
Date: Mon, 18 Sep 2006 17:36:50 -0300
Message-ID: <[EMAIL PROTECTED]>
[ 30013]
Subject: Re: [perl #32135] File::Copy module
From: "Adriano Ferreira" <[EMAIL PROTECTED]>
Date: Fri, 26 Jan 2007 12:56:18 -0200
Message-ID: <[EMAIL PROTECTED]>
[ 30172]
Typo fix, by John P. Linderman
Affected files ...
... //depot/maint-5.8/perl/lib/File/Copy.pm#15 integrate
... //depot/maint-5.8/perl/lib/File/Copy.t#7 integrate
Differences ...
==== //depot/maint-5.8/perl/lib/File/Copy.pm#15 (text) ====
Index: perl/lib/File/Copy.pm
--- perl/lib/File/Copy.pm#14~26806~ 2006-01-12 11:23:34.000000000 -0800
+++ perl/lib/File/Copy.pm 2007-02-08 08:02:24.000000000 -0800
@@ -24,7 +24,7 @@
# package has not yet been updated to work with Perl 5.004, and so it
# would be a Bad Thing for the CPAN module to grab it and replace this
# module. Therefore, we set this module's version higher than 2.0.
-$VERSION = '2.09';
+$VERSION = '2.10';
require Exporter;
@ISA = qw(Exporter);
@@ -55,6 +55,14 @@
return File::Spec->catfile($to, basename($from));
}
+# _eq($from, $to) tells whether $from and $to are identical
+# works for strings and references
+sub _eq {
+ return $_[0] == $_[1] if ref $_[0] && ref $_[1];
+ return $_[0] eq $_[1] if !ref $_[0] && !ref $_[1];
+ return "";
+}
+
sub copy {
croak("Usage: copy(FROM, TO [, BUFFERSIZE]) ")
unless(@_ == 2 || @_ == 3);
@@ -73,7 +81,7 @@
|| UNIVERSAL::isa($to, 'IO::Handle'))
: (ref(\$to) eq 'GLOB'));
- if ($from eq $to) { # works for references, too
+ if (_eq($from, $to)) { # works for references, too
carp("'$from' and '$to' are identical (not copied)");
# The "copy" was a success as the source and destination contain
# the same data.
@@ -249,7 +257,8 @@
# preserve MPE file attributes.
return system('/bin/cp', '-f', $_[0], $_[1]) == 0;
};
- } elsif ($^O eq 'MSWin32') {
+ } elsif ($^O eq 'MSWin32' && defined &DynaLoader::boot_DynaLoader) {
+ # Win32::CopyFile() fill only work if we can load Win32.xs
*syscopy = sub {
return 0 unless @_ == 2;
return Win32::CopyFile(@_, 1);
@@ -305,7 +314,8 @@
=over 4
-=item *
+=item copy
+X<copy> X<cp>
The C<copy> function takes two
parameters: a file to copy from and a file to copy to. Either
@@ -325,7 +335,7 @@
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
+first file, that will 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).
@@ -333,7 +343,8 @@
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 *
+=item move
+X<move> X<mv> X<rename>
The C<move> function also takes two parameters: the current name
and the intended name of the file to be moved. If the destination
@@ -349,7 +360,8 @@
You may use the "mv" alias for this function in the same way that
you may use the "cp" alias for C<copy>.
-=back
+=item syscopy
+X<syscopy>
File::Copy also provides the C<syscopy> routine, which copies the
file specified in the first parameter to the file specified in the
@@ -363,7 +375,7 @@
On Mac OS (Classic), C<syscopy> calls C<Mac::MoreFiles::FSpFileCopy>,
if available.
-=head2 Special behaviour if C<syscopy> is defined (OS/2, VMS and Win32)
+B<Special behaviour if C<syscopy> is defined (OS/2, VMS and Win32)>
If both arguments to C<copy> are not file handles,
then C<copy> will perform a "system copy" of
@@ -378,9 +390,8 @@
as C<File::Copy::syscopy> (or under VMS as C<File::Copy::rmscopy>, which
is the routine that does the actual work for syscopy).
-=over 4
-
=item rmscopy($from,$to[,$date_flag])
+X<rmscopy>
The first and second arguments may be strings, typeglobs, typeglob
references, or objects inheriting from IO::Handle;
@@ -439,13 +450,13 @@
copy("file1", "tmp"); # creates the file 'tmp' in the current
directory
copy("file1", ":tmp:"); # creates :tmp:file1
copy("file1", ":tmp"); # same as above
- copy("file1", "tmp"); # same as above, if 'tmp' is a directory (but
don't do
+ copy("file1", "tmp"); # same as above, if 'tmp' is a directory (but
don't do
# that, since it may cause confusion, see
example #1)
copy("file1", "tmp:file1"); # error, since 'tmp:' is not a volume
copy("file1", ":tmp:file1"); # ok, partial path
copy("file1", "DataHD:"); # creates DataHD:file1
-
- move("MacintoshHD:fileA", "DataHD:fileB"); # moves (don't copies) files from
one
+
+ move("MacintoshHD:fileA", "DataHD:fileB"); # moves (don't copies) files from
one
# volume to another
=back
==== //depot/maint-5.8/perl/lib/File/Copy.t#7 (xtext) ====
Index: perl/lib/File/Copy.t
--- perl/lib/File/Copy.t#6~26956~ 2006-01-27 03:35:12.000000000 -0800
+++ perl/lib/File/Copy.t 2007-02-08 08:02:24.000000000 -0800
@@ -1,8 +1,10 @@
#!./perl
BEGIN {
- chdir 't' if -d 't';
- @INC = '../lib';
+ if( $ENV{PERL_CORE} ) {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ }
}
use Test::More;
@@ -25,7 +27,7 @@
)
{
eval $code;
- like $@, qr/^Usage: /;
+ like $@, qr/^Usage: /, "'$code' is a usage error";
}
@@ -49,10 +51,11 @@
$foo = <F>;
close(F);
- is -s "file-$$", -s "copy-$$";
+ is -s "file-$$", -s "copy-$$", 'copy(fn, fn): files of the same size';
- is $foo, "ok\n";
+ is $foo, "ok\n", 'copy(fn, fn): same contents';
+ print("# next test checks copying to STDOUT\n");
binmode STDOUT unless $^O eq 'VMS'; # Copy::copy works in binary mode
# This outputs "ok" so its a test.
copy "copy-$$", \*STDOUT;
@@ -62,14 +65,14 @@
open(F,"file-$$");
copy(*F, "copy-$$");
open(R, "copy-$$") or die "open copy-$$: $!"; $foo = <R>; close(R);
- is $foo, "ok\n";
+ is $foo, "ok\n", 'copy(*F, fn): same contents';
unlink "copy-$$" or die "unlink: $!";
open(F,"file-$$");
copy(\*F, "copy-$$");
close(F) or die "close: $!";
open(R, "copy-$$") or die; $foo = <R>; close(R) or die "close: $!";
- is $foo, "ok\n";
+ is $foo, "ok\n", 'copy(\*F, fn): same contents';
unlink "copy-$$" or die "unlink: $!";
require IO::File;
@@ -78,7 +81,7 @@
copy("file-$$",$fh);
$fh->close or die "close: $!";
open(R, "copy-$$") or die; $foo = <R>; close(R);
- is $foo, "ok\n";
+ is $foo, "ok\n", 'copy(fn, io): same contents';
unlink "copy-$$" or die "unlink: $!";
require FileHandle;
@@ -87,7 +90,7 @@
copy("file-$$",$fh);
$fh->close;
open(R, "copy-$$") or die; $foo = <R>; close(R);
- is $foo, "ok\n";
+ is $foo, "ok\n", 'copy(fn, fh): same contents';
unlink "file-$$" or die "unlink: $!";
ok !move("file-$$", "copy-$$"), "move on missing file";
@@ -106,7 +109,7 @@
ok -e "file-$$", ' destination exists';
ok !-e "copy-$$", ' source does not';
open(R, "file-$$") or die; $foo = <R>; close(R);
- is $foo, "ok\n";
+ is $foo, "ok\n", 'contents preserved';
TODO: {
local $TODO = 'mtime only preserved on ODS-5 with POSIX dates and
DECC$EFS_FILE_TIMESTAMPS enabled' if $^O eq 'VMS';
@@ -117,30 +120,32 @@
($cross_partition_test ? " while testing cross-partition" : "");
}
+ # trick: create lib/ if not exists - not needed in Perl core
+ unless (-d 'lib') { mkdir 'lib' or die; }
copy "file-$$", "lib";
- open(R, "lib/file-$$") or die; $foo = <R>; close(R);
- is $foo, "ok\n";
+ open(R, "lib/file-$$") or die $!; $foo = <R>; close(R);
+ is $foo, "ok\n", 'copy(fn, dir): same contents';
unlink "lib/file-$$" or die "unlink: $!";
# Do it twice to ensure copying over the same file works.
copy "file-$$", "lib";
open(R, "lib/file-$$") or die; $foo = <R>; close(R);
- is $foo, "ok\n";
+ is $foo, "ok\n", 'copy over the same file works';
unlink "lib/file-$$" or die "unlink: $!";
{
my $warnings = '';
local $SIG{__WARN__} = sub { $warnings .= join '', @_ };
- ok copy("file-$$", "file-$$");
+ ok copy("file-$$", "file-$$"), 'copy(fn, fn) succeeds';
- like $warnings, qr/are identical/;
- ok -s "file-$$";
+ like $warnings, qr/are identical/, 'but warns';
+ ok -s "file-$$", 'contents preserved';
}
move "file-$$", "lib";
open(R, "lib/file-$$") or die "open lib/file-$$: $!"; $foo = <R>; close(R);
- is $foo, "ok\n";
- ok !-e "file-$$";
+ is $foo, "ok\n", 'move(fn, dir): same contents';
+ ok !-e "file-$$", 'file moved indeed';
unlink "lib/file-$$" or die "unlink: $!";
SKIP: {
@@ -153,9 +158,9 @@
my $warnings = '';
local $SIG{__WARN__} = sub { $warnings .= join '', @_ };
- ok !copy("file-$$", "symlink-$$");
+ ok !copy("file-$$", "symlink-$$"), 'copy to itself (via symlink) fails';
- like $warnings, qr/are identical/;
+ like $warnings, qr/are identical/, 'emits a warning';
ok !-z "file-$$",
'rt.perl.org 5196: copying to itself would truncate the file';
@@ -164,7 +169,8 @@
}
SKIP: {
- skip "Testing hard links", 3 if !$Config{d_link} or $^O eq 'MSWin32';
+ skip "Testing hard links", 3
+ if !$Config{d_link} or $^O eq 'MSWin32' or $^O eq 'cygwin';
open(F, ">file-$$") or die $!;
print F "dummy content\n";
@@ -173,9 +179,9 @@
my $warnings = '';
local $SIG{__WARN__} = sub { $warnings .= join '', @_ };
- ok !copy("file-$$", "hardlink-$$");
+ ok !copy("file-$$", "hardlink-$$"), 'copy to itself (via hardlink) fails';
- like $warnings, qr/are identical/;
+ like $warnings, qr/are identical/, 'emits a warning';
ok ! -z "file-$$",
'rt.perl.org 5196: copying to itself would truncate the file';
End of Patch.
