1package ExtUtils::Command; 2 3use 5.00503; 4use strict; 5use Carp; 6use File::Copy; 7use File::Compare; 8use File::Basename; 9use File::Path qw(rmtree); 10require Exporter; 11use vars qw(@ISA @EXPORT $VERSION); 12@ISA = qw(Exporter); 13@EXPORT = qw(cp rm_f rm_rf mv cat eqtime mkpath touch test_f); 14$VERSION = '1.05'; 15 16my $Is_VMS = $^O eq 'VMS'; 17 18=head1 NAME 19 20ExtUtils::Command - utilities to replace common UNIX commands in Makefiles etc. 21 22=head1 SYNOPSIS 23 24 perl -MExtUtils::Command -e cat files... > destination 25 perl -MExtUtils::Command -e mv source... destination 26 perl -MExtUtils::Command -e cp source... destination 27 perl -MExtUtils::Command -e touch files... 28 perl -MExtUtils::Command -e rm_f files... 29 perl -MExtUtils::Command -e rm_rf directories... 30 perl -MExtUtils::Command -e mkpath directories... 31 perl -MExtUtils::Command -e eqtime source destination 32 perl -MExtUtils::Command -e test_f file 33 perl -MExtUtils::Command=chmod -e chmod mode files... 34 35=head1 DESCRIPTION 36 37The module is used to replace common UNIX commands. In all cases the 38functions work from @ARGV rather than taking arguments. This makes 39them easier to deal with in Makefiles. 40 41 perl -MExtUtils::Command -e some_command some files to work on 42 43I<NOT> 44 45 perl -MExtUtils::Command -e 'some_command qw(some files to work on)' 46 47Filenames with * and ? will be glob expanded. 48 49=over 4 50 51=cut 52 53# VMS uses % instead of ? to mean "one character" 54my $wild_regex = $Is_VMS ? '*%' : '*?'; 55sub expand_wildcards 56{ 57 @ARGV = map(/[$wild_regex]/o ? glob($_) : $_,@ARGV); 58} 59 60 61=item cat 62 63Concatenates all files mentioned on command line to STDOUT. 64 65=cut 66 67sub cat () 68{ 69 expand_wildcards(); 70 print while (<>); 71} 72 73=item eqtime src dst 74 75Sets modified time of dst to that of src 76 77=cut 78 79sub eqtime 80{ 81 my ($src,$dst) = @ARGV; 82 local @ARGV = ($dst); touch(); # in case $dst doesn't exist 83 utime((stat($src))[8,9],$dst); 84} 85 86=item rm_rf files.... 87 88Removes directories - recursively (even if readonly) 89 90=cut 91 92sub rm_rf 93{ 94 expand_wildcards(); 95 rmtree([grep -e $_,@ARGV],0,0); 96} 97 98=item rm_f files.... 99 100Removes files (even if readonly) 101 102=cut 103 104sub rm_f 105{ 106 expand_wildcards(); 107 foreach (@ARGV) 108 { 109 next unless -f $_; 110 next if unlink($_); 111 chmod(0777,$_); 112 next if unlink($_); 113 carp "Cannot delete $_:$!"; 114 } 115} 116 117=item touch files ... 118 119Makes files exist, with current timestamp 120 121=cut 122 123sub touch { 124 my $t = time; 125 expand_wildcards(); 126 foreach my $file (@ARGV) { 127 open(FILE,">>$file") || die "Cannot write $file:$!"; 128 close(FILE); 129 utime($t,$t,$file); 130 } 131} 132 133=item mv source... destination 134 135Moves source to destination. 136Multiple sources are allowed if destination is an existing directory. 137 138=cut 139 140sub mv { 141 my $dst = pop(@ARGV); 142 expand_wildcards(); 143 croak("Too many arguments") if (@ARGV > 1 && ! -d $dst); 144 foreach my $src (@ARGV) { 145 move($src,$dst); 146 } 147} 148 149=item cp source... destination 150 151Copies source to destination. 152Multiple sources are allowed if destination is an existing directory. 153 154=cut 155 156sub cp { 157 my $dst = pop(@ARGV); 158 expand_wildcards(); 159 croak("Too many arguments") if (@ARGV > 1 && ! -d $dst); 160 foreach my $src (@ARGV) { 161 copy($src,$dst); 162 } 163} 164 165=item chmod mode files... 166 167Sets UNIX like permissions 'mode' on all the files. e.g. 0666 168 169=cut 170 171sub chmod { 172 my $mode = shift(@ARGV); 173 expand_wildcards(); 174 chmod(oct $mode,@ARGV) || die "Cannot chmod ".join(' ',$mode,@ARGV).":$!"; 175} 176 177=item mkpath directory... 178 179Creates directory, including any parent directories. 180 181=cut 182 183sub mkpath 184{ 185 expand_wildcards(); 186 File::Path::mkpath([@ARGV],0,0777); 187} 188 189=item test_f file 190 191Tests if a file exists 192 193=cut 194 195sub test_f 196{ 197 exit !-f shift(@ARGV); 198} 199 200 2011; 202__END__ 203 204=back 205 206=head1 BUGS 207 208Should probably be Auto/Self loaded. 209 210=head1 SEE ALSO 211 212ExtUtils::MakeMaker, ExtUtils::MM_Unix, ExtUtils::MM_Win32 213 214=head1 AUTHOR 215 216Nick Ing-Simmons <F<nick@ni-s.u-net.com>>. 217 218=cut 219 220