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