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