package ExtUtils::Command;
+
+use 5.005_64;
use strict;
# use AutoLoader;
+use Carp;
use File::Copy;
use File::Compare;
use File::Basename;
use File::Path qw(rmtree);
require Exporter;
-use vars qw(@ISA @EXPORT $VERSION);
+our(@ISA, @EXPORT, $VERSION);
@ISA = qw(Exporter);
@EXPORT = qw(cp rm_f rm_rf mv cat eqtime mkpath touch test_f);
-$VERSION = '1.00';
+$VERSION = '1.01';
=head1 NAME
ExtUtils::Command - utilities to replace common UNIX commands in Makefiles etc.
-=head1 SYNOPSYS
+=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 file...
- perl -MExtUtils::command -e rm_rf directories...
- perl -MExtUtils::command -e mkpath directories...
- perl -MExtUtils::command -e eqtime source destination
- perl -MExtUtils::command -e chmod mode files...
- perl -MExtUtils::command -e test_f file
+ 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 file...
+ perl -MExtUtils::Command -e rm_rf directories...
+ perl -MExtUtils::Command -e mkpath directories...
+ perl -MExtUtils::Command -e eqtime source destination
+ perl -MExtUtils::Command -e chmod mode files...
+ perl -MExtUtils::Command -e test_f file
=head1 DESCRIPTION
-The module is used in Win32 port to replace common UNIX commands.
-Most commands are wrapers on generic modules File::Path and File::Basename.
+The module is used in the Win32 port to replace common UNIX commands.
+Most commands are wrappers on generic modules File::Path and File::Basename.
=over 4
+=cut
+
+sub expand_wildcards
+{
+ @ARGV = map(/[\*\?]/ ? glob($_) : $_,@ARGV);
+}
+
=item cat
-Concatenates all files menthion on command line to STDOUT.
+Concatenates all files mentioned on command line to STDOUT.
=cut
sub cat ()
{
+ expand_wildcards();
print while (<>);
}
sub rm_rf
{
- rmtree([@ARGV],0,0);
+ rmtree([grep -e $_,expand_wildcards()],0,0);
}
=item rm_f files....
sub rm_f
{
- foreach (@ARGV)
+ foreach (expand_wildcards())
{
- next unless -e $_;
- chmod(0777,$_);
- next if (-f $_ and unlink($_));
- die "Cannot delete $_:$!";
+ next unless -f $_;
+ next if unlink($_);
+ chmod(0777,$_);
+ next if unlink($_);
+ carp "Cannot delete $_:$!";
}
}
sub touch
{
+ expand_wildcards();
+ my $t = time;
while (@ARGV)
{
my $file = shift(@ARGV);
open(FILE,">>$file") || die "Cannot write $file:$!";
close(FILE);
+ utime($t,$t,$file);
}
}
sub mv
{
my $dst = pop(@ARGV);
- if (-d $dst)
- {
- while (@ARGV)
- {
- my $src = shift(@ARGV);
- my $leaf = basename($src);
- move($src,"$dst/$leaf"); # fixme
- }
- }
- else
+ expand_wildcards();
+ croak("Too many arguments") if (@ARGV > 1 && ! -d $dst);
+ while (@ARGV)
{
- my $src = shift(@ARGV);
- move($src,$dst) || die "Cannot move $src $dst:$!";
+ my $src = shift(@ARGV);
+ move($src,$dst);
}
}
sub cp
{
my $dst = pop(@ARGV);
- if (-d $dst)
- {
- while (@ARGV)
- {
- my $src = shift(@ARGV);
- my $leaf = basename($src);
- copy($src,"$dst/$leaf"); # fixme
- }
- }
- else
+ expand_wildcards();
+ croak("Too many arguments") if (@ARGV > 1 && ! -d $dst);
+ while (@ARGV)
{
- copy(shift,$dst);
+ my $src = shift(@ARGV);
+ copy($src,$dst);
}
}
sub chmod
{
- chmod(@ARGV) || die "Cannot chmod ".join(' ',@ARGV).":$!";
+ my $mode = shift(@ARGV);
+ chmod($mode,expand_wildcards()) || die "Cannot chmod ".join(' ',$mode,@ARGV).":$!";
}
=item mkpath directory...
sub mkpath
{
- File::Path::mkpath([@ARGV],1,0777);
+ File::Path::mkpath([expand_wildcards()],0,0777);
}
=item test_f file
exit !-f shift(@ARGV);
}
+
1;
__END__
=head1 BUGS
-eqtime does not work right on Win32 due to problems with utime() built-in
-command.
-
Should probably be Auto/Self loaded.
=head1 SEE ALSO