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