This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade to ExtUtils::Command 1.15
[perl5.git] / lib / ExtUtils / Command.pm
CommitLineData
68dc0745 1package ExtUtils::Command;
17f410f9 2
57b1a898 3use 5.00503;
68dc0745 4use strict;
3fe9a6f1 5use Carp;
68dc0745 6use File::Copy;
7use File::Compare;
8use File::Basename;
9use File::Path qw(rmtree);
10require Exporter;
a7d1454b
RGS
11use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
12@ISA = qw(Exporter);
a85f5f83 13@EXPORT = qw(cp rm_f rm_rf mv cat eqtime mkpath touch test_f test_d chmod
a7d1454b 14 dos2unix);
8bdaab24
NC
15$VERSION = '1.15';
16
17my $Is_VMS = $^O eq 'VMS';
18my $Is_Win32 = $^O eq 'MSWin32';
68dc0745 19
a67d7a01 20
68dc0745 21=head1 NAME
22
23ExtUtils::Command - utilities to replace common UNIX commands in Makefiles etc.
24
dc848c6f 25=head1 SYNOPSIS
68dc0745 26
a85f5f83
SP
27 perl -MExtUtils::Command -e cat files... > destination
28 perl -MExtUtils::Command -e mv source... destination
29 perl -MExtUtils::Command -e cp source... destination
30 perl -MExtUtils::Command -e touch files...
31 perl -MExtUtils::Command -e rm_f files...
32 perl -MExtUtils::Command -e rm_rf directories...
33 perl -MExtUtils::Command -e mkpath directories...
34 perl -MExtUtils::Command -e eqtime source destination
35 perl -MExtUtils::Command -e test_f file
36 perl -MExtUtils::Command -e test_d directory
37 perl -MExtUtils::Command -e chmod mode files...
a7d1454b 38 ...
68dc0745 39
40=head1 DESCRIPTION
41
57b1a898
MS
42The module is used to replace common UNIX commands. In all cases the
43functions work from @ARGV rather than taking arguments. This makes
a85f5f83 44them easier to deal with in Makefiles. Call them like this:
57b1a898
MS
45
46 perl -MExtUtils::Command -e some_command some files to work on
47
a85f5f83 48and I<NOT> like this:
57b1a898
MS
49
50 perl -MExtUtils::Command -e 'some_command qw(some files to work on)'
51
a85f5f83
SP
52For that use L<Shell::Command>.
53
57b1a898 54Filenames with * and ? will be glob expanded.
68dc0745 55
a85f5f83
SP
56
57=head2 FUNCTIONS
58
68dc0745 59=over 4
60
3fe9a6f1 61=cut
62
a67d7a01
MS
63# VMS uses % instead of ? to mean "one character"
64my $wild_regex = $Is_VMS ? '*%' : '*?';
3fe9a6f1 65sub expand_wildcards
66{
a67d7a01 67 @ARGV = map(/[$wild_regex]/o ? glob($_) : $_,@ARGV);
3fe9a6f1 68}
69
479d2113 70
a85f5f83
SP
71=item cat
72
73 cat file ...
68dc0745 74
3fe9a6f1 75Concatenates all files mentioned on command line to STDOUT.
68dc0745 76
77=cut
78
79sub cat ()
80{
3fe9a6f1 81 expand_wildcards();
68dc0745 82 print while (<>);
83}
84
a85f5f83
SP
85=item eqtime
86
87 eqtime source destination
7292dc67 88
a85f5f83 89Sets modified time of destination to that of source.
68dc0745 90
91=cut
92
93sub eqtime
94{
95 my ($src,$dst) = @ARGV;
479d2113 96 local @ARGV = ($dst); touch(); # in case $dst doesn't exist
68dc0745 97 utime((stat($src))[8,9],$dst);
98}
99
a85f5f83 100=item rm_rf
7292dc67 101
a85f5f83
SP
102 rm_rf files or directories ...
103
104Removes files and directories - recursively (even if readonly)
68dc0745 105
106=cut
107
108sub rm_rf
109{
57b1a898
MS
110 expand_wildcards();
111 rmtree([grep -e $_,@ARGV],0,0);
68dc0745 112}
113
a85f5f83
SP
114=item rm_f
115
116 rm_f file ...
68dc0745 117
118Removes files (even if readonly)
119
120=cut
121
5dca256e
RGS
122sub rm_f {
123 expand_wildcards();
124
125 foreach my $file (@ARGV) {
126 next unless -f $file;
127
128 next if _unlink($file);
129
130 chmod(0777, $file);
131
132 next if _unlink($file);
a85f5f83 133
5dca256e
RGS
134 carp "Cannot delete $file: $!";
135 }
68dc0745 136}
137
5dca256e
RGS
138sub _unlink {
139 my $files_unlinked = 0;
140 foreach my $file (@_) {
141 my $delete_count = 0;
142 $delete_count++ while unlink $file;
143 $files_unlinked++ if $delete_count;
144 }
145 return $files_unlinked;
146}
147
148
a85f5f83
SP
149=item touch
150
151 touch file ...
68dc0745 152
153Makes files exist, with current timestamp
154
155=cut
156
479d2113
MS
157sub touch {
158 my $t = time;
159 expand_wildcards();
160 foreach my $file (@ARGV) {
161 open(FILE,">>$file") || die "Cannot write $file:$!";
162 close(FILE);
163 utime($t,$t,$file);
164 }
68dc0745 165}
166
a85f5f83
SP
167=item mv
168
169 mv source_file destination_file
170 mv source_file source_file destination_dir
68dc0745 171
a7d1454b
RGS
172Moves source to destination. Multiple sources are allowed if
173destination is an existing directory.
174
175Returns true if all moves succeeded, false otherwise.
68dc0745 176
177=cut
178
479d2113 179sub mv {
479d2113 180 expand_wildcards();
a7d1454b
RGS
181 my @src = @ARGV;
182 my $dst = pop @src;
183
184 croak("Too many arguments") if (@src > 1 && ! -d $dst);
185
186 my $nok = 0;
187 foreach my $src (@src) {
188 $nok ||= !move($src,$dst);
479d2113 189 }
a7d1454b 190 return !$nok;
68dc0745 191}
192
a85f5f83 193=item cp
7292dc67 194
a85f5f83
SP
195 cp source_file destination_file
196 cp source_file source_file destination_dir
197
198Copies sources to the destination. Multiple sources are allowed if
a7d1454b
RGS
199destination is an existing directory.
200
201Returns true if all copies succeeded, false otherwise.
68dc0745 202
d5d4ec93 203=cut
68dc0745 204
479d2113 205sub cp {
479d2113 206 expand_wildcards();
a7d1454b
RGS
207 my @src = @ARGV;
208 my $dst = pop @src;
209
210 croak("Too many arguments") if (@src > 1 && ! -d $dst);
211
212 my $nok = 0;
213 foreach my $src (@src) {
214 $nok ||= !copy($src,$dst);
8bdaab24
NC
215
216 # Win32 does not update the mod time of a copied file, just the
217 # created time which make does not look at.
218 utime(time, time, $dst) if $Is_Win32;
479d2113 219 }
a7d1454b 220 return $nok;
68dc0745 221}
222
a85f5f83
SP
223=item chmod
224
225 chmod mode files ...
68dc0745 226
479d2113 227Sets UNIX like permissions 'mode' on all the files. e.g. 0666
68dc0745 228
229=cut
230
479d2113 231sub chmod {
a7d1454b 232 local @ARGV = @ARGV;
479d2113
MS
233 my $mode = shift(@ARGV);
234 expand_wildcards();
5dca256e
RGS
235
236 if( $Is_VMS ) {
237 foreach my $idx (0..$#ARGV) {
238 my $path = $ARGV[$idx];
239 next unless -d $path;
240
241 # chmod 0777, [.foo.bar] doesn't work on VMS, you have to do
242 # chmod 0777, [.foo]bar.dir
243 my @dirs = File::Spec->splitdir( $path );
244 $dirs[-1] .= '.dir';
245 $path = File::Spec->catfile(@dirs);
246
247 $ARGV[$idx] = $path;
248 }
249 }
250
479d2113 251 chmod(oct $mode,@ARGV) || die "Cannot chmod ".join(' ',$mode,@ARGV).":$!";
68dc0745 252}
253
a85f5f83
SP
254=item mkpath
255
256 mkpath directory ...
7292dc67 257
a85f5f83 258Creates directories, including any parent directories.
68dc0745 259
260=cut
261
262sub mkpath
263{
57b1a898
MS
264 expand_wildcards();
265 File::Path::mkpath([@ARGV],0,0777);
68dc0745 266}
267
a85f5f83 268=item test_f
68dc0745 269
a85f5f83
SP
270 test_f file
271
272Tests if a file exists. I<Exits> with 0 if it does, 1 if it does not (ie.
273shell's idea of true and false).
68dc0745 274
275=cut
276
277sub test_f
278{
a85f5f83 279 exit(-f $ARGV[0] ? 0 : 1);
68dc0745 280}
281
a85f5f83 282=item test_d
f353a419 283
a85f5f83 284 test_d directory
f353a419 285
a85f5f83
SP
286Tests if a directory exists. I<Exits> with 0 if it does, 1 if it does
287not (ie. shell's idea of true and false).
288
289=cut
a7d1454b 290
f353a419
SP
291sub test_d
292{
a85f5f83 293 exit(-d $ARGV[0] ? 0 : 1);
f353a419
SP
294}
295
296=item dos2unix
7292dc67 297
a85f5f83
SP
298 dos2unix files or dirs ...
299
a7d1454b 300Converts DOS and OS/2 linefeeds to Unix style recursively.
5b0d9cbe 301
a7d1454b
RGS
302=cut
303
304sub dos2unix {
305 require File::Find;
306 File::Find::find(sub {
dd0810f9 307 return if -d;
a7d1454b 308 return unless -w _;
dd0810f9 309 return unless -r _;
a7d1454b
RGS
310 return if -B _;
311
a7d1454b
RGS
312 local $\;
313
dd0810f9
RGS
314 my $orig = $_;
315 my $temp = '.dos2unix_tmp';
316 open ORIG, $_ or do { warn "dos2unix can't open $_: $!"; return };
317 open TEMP, ">$temp" or
318 do { warn "dos2unix can't create .dos2unix_tmp: $!"; return };
319 while (my $line = <ORIG>) {
320 $line =~ s/\015\012/\012/g;
321 print TEMP $line;
a7d1454b 322 }
dd0810f9
RGS
323 close ORIG;
324 close TEMP;
325 rename $temp, $orig;
a7d1454b
RGS
326
327 }, @ARGV);
328}
68dc0745 329
330=back
331
a85f5f83 332=head1 SEE ALSO
f353a419 333
a85f5f83 334Shell::Command which is these same functions but take arguments normally.
7292dc67 335
68dc0745 336
337=head1 AUTHOR
338
a7d1454b
RGS
339Nick Ing-Simmons C<ni-s@cpan.org>
340
f353a419
SP
341Maintained by Michael G Schwern C<schwern@pobox.com> within the
342ExtUtils-MakeMaker package and, as a separate CPAN package, by
343Randy Kobes C<r.kobes@uwinnipeg.ca>.
68dc0745 344
345=cut
346