Bug #21982 for ExtUtils-Command: Retrograde motion

Here's a slightly more complete patch. Some additional fixes to the test.

=== lib/ExtUtils/Command.pm ================================================================== --- lib/ExtUtils/Command.pm (revision 19601) +++ lib/ExtUtils/Command.pm (local) @@ -10,9 +10,9 @@ require Exporter; use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); @ISA = qw(Exporter); -@EXPORT = qw(cp rm_f rm_rf mv cat eqtime mkpath touch test_f test_d chmod +@EXPORT = qw(cp rm_f rm_rf mv cat eqtime mkpath touch test_f test_d chmod dos2unix); -$VERSION = '1.11'; +$VERSION = '1.12'; my $Is_VMS = $^O eq 'VMS'; @@ -22,33 +22,38 @@ =head1 SYNOPSIS - perl -MExtUtils::Command -e cat files... > destination - perl -MExtUtils::Command -e mv source... destination - perl -MExtUtils::Command -e cp source... destination - perl -MExtUtils::Command -e touch files... - perl -MExtUtils::Command -e rm_f files... - perl -MExtUtils::Command -e rm_rf directories... - perl -MExtUtils::Command -e mkpath directories... - perl -MExtUtils::Command -e eqtime source destination - perl -MExtUtils::Command -e test_f file - perl -MExtUtils::Command -e test_d directory - perl -MExtUtils::Command -e chmod mode files... + perl -MExtUtils::Command -e cat files... > destination + perl -MExtUtils::Command -e mv source... destination + perl -MExtUtils::Command -e cp source... destination + perl -MExtUtils::Command -e touch files... + perl -MExtUtils::Command -e rm_f files... + perl -MExtUtils::Command -e rm_rf directories... + perl -MExtUtils::Command -e mkpath directories... + perl -MExtUtils::Command -e eqtime source destination + perl -MExtUtils::Command -e test_f file + perl -MExtUtils::Command -e test_d directory + perl -MExtUtils::Command -e chmod mode files... ... =head1 DESCRIPTION The module is used to replace common UNIX commands. In all cases the functions work from @ARGV rather than taking arguments. This makes -them easier to deal with in Makefiles. +them easier to deal with in Makefiles. Call them like this: perl -MExtUtils::Command -e some_command some files to work on -I<NOT> +and I<NOT> like this: perl -MExtUtils::Command -e 'some_command qw(some files to work on)' +For that use L<Shell::Command>. + Filenames with * and ? will be glob expanded. + +=head2 FUNCTIONS + =over 4 =cut @@ -61,8 +66,10 @@ } -=item cat +=item cat + cat file ... + Concatenates all files mentioned on command line to STDOUT. =cut @@ -73,10 +80,12 @@ print while (<>); } -=item eqtime src dst +=item eqtime -Sets modified time of dst to that of src + eqtime source destination +Sets modified time of destination to that of source. + =cut sub eqtime @@ -86,10 +95,12 @@ utime((stat($src))[8,9],$dst); } -=item rm_rf files.... +=item rm_rf -Removes directories - recursively (even if readonly) + rm_rf files or directories ... +Removes files and directories - recursively (even if readonly) + =cut sub rm_rf @@ -98,8 +109,10 @@ rmtree([grep -e $_,@ARGV],0,0); } -=item rm_f files.... +=item rm_f + rm_f file ... + Removes files (even if readonly) =cut @@ -115,7 +128,7 @@ chmod(0777, $file); next if _unlink($file); - + carp "Cannot delete $file: $!"; } } @@ -131,8 +144,10 @@ } -=item touch files ... +=item touch + touch file ... + Makes files exist, with current timestamp =cut @@ -147,8 +162,11 @@ } } -=item mv source... destination +=item mv + mv source_file destination_file + mv source_file source_file destination_dir + Moves source to destination. Multiple sources are allowed if destination is an existing directory. @@ -170,9 +188,12 @@ return !$nok; } -=item cp source... destination +=item cp -Copies source to destination. Multiple sources are allowed if + cp source_file destination_file + cp source_file source_file destination_dir + +Copies sources to the destination. Multiple sources are allowed if destination is an existing directory. Returns true if all copies succeeded, false otherwise. @@ -193,8 +214,10 @@ return $nok; } -=item chmod mode files... +=item chmod + chmod mode files ... + Sets UNIX like permissions 'mode' on all the files. e.g. 0666 =cut @@ -222,10 +245,12 @@ chmod(oct $mode,@ARGV) || die "Cannot chmod ".join(' ',$mode,@ARGV).":$!"; } -=item mkpath directory... +=item mkpath -Creates directory, including any parent directories. + mkpath directory ... +Creates directories, including any parent directories. + =cut sub mkpath @@ -234,30 +259,38 @@ File::Path::mkpath([@ARGV],0,0777); } -=item test_f file +=item test_f -Tests if a file exists + test_f file +Tests if a file exists. I<Exits> with 0 if it does, 1 if it does not (ie. +shell's idea of true and false). + =cut sub test_f { - exit !-f $ARGV[0]; + exit(-f $ARGV[0] ? 0 : 1); } -=item test_d directory +=item test_d -Tests if a directory exists + test_d directory -=cut +Tests if a directory exists. I<Exits> with 0 if it does, 1 if it does +not (ie. shell's idea of true and false). +=cut + sub test_d { - exit !-d $ARGV[0]; + exit(-d $ARGV[0] ? 0 : 1); } =item dos2unix + dos2unix files or dirs ... + Converts DOS and OS/2 linefeeds to Unix style recursively. =cut @@ -290,14 +323,11 @@ =back -=head1 BUGS +=head1 SEE ALSO -Should probably be Auto/Self loaded. +Shell::Command which is these same functions but take arguments normally. -=head1 SEE ALSO -ExtUtils::MakeMaker, ExtUtils::MM_Unix, ExtUtils::MM_Win32 - =head1 AUTHOR Nick Ing-Simmons C<ni-s@cpan.org> === t/eu_command.t ================================================================== --- t/eu_command.t (revision 19601) +++ t/eu_command.t (local) @@ -23,14 +23,14 @@ } BEGIN { - use Test::More tests => 41; + use Test::More tests => 40; use File::Spec; } BEGIN { # bad neighbor, but test_f() uses exit() - *CORE::GLOBAL::exit = ''; # quiet 'only once' warning. - *CORE::GLOBAL::exit = sub { return @_ }; + *CORE::GLOBAL::exit = ''; # quiet 'only once' warning. + *CORE::GLOBAL::exit = sub (;$) { return $_[0] }; use_ok( 'ExtUtils::Command' ); } @@ -53,19 +53,16 @@ is( scalar( $$out =~ s/use_ok\( 'ExtUtils::Command'//g), 2, 'concatenation worked' ); - # the truth value here is reversed -- Perl true is C false + # the truth value here is reversed -- Perl true is shell false @ARGV = ( $Testfile ); - ok( test_f(), 'testing non-existent file' ); + is( test_f(), 1, 'testing non-existent file' ); - @ARGV = ( $Testfile ); - cmp_ok( ! test_f(), '==', (-f $Testfile), 'testing non-existent file' ); - # these are destructive, have to keep setting @ARGV @ARGV = ( $Testfile ); touch(); @ARGV = ( $Testfile ); - ok( test_f(), 'now creating that file' ); + is( test_f(), 0, 'testing touch() and test_f()' ); is_deeply( \@ARGV, [$Testfile], 'test_f preserves @ARGV' ); @ARGV = ( $Testfile ); @@ -148,7 +145,7 @@ $^O eq 'NetWare' || $^O eq 'dos' || $^O eq 'cygwin' || $^O eq 'MacOS' ) { - skip( "different file permission semantics on $^O", 4); + skip( "different file permission semantics on $^O", 5); } @ARGV = ('testdir'); @@ -178,6 +175,7 @@ @ARGV = ('testdir'); rm_rf; + ok( ! -e 'testdir', 'rm_rf can delete a read-only dir' ); } @@ -185,15 +183,12 @@ my $test_dir = File::Spec->join( 'ecmddir', 'temp2' ); @ARGV = ( $test_dir ); ok( ! -e $ARGV[0], 'temp directory not there yet' ); - ok( test_d(), 'testing non-existent directory' ); + is( test_d(), 1, 'testing non-existent directory' ); @ARGV = ( $test_dir ); - cmp_ok( ! test_d(), '==', (-d $test_dir), 'testing non-existent dir' ); - - @ARGV = ( $test_dir ); mkpath(); ok( -e $ARGV[0], 'temp directory created' ); - cmp_ok( test_d(), '==', (-d $test_dir), 'testing existing dir' ); + is( test_d(), 0, 'testing existing dir' ); @ARGV = ( $test_dir ); # copy a file to a nested subdirectory