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