This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade to MakeMaker 6.20.
[perl5.git] / lib / ExtUtils / Command.pm
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.07';
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 Filenames with * and ? will be glob expanded.
50
51 =over 4
52
53 =cut
54
55 # VMS uses % instead of ? to mean "one character"
56 my $wild_regex = $Is_VMS ? '*%' : '*?';
57 sub expand_wildcards
58 {
59  @ARGV = map(/[$wild_regex]/o ? glob($_) : $_,@ARGV);
60 }
61
62
63 =item cat 
64
65 Concatenates all files mentioned on command line to STDOUT.
66
67 =cut 
68
69 sub cat ()
70 {
71  expand_wildcards();
72  print while (<>);
73 }
74
75 =item eqtime src dst
76
77 Sets modified time of dst to that of src
78
79 =cut 
80
81 sub eqtime
82 {
83  my ($src,$dst) = @ARGV;
84  local @ARGV = ($dst);  touch();  # in case $dst doesn't exist
85  utime((stat($src))[8,9],$dst);
86 }
87
88 =item rm_rf files....
89
90 Removes directories - recursively (even if readonly)
91
92 =cut 
93
94 sub rm_rf
95 {
96  expand_wildcards();
97  rmtree([grep -e $_,@ARGV],0,0);
98 }
99
100 =item rm_f files....
101
102 Removes files (even if readonly)
103
104 =cut 
105
106 sub rm_f
107 {
108  expand_wildcards();
109  foreach (@ARGV)
110   {
111    next unless -f $_;
112    next if unlink($_);
113    chmod(0777,$_);
114    next if unlink($_);
115    carp "Cannot delete $_:$!";
116   }
117 }
118
119 =item touch files ...
120
121 Makes files exist, with current timestamp 
122
123 =cut 
124
125 sub touch {
126     my $t    = time;
127     expand_wildcards();
128     foreach my $file (@ARGV) {
129         open(FILE,">>$file") || die "Cannot write $file:$!";
130         close(FILE);
131         utime($t,$t,$file);
132     }
133 }
134
135 =item mv source... destination
136
137 Moves source to destination.  Multiple sources are allowed if
138 destination is an existing directory.
139
140 Returns true if all moves succeeded, false otherwise.
141
142 =cut 
143
144 sub mv {
145     expand_wildcards();
146     my @src = @ARGV;
147     my $dst = pop @src;
148
149     croak("Too many arguments") if (@src > 1 && ! -d $dst);
150
151     my $nok = 0;
152     foreach my $src (@src) {
153         $nok ||= !move($src,$dst);
154     }
155     return !$nok;
156 }
157
158 =item cp source... destination
159
160 Copies source to destination.  Multiple sources are allowed if
161 destination is an existing directory.
162
163 Returns true if all copies succeeded, false otherwise.
164
165 =cut
166
167 sub cp {
168     expand_wildcards();
169     my @src = @ARGV;
170     my $dst = pop @src;
171
172     croak("Too many arguments") if (@src > 1 && ! -d $dst);
173
174     my $nok = 0;
175     foreach my $src (@src) {
176         $nok ||= !copy($src,$dst);
177     }
178     return $nok;
179 }
180
181 =item chmod mode files...
182
183 Sets UNIX like permissions 'mode' on all the files.  e.g. 0666
184
185 =cut 
186
187 sub chmod {
188     local @ARGV = @ARGV;
189     my $mode = shift(@ARGV);
190     expand_wildcards();
191     chmod(oct $mode,@ARGV) || die "Cannot chmod ".join(' ',$mode,@ARGV).":$!";
192 }
193
194 =item mkpath directory...
195
196 Creates directory, including any parent directories.
197
198 =cut 
199
200 sub mkpath
201 {
202  expand_wildcards();
203  File::Path::mkpath([@ARGV],0,0777);
204 }
205
206 =item test_f file
207
208 Tests if a file exists
209
210 =cut 
211
212 sub test_f
213 {
214  exit !-f $ARGV[0];
215 }
216
217 =item dos2unix
218
219 Converts DOS and OS/2 linefeeds to Unix style recursively.
220
221 =cut
222
223 sub dos2unix {
224     require File::Find;
225     File::Find::find(sub {
226         return if -d;
227         return unless -w _;
228         return unless -r _;
229         return if -B _;
230
231         local $\;
232
233         my $orig = $_;
234         my $temp = '.dos2unix_tmp';
235         open ORIG, $_ or do { warn "dos2unix can't open $_: $!"; return };
236         open TEMP, ">$temp" or 
237             do { warn "dos2unix can't create .dos2unix_tmp: $!"; return };
238         while (my $line = <ORIG>) { 
239             $line =~ s/\015\012/\012/g;
240             print TEMP $line;
241         }
242         close ORIG;
243         close TEMP;
244         rename $temp, $orig;
245
246     }, @ARGV);
247 }
248
249 =back
250
251 =head1 BUGS
252
253 Should probably be Auto/Self loaded.
254
255 =head1 SEE ALSO 
256
257 ExtUtils::MakeMaker, ExtUtils::MM_Unix, ExtUtils::MM_Win32
258
259 =head1 AUTHOR
260
261 Nick Ing-Simmons C<ni-s@cpan.org>
262
263 Currently maintained by Michael G Schwern C<schwern@pobox.com>.
264
265 =cut
266