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';
18 my $Is_VMS_mode = $Is_VMS;
19 my $Is_VMS_noefs = $Is_VMS;
20 my $Is_Win32 = $^O eq 'MSWin32';
27 if (eval { local $SIG{__DIE__}; require VMS::Feature; }) {
28 $vms_unix_rpt = VMS::Feature::current("filename_unix_report");
29 $vms_efs = VMS::Feature::current("efs_charset");
30 $vms_case = VMS::Feature::current("efs_case_preserve");
32 my $unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || '';
33 my $efs_charset = $ENV{'DECC$EFS_CHARSET'} || '';
34 my $efs_case = $ENV{'DECC$EFS_CASE_PRESERVE'} || '';
35 $vms_unix_rpt = $unix_rpt =~ /^[ET1]/i;
36 $vms_efs = $efs_charset =~ /^[ET1]/i;
37 $vms_case = $efs_case =~ /^[ET1]/i;
39 $Is_VMS_mode = 0 if $vms_unix_rpt;
40 $Is_VMS_noefs = 0 if ($vms_efs);
46 ExtUtils::Command - utilities to replace common UNIX commands in Makefiles etc.
50 perl -MExtUtils::Command -e cat files... > destination
51 perl -MExtUtils::Command -e mv source... destination
52 perl -MExtUtils::Command -e cp source... destination
53 perl -MExtUtils::Command -e touch files...
54 perl -MExtUtils::Command -e rm_f files...
55 perl -MExtUtils::Command -e rm_rf directories...
56 perl -MExtUtils::Command -e mkpath directories...
57 perl -MExtUtils::Command -e eqtime source destination
58 perl -MExtUtils::Command -e test_f file
59 perl -MExtUtils::Command -e test_d directory
60 perl -MExtUtils::Command -e chmod mode files...
65 The module is used to replace common UNIX commands. In all cases the
66 functions work from @ARGV rather than taking arguments. This makes
67 them easier to deal with in Makefiles. Call them like this:
69 perl -MExtUtils::Command -e some_command some files to work on
73 perl -MExtUtils::Command -e 'some_command qw(some files to work on)'
75 For that use L<Shell::Command>.
77 Filenames with * and ? will be glob expanded.
86 # VMS uses % instead of ? to mean "one character"
87 my $wild_regex = $Is_VMS ? '*%' : '*?';
90 @ARGV = map(/[$wild_regex]/o ? glob($_) : $_,@ARGV);
98 Concatenates all files mentioned on command line to STDOUT.
110 eqtime source destination
112 Sets modified time of destination to that of source.
118 my ($src,$dst) = @ARGV;
119 local @ARGV = ($dst); touch(); # in case $dst doesn't exist
120 utime((stat($src))[8,9],$dst);
125 rm_rf files or directories ...
127 Removes files and directories - recursively (even if readonly)
134 rmtree([grep -e $_,@ARGV],0,0);
141 Removes files (even if readonly)
148 foreach my $file (@ARGV) {
149 next unless -f $file;
151 next if _unlink($file);
155 next if _unlink($file);
157 carp "Cannot delete $file: $!";
162 my $files_unlinked = 0;
163 foreach my $file (@_) {
164 my $delete_count = 0;
165 $delete_count++ while unlink $file;
166 $files_unlinked++ if $delete_count;
168 return $files_unlinked;
176 Makes files exist, with current timestamp
183 foreach my $file (@ARGV) {
184 open(FILE,">>$file") || die "Cannot write $file:$!";
192 mv source_file destination_file
193 mv source_file source_file destination_dir
195 Moves source to destination. Multiple sources are allowed if
196 destination is an existing directory.
198 Returns true if all moves succeeded, false otherwise.
207 croak("Too many arguments") if (@src > 1 && ! -d $dst);
210 foreach my $src (@src) {
211 $nok ||= !move($src,$dst);
218 cp source_file destination_file
219 cp source_file source_file destination_dir
221 Copies sources to the destination. Multiple sources are allowed if
222 destination is an existing directory.
224 Returns true if all copies succeeded, false otherwise.
233 croak("Too many arguments") if (@src > 1 && ! -d $dst);
236 foreach my $src (@src) {
237 $nok ||= !copy($src,$dst);
239 # Win32 does not update the mod time of a copied file, just the
240 # created time which make does not look at.
241 utime(time, time, $dst) if $Is_Win32;
250 Sets UNIX like permissions 'mode' on all the files. e.g. 0666
256 my $mode = shift(@ARGV);
259 if( $Is_VMS_mode && $Is_VMS_noefs) {
260 foreach my $idx (0..$#ARGV) {
261 my $path = $ARGV[$idx];
262 next unless -d $path;
264 # chmod 0777, [.foo.bar] doesn't work on VMS, you have to do
265 # chmod 0777, [.foo]bar.dir
266 my @dirs = File::Spec->splitdir( $path );
268 $path = File::Spec->catfile(@dirs);
274 chmod(oct $mode,@ARGV) || die "Cannot chmod ".join(' ',$mode,@ARGV).":$!";
281 Creates directories, including any parent directories.
288 File::Path::mkpath([@ARGV],0,0777);
295 Tests if a file exists. I<Exits> with 0 if it does, 1 if it does not (ie.
296 shell's idea of true and false).
302 exit(-f $ARGV[0] ? 0 : 1);
309 Tests if a directory exists. I<Exits> with 0 if it does, 1 if it does
310 not (ie. shell's idea of true and false).
316 exit(-d $ARGV[0] ? 0 : 1);
321 dos2unix files or dirs ...
323 Converts DOS and OS/2 linefeeds to Unix style recursively.
329 File::Find::find(sub {
338 my $temp = '.dos2unix_tmp';
339 open ORIG, $_ or do { warn "dos2unix can't open $_: $!"; return };
340 open TEMP, ">$temp" or
341 do { warn "dos2unix can't create .dos2unix_tmp: $!"; return };
342 while (my $line = <ORIG>) {
343 $line =~ s/\015\012/\012/g;
357 Shell::Command which is these same functions but take arguments normally.
362 Nick Ing-Simmons C<ni-s@cpan.org>
364 Maintained by Michael G Schwern C<schwern@pobox.com> within the
365 ExtUtils-MakeMaker package and, as a separate CPAN package, by
366 Randy Kobes C<r.kobes@uwinnipeg.ca>.