Skip to content

Commit 4d45967

Browse files
sschuberthsschuberth
committed
Perl: Add back more files which are required to install CPAN modules
c3b46a4 still removed too many files. Restore all files required to run $ perl -MCPAN -e 'install Test::Harness' which is a dependency of the "prove" command as suggested in git\t\README. The files were originally removed in order to reduce the installer size. This commit adds about 5 MiB of uncompressed text files, increasing the compressed installer by about 420 KiB. Signed-off-by: Sebastian Schuberth <[email protected]>
1 parent 2a0ce7e commit 4d45967

507 files changed

Lines changed: 163613 additions & 0 deletions

File tree

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

‎lib/perl5/5.8.8/ExtUtils/Command.pm‎

Lines changed: 319 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,319 @@
1+
package ExtUtils::Command;
2+
3+
use 5.00503;
4+
use strict;
5+
use Carp;
6+
use File::Copy;
7+
use File::Compare;
8+
use File::Basename;
9+
use File::Path qw(rmtree);
10+
require Exporter;
11+
use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
12+
@ISA = qw(Exporter);
13+
@EXPORT = qw(cp rm_f rm_rf mv cat eqtime mkpath touch test_f chmod
14+
dos2unix);
15+
$VERSION = '1.09';
16+
17+
my $Is_VMS = $^O eq 'VMS';
18+
19+
=head1 NAME
20+
21+
ExtUtils::Command - utilities to replace common UNIX commands in Makefiles etc.
22+
23+
=head1 SYNOPSIS
24+
25+
perl -MExtUtils::Command -e cat files... > destination
26+
perl -MExtUtils::Command -e mv source... destination
27+
perl -MExtUtils::Command -e cp source... destination
28+
perl -MExtUtils::Command -e touch files...
29+
perl -MExtUtils::Command -e rm_f files...
30+
perl -MExtUtils::Command -e rm_rf directories...
31+
perl -MExtUtils::Command -e mkpath directories...
32+
perl -MExtUtils::Command -e eqtime source destination
33+
perl -MExtUtils::Command -e test_f file
34+
perl -MExtUtils::Command -e chmod mode files...
35+
...
36+
37+
=head1 DESCRIPTION
38+
39+
The module is used to replace common UNIX commands. In all cases the
40+
functions work from @ARGV rather than taking arguments. This makes
41+
them easier to deal with in Makefiles.
42+
43+
perl -MExtUtils::Command -e some_command some files to work on
44+
45+
I<NOT>
46+
47+
perl -MExtUtils::Command -e 'some_command qw(some files to work on)'
48+
49+
For that use L<Shell::Command>.
50+
51+
Filenames with * and ? will be glob expanded.
52+
53+
=over 4
54+
55+
=cut
56+
57+
# VMS uses % instead of ? to mean "one character"
58+
my $wild_regex = $Is_VMS ? '*%' : '*?';
59+
sub expand_wildcards
60+
{
61+
@ARGV = map(/[$wild_regex]/o ? glob($_) : $_,@ARGV);
62+
}
63+
64+
65+
=item cat
66+
67+
cat file ...
68+
69+
Concatenates all files mentioned on command line to STDOUT.
70+
71+
=cut
72+
73+
sub cat ()
74+
{
75+
expand_wildcards();
76+
print while (<>);
77+
}
78+
79+
=item eqtime
80+
81+
eqtime source destination
82+
83+
Sets modified time of destination to that of source.
84+
85+
=cut
86+
87+
sub eqtime
88+
{
89+
my ($src,$dst) = @ARGV;
90+
local @ARGV = ($dst); touch(); # in case $dst doesn't exist
91+
utime((stat($src))[8,9],$dst);
92+
}
93+
94+
=item rm_rf
95+
96+
rm_rf files or directories ...
97+
98+
Removes files and directories - recursively (even if readonly)
99+
100+
=cut
101+
102+
sub rm_rf
103+
{
104+
expand_wildcards();
105+
rmtree([grep -e $_,@ARGV],0,0);
106+
}
107+
108+
=item rm_f
109+
110+
rm_f file ...
111+
112+
Removes files (even if readonly)
113+
114+
=cut
115+
116+
sub rm_f {
117+
expand_wildcards();
118+
119+
foreach my $file (@ARGV) {
120+
next unless -f $file;
121+
122+
next if _unlink($file);
123+
124+
chmod(0777, $file);
125+
126+
next if _unlink($file);
127+
128+
carp "Cannot delete $file: $!";
129+
}
130+
}
131+
132+
sub _unlink {
133+
my $files_unlinked = 0;
134+
foreach my $file (@_) {
135+
my $delete_count = 0;
136+
$delete_count++ while unlink $file;
137+
$files_unlinked++ if $delete_count;
138+
}
139+
return $files_unlinked;
140+
}
141+
142+
143+
=item touch
144+
145+
touch file ...
146+
147+
Makes files exist, with current timestamp
148+
149+
=cut
150+
151+
sub touch {
152+
my $t = time;
153+
expand_wildcards();
154+
foreach my $file (@ARGV) {
155+
open(FILE,">>$file") || die "Cannot write $file:$!";
156+
close(FILE);
157+
utime($t,$t,$file);
158+
}
159+
}
160+
161+
=item mv
162+
163+
mv source_file destination_file
164+
mv source_file source_file destination_dir
165+
166+
Moves source to destination. Multiple sources are allowed if
167+
destination is an existing directory.
168+
169+
Returns true if all moves succeeded, false otherwise.
170+
171+
=cut
172+
173+
sub mv {
174+
expand_wildcards();
175+
my @src = @ARGV;
176+
my $dst = pop @src;
177+
178+
croak("Too many arguments") if (@src > 1 && ! -d $dst);
179+
180+
my $nok = 0;
181+
foreach my $src (@src) {
182+
$nok ||= !move($src,$dst);
183+
}
184+
return !$nok;
185+
}
186+
187+
=item cp
188+
189+
cp source_file destination_file
190+
cp source_file source_file destination_dir
191+
192+
Copies sources to the destination. Multiple sources are allowed if
193+
destination is an existing directory.
194+
195+
Returns true if all copies succeeded, false otherwise.
196+
197+
=cut
198+
199+
sub cp {
200+
expand_wildcards();
201+
my @src = @ARGV;
202+
my $dst = pop @src;
203+
204+
croak("Too many arguments") if (@src > 1 && ! -d $dst);
205+
206+
my $nok = 0;
207+
foreach my $src (@src) {
208+
$nok ||= !copy($src,$dst);
209+
}
210+
return $nok;
211+
}
212+
213+
=item chmod
214+
215+
chmod mode files ...
216+
217+
Sets UNIX like permissions 'mode' on all the files. e.g. 0666
218+
219+
=cut
220+
221+
sub chmod {
222+
local @ARGV = @ARGV;
223+
my $mode = shift(@ARGV);
224+
expand_wildcards();
225+
226+
if( $Is_VMS ) {
227+
foreach my $idx (0..$#ARGV) {
228+
my $path = $ARGV[$idx];
229+
next unless -d $path;
230+
231+
# chmod 0777, [.foo.bar] doesn't work on VMS, you have to do
232+
# chmod 0777, [.foo]bar.dir
233+
my @dirs = File::Spec->splitdir( $path );
234+
$dirs[-1] .= '.dir';
235+
$path = File::Spec->catfile(@dirs);
236+
237+
$ARGV[$idx] = $path;
238+
}
239+
}
240+
241+
chmod(oct $mode,@ARGV) || die "Cannot chmod ".join(' ',$mode,@ARGV).":$!";
242+
}
243+
244+
=item mkpath
245+
246+
mkpath directory ...
247+
248+
Creates directories, including any parent directories.
249+
250+
=cut
251+
252+
sub mkpath
253+
{
254+
expand_wildcards();
255+
File::Path::mkpath([@ARGV],0,0777);
256+
}
257+
258+
=item test_f
259+
260+
test_f file
261+
262+
Tests if a file exists
263+
264+
=cut
265+
266+
sub test_f
267+
{
268+
exit !-f $ARGV[0];
269+
}
270+
271+
=item dos2unix
272+
273+
dos2unix files or dirs ...
274+
275+
Converts DOS and OS/2 linefeeds to Unix style recursively.
276+
277+
=cut
278+
279+
sub dos2unix {
280+
require File::Find;
281+
File::Find::find(sub {
282+
return if -d;
283+
return unless -w _;
284+
return unless -r _;
285+
return if -B _;
286+
287+
local $\;
288+
289+
my $orig = $_;
290+
my $temp = '.dos2unix_tmp';
291+
open ORIG, $_ or do { warn "dos2unix can't open $_: $!"; return };
292+
open TEMP, ">$temp" or
293+
do { warn "dos2unix can't create .dos2unix_tmp: $!"; return };
294+
while (my $line = <ORIG>) {
295+
$line =~ s/\015\012/\012/g;
296+
print TEMP $line;
297+
}
298+
close ORIG;
299+
close TEMP;
300+
rename $temp, $orig;
301+
302+
}, @ARGV);
303+
}
304+
305+
=back
306+
307+
=head1 SEE ALSO
308+
309+
Shell::Command which is these same functions but take arguments normally.
310+
311+
312+
=head1 AUTHOR
313+
314+
Nick Ing-Simmons C<[email protected]>
315+
316+
Currently maintained by Michael G Schwern C<[email protected]>.
317+
318+
=cut
319+

0 commit comments

Comments
 (0)