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; |
57b1a898 |
11 | use vars qw(@ISA @EXPORT $VERSION); |
68dc0745 |
12 | @ISA = qw(Exporter); |
13 | @EXPORT = qw(cp rm_f rm_rf mv cat eqtime mkpath touch test_f); |
69ff8adf |
14 | $VERSION = '1.04'; |
68dc0745 |
15 | |
a67d7a01 |
16 | my $Is_VMS = $^O eq 'VMS'; |
17 | |
68dc0745 |
18 | =head1 NAME |
19 | |
20 | ExtUtils::Command - utilities to replace common UNIX commands in Makefiles etc. |
21 | |
dc848c6f |
22 | =head1 SYNOPSIS |
68dc0745 |
23 | |
84902520 |
24 | perl -MExtUtils::Command -e cat files... > destination |
25 | perl -MExtUtils::Command -e mv source... destination |
26 | perl -MExtUtils::Command -e cp source... destination |
27 | perl -MExtUtils::Command -e touch files... |
28 | perl -MExtUtils::Command -e rm_f file... |
29 | perl -MExtUtils::Command -e rm_rf directories... |
30 | perl -MExtUtils::Command -e mkpath directories... |
31 | perl -MExtUtils::Command -e eqtime source destination |
32 | perl -MExtUtils::Command -e chmod mode files... |
33 | perl -MExtUtils::Command -e test_f file |
68dc0745 |
34 | |
35 | =head1 DESCRIPTION |
36 | |
57b1a898 |
37 | The module is used to replace common UNIX commands. In all cases the |
38 | functions work from @ARGV rather than taking arguments. This makes |
39 | them easier to deal with in Makefiles. |
40 | |
41 | perl -MExtUtils::Command -e some_command some files to work on |
42 | |
43 | I<NOT> |
44 | |
45 | perl -MExtUtils::Command -e 'some_command qw(some files to work on)' |
46 | |
47 | Filenames with * and ? will be glob expanded. |
68dc0745 |
48 | |
49 | =over 4 |
50 | |
3fe9a6f1 |
51 | =cut |
52 | |
a67d7a01 |
53 | # VMS uses % instead of ? to mean "one character" |
54 | my $wild_regex = $Is_VMS ? '*%' : '*?'; |
3fe9a6f1 |
55 | sub expand_wildcards |
56 | { |
a67d7a01 |
57 | @ARGV = map(/[$wild_regex]/o ? glob($_) : $_,@ARGV); |
3fe9a6f1 |
58 | } |
59 | |
68dc0745 |
60 | =item cat |
61 | |
3fe9a6f1 |
62 | Concatenates all files mentioned on command line to STDOUT. |
68dc0745 |
63 | |
64 | =cut |
65 | |
66 | sub cat () |
67 | { |
3fe9a6f1 |
68 | expand_wildcards(); |
68dc0745 |
69 | print while (<>); |
70 | } |
71 | |
72 | =item eqtime src dst |
73 | |
74 | Sets modified time of dst to that of src |
75 | |
76 | =cut |
77 | |
78 | sub eqtime |
79 | { |
80 | my ($src,$dst) = @ARGV; |
a6bd83f0 |
81 | open(F,">>$dst"); |
68dc0745 |
82 | close(F); |
83 | utime((stat($src))[8,9],$dst); |
84 | } |
85 | |
e38fdfdb |
86 | =item rm_rf files.... |
68dc0745 |
87 | |
88 | Removes directories - recursively (even if readonly) |
89 | |
90 | =cut |
91 | |
92 | sub rm_rf |
93 | { |
57b1a898 |
94 | expand_wildcards(); |
95 | rmtree([grep -e $_,@ARGV],0,0); |
68dc0745 |
96 | } |
97 | |
98 | =item rm_f files.... |
99 | |
100 | Removes files (even if readonly) |
101 | |
102 | =cut |
103 | |
104 | sub rm_f |
105 | { |
57b1a898 |
106 | expand_wildcards(); |
107 | foreach (@ARGV) |
68dc0745 |
108 | { |
d5d4ec93 |
109 | next unless -f $_; |
3fe9a6f1 |
110 | next if unlink($_); |
d5d4ec93 |
111 | chmod(0777,$_); |
3fe9a6f1 |
112 | next if unlink($_); |
113 | carp "Cannot delete $_:$!"; |
68dc0745 |
114 | } |
115 | } |
116 | |
117 | =item touch files ... |
118 | |
119 | Makes files exist, with current timestamp |
120 | |
121 | =cut |
122 | |
123 | sub touch |
124 | { |
5b0d9cbe |
125 | my $t = time; |
fbac1b85 |
126 | expand_wildcards(); |
68dc0745 |
127 | while (@ARGV) |
128 | { |
69ff8adf |
129 | my $file = shift(@ARGV); |
68dc0745 |
130 | open(FILE,">>$file") || die "Cannot write $file:$!"; |
131 | close(FILE); |
5b0d9cbe |
132 | utime($t,$t,$file); |
68dc0745 |
133 | } |
134 | } |
135 | |
136 | =item mv source... destination |
137 | |
138 | Moves source to destination. |
139 | Multiple sources are allowed if destination is an existing directory. |
140 | |
141 | =cut |
142 | |
143 | sub mv |
144 | { |
145 | my $dst = pop(@ARGV); |
3fe9a6f1 |
146 | expand_wildcards(); |
147 | croak("Too many arguments") if (@ARGV > 1 && ! -d $dst); |
148 | while (@ARGV) |
68dc0745 |
149 | { |
d5d4ec93 |
150 | my $src = shift(@ARGV); |
3fe9a6f1 |
151 | move($src,$dst); |
68dc0745 |
152 | } |
153 | } |
154 | |
155 | =item cp source... destination |
156 | |
157 | Copies source to destination. |
158 | Multiple sources are allowed if destination is an existing directory. |
159 | |
d5d4ec93 |
160 | =cut |
68dc0745 |
161 | |
162 | sub cp |
163 | { |
164 | my $dst = pop(@ARGV); |
3fe9a6f1 |
165 | expand_wildcards(); |
166 | croak("Too many arguments") if (@ARGV > 1 && ! -d $dst); |
167 | while (@ARGV) |
68dc0745 |
168 | { |
d5d4ec93 |
169 | my $src = shift(@ARGV); |
3fe9a6f1 |
170 | copy($src,$dst); |
68dc0745 |
171 | } |
172 | } |
173 | |
174 | =item chmod mode files... |
175 | |
176 | Sets UNIX like permissions 'mode' on all the files. |
177 | |
178 | =cut |
179 | |
180 | sub chmod |
181 | { |
3fe9a6f1 |
182 | my $mode = shift(@ARGV); |
57b1a898 |
183 | expand_wildcards(); |
184 | chmod($mode,@ARGV) || die "Cannot chmod ".join(' ',$mode,@ARGV).":$!"; |
68dc0745 |
185 | } |
186 | |
187 | =item mkpath directory... |
188 | |
189 | Creates directory, including any parent directories. |
190 | |
191 | =cut |
192 | |
193 | sub mkpath |
194 | { |
57b1a898 |
195 | expand_wildcards(); |
196 | File::Path::mkpath([@ARGV],0,0777); |
68dc0745 |
197 | } |
198 | |
199 | =item test_f file |
200 | |
201 | Tests if a file exists |
202 | |
203 | =cut |
204 | |
205 | sub test_f |
206 | { |
207 | exit !-f shift(@ARGV); |
208 | } |
209 | |
5b0d9cbe |
210 | |
68dc0745 |
211 | 1; |
212 | __END__ |
213 | |
214 | =back |
215 | |
216 | =head1 BUGS |
217 | |
68dc0745 |
218 | Should probably be Auto/Self loaded. |
219 | |
220 | =head1 SEE ALSO |
221 | |
222 | ExtUtils::MakeMaker, ExtUtils::MM_Unix, ExtUtils::MM_Win32 |
223 | |
224 | =head1 AUTHOR |
225 | |
226 | Nick Ing-Simmons <F<nick@ni-s.u-net.com>>. |
227 | |
228 | =cut |
229 | |