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 MS |
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 TB |
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 MS |
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 MS |
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; | |
81 | open(F,">$dst"); | |
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 MS |
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 MS |
106 | expand_wildcards(); |
107 | foreach (@ARGV) | |
68dc0745 | 108 | { |
3fe9a6f1 | 109 | next unless -f $_; |
110 | next if unlink($_); | |
111 | chmod(0777,$_); | |
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 | { |
3fe9a6f1 | 150 | my $src = shift(@ARGV); |
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 | ||
160 | =cut | |
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 | { |
3fe9a6f1 | 169 | my $src = shift(@ARGV); |
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 MS |
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 MS |
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 |