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