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