1 package ExtUtils::Command;
9 use File::Path qw(rmtree);
11 use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
13 @EXPORT = qw(cp rm_f rm_rf mv cat eqtime mkpath touch test_f test_d chmod
17 my $Is_VMS = $^O eq 'VMS';
21 ExtUtils::Command - utilities to replace common UNIX commands in Makefiles etc.
25 perl -MExtUtils::Command -e cat files... > destination
26 perl -MExtUtils::Command -e mv source... destination
27 perl -MExtUtils::Command -e cp source... destination
28 perl -MExtUtils::Command -e touch files...
29 perl -MExtUtils::Command -e rm_f files...
30 perl -MExtUtils::Command -e rm_rf directories...
31 perl -MExtUtils::Command -e mkpath directories...
32 perl -MExtUtils::Command -e eqtime source destination
33 perl -MExtUtils::Command -e test_f file
34 perl -MExtUtils::Command -e test_d directory
35 perl -MExtUtils::Command -e chmod mode files...
40 The module is used to replace common UNIX commands. In all cases the
41 functions work from @ARGV rather than taking arguments. This makes
42 them easier to deal with in Makefiles. Call them like this:
44 perl -MExtUtils::Command -e some_command some files to work on
48 perl -MExtUtils::Command -e 'some_command qw(some files to work on)'
50 For that use L<Shell::Command>.
52 Filenames with * and ? will be glob expanded.
61 # VMS uses % instead of ? to mean "one character"
62 my $wild_regex = $Is_VMS ? '*%' : '*?';
65 @ARGV = map(/[$wild_regex]/o ? glob($_) : $_,@ARGV);
73 Concatenates all files mentioned on command line to STDOUT.
85 eqtime source destination
87 Sets modified time of destination to that of source.
93 my ($src,$dst) = @ARGV;
94 local @ARGV = ($dst); touch(); # in case $dst doesn't exist
95 utime((stat($src))[8,9],$dst);
100 rm_rf files or directories ...
102 Removes files and directories - recursively (even if readonly)
109 rmtree([grep -e $_,@ARGV],0,0);
116 Removes files (even if readonly)
123 foreach my $file (@ARGV) {
124 next unless -f $file;
126 next if _unlink($file);
130 next if _unlink($file);
132 carp "Cannot delete $file: $!";
137 my $files_unlinked = 0;
138 foreach my $file (@_) {
139 my $delete_count = 0;
140 $delete_count++ while unlink $file;
141 $files_unlinked++ if $delete_count;
143 return $files_unlinked;
151 Makes files exist, with current timestamp
158 foreach my $file (@ARGV) {
159 open(FILE,">>$file") || die "Cannot write $file:$!";
167 mv source_file destination_file
168 mv source_file source_file destination_dir
170 Moves source to destination. Multiple sources are allowed if
171 destination is an existing directory.
173 Returns true if all moves succeeded, false otherwise.
182 croak("Too many arguments") if (@src > 1 && ! -d $dst);
185 foreach my $src (@src) {
186 $nok ||= !move($src,$dst);
193 cp source_file destination_file
194 cp source_file source_file destination_dir
196 Copies sources to the destination. Multiple sources are allowed if
197 destination is an existing directory.
199 Returns true if all copies succeeded, false otherwise.
208 croak("Too many arguments") if (@src > 1 && ! -d $dst);
211 foreach my $src (@src) {
212 $nok ||= !copy($src,$dst);
221 Sets UNIX like permissions 'mode' on all the files. e.g. 0666
227 my $mode = shift(@ARGV);
231 foreach my $idx (0..$#ARGV) {
232 my $path = $ARGV[$idx];
233 next unless -d $path;
235 # chmod 0777, [.foo.bar] doesn't work on VMS, you have to do
236 # chmod 0777, [.foo]bar.dir
237 my @dirs = File::Spec->splitdir( $path );
239 $path = File::Spec->catfile(@dirs);
245 chmod(oct $mode,@ARGV) || die "Cannot chmod ".join(' ',$mode,@ARGV).":$!";
252 Creates directories, including any parent directories.
259 File::Path::mkpath([@ARGV],0,0777);
266 Tests if a file exists. I<Exits> with 0 if it does, 1 if it does not (ie.
267 shell's idea of true and false).
273 exit(-f $ARGV[0] ? 0 : 1);
280 Tests if a directory exists. I<Exits> with 0 if it does, 1 if it does
281 not (ie. shell's idea of true and false).
287 exit(-d $ARGV[0] ? 0 : 1);
292 dos2unix files or dirs ...
294 Converts DOS and OS/2 linefeeds to Unix style recursively.
300 File::Find::find(sub {
309 my $temp = '.dos2unix_tmp';
310 open ORIG, $_ or do { warn "dos2unix can't open $_: $!"; return };
311 open TEMP, ">$temp" or
312 do { warn "dos2unix can't create .dos2unix_tmp: $!"; return };
313 while (my $line = <ORIG>) {
314 $line =~ s/\015\012/\012/g;
328 Shell::Command which is these same functions but take arguments normally.
333 Nick Ing-Simmons C<ni-s@cpan.org>
335 Maintained by Michael G Schwern C<schwern@pobox.com> within the
336 ExtUtils-MakeMaker package and, as a separate CPAN package, by
337 Randy Kobes C<r.kobes@uwinnipeg.ca>.