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