Update ExtUtils-MakeMaker to CPAN version 7.28
[perl.git] / cpan / ExtUtils-MakeMaker / lib / ExtUtils / Command / MM.pm
1 package ExtUtils::Command::MM;
2
3 require 5.006;
4
5 use strict;
6 use warnings;
7
8 require Exporter;
9 our @ISA = qw(Exporter);
10
11 our @EXPORT  = qw(test_harness pod2man perllocal_install uninstall
12                   warn_if_old_packlist test_s cp_nonempty);
13 our $VERSION = '7.28';
14 $VERSION = eval $VERSION;
15
16 my $Is_VMS = $^O eq 'VMS';
17
18 sub mtime {
19   no warnings 'redefine';
20   local $@;
21   *mtime = (eval { require Time::HiRes } && defined &Time::HiRes::stat)
22     ? sub { (Time::HiRes::stat($_[0]))[9] }
23     : sub { (             stat($_[0]))[9] }
24   ;
25   goto &mtime;
26 }
27
28 =head1 NAME
29
30 ExtUtils::Command::MM - Commands for the MM's to use in Makefiles
31
32 =head1 SYNOPSIS
33
34   perl "-MExtUtils::Command::MM" -e "function" "--" arguments...
35
36
37 =head1 DESCRIPTION
38
39 B<FOR INTERNAL USE ONLY!>  The interface is not stable.
40
41 ExtUtils::Command::MM encapsulates code which would otherwise have to
42 be done with large "one" liners.
43
44 Any $(FOO) used in the examples are make variables, not Perl.
45
46 =over 4
47
48 =item B<test_harness>
49
50   test_harness($verbose, @test_libs);
51
52 Runs the tests on @ARGV via Test::Harness passing through the $verbose
53 flag.  Any @test_libs will be unshifted onto the test's @INC.
54
55 @test_libs are run in alphabetical order.
56
57 =cut
58
59 sub test_harness {
60     require Test::Harness;
61     require File::Spec;
62
63     $Test::Harness::verbose = shift;
64
65     # Because Windows doesn't do this for us and listing all the *.t files
66     # out on the command line can blow over its exec limit.
67     require ExtUtils::Command;
68     my @argv = ExtUtils::Command::expand_wildcards(@ARGV);
69
70     local @INC = @INC;
71     unshift @INC, map { File::Spec->rel2abs($_) } @_;
72     Test::Harness::runtests(sort { lc $a cmp lc $b } @argv);
73 }
74
75
76
77 =item B<pod2man>
78
79   pod2man( '--option=value',
80            $podfile1 => $manpage1,
81            $podfile2 => $manpage2,
82            ...
83          );
84
85   # or args on @ARGV
86
87 pod2man() is a function performing most of the duties of the pod2man
88 program.  Its arguments are exactly the same as pod2man as of 5.8.0
89 with the addition of:
90
91     --perm_rw   octal permission to set the resulting manpage to
92
93 And the removal of:
94
95     --verbose/-v
96     --help/-h
97
98 If no arguments are given to pod2man it will read from @ARGV.
99
100 If Pod::Man is unavailable, this function will warn and return undef.
101
102 =cut
103
104 sub pod2man {
105     local @ARGV = @_ ? @_ : @ARGV;
106
107     {
108         local $@;
109         if( !eval { require Pod::Man } ) {
110             warn "Pod::Man is not available: $@".
111                  "Man pages will not be generated during this install.\n";
112             return 0;
113         }
114     }
115     require Getopt::Long;
116
117     # We will cheat and just use Getopt::Long.  We fool it by putting
118     # our arguments into @ARGV.  Should be safe.
119     my %options = ();
120     Getopt::Long::config ('bundling_override');
121     Getopt::Long::GetOptions (\%options,
122                 'section|s=s', 'release|r=s', 'center|c=s',
123                 'date|d=s', 'fixed=s', 'fixedbold=s', 'fixeditalic=s',
124                 'fixedbolditalic=s', 'official|o', 'quotes|q=s', 'lax|l',
125                 'name|n=s', 'perm_rw=i', 'utf8|u'
126     );
127     delete $options{utf8} unless $Pod::Man::VERSION >= 2.17;
128
129     # If there's no files, don't bother going further.
130     return 0 unless @ARGV;
131
132     # Official sets --center, but don't override things explicitly set.
133     if ($options{official} && !defined $options{center}) {
134         $options{center} = q[Perl Programmer's Reference Guide];
135     }
136
137     # This isn't a valid Pod::Man option and is only accepted for backwards
138     # compatibility.
139     delete $options{lax};
140     my $count = scalar @ARGV / 2;
141     my $plural = $count == 1 ? 'document' : 'documents';
142     print "Manifying $count pod $plural\n";
143
144     do {{  # so 'next' works
145         my ($pod, $man) = splice(@ARGV, 0, 2);
146
147         next if ((-e $man) &&
148                  (mtime($man) > mtime($pod)) &&
149                  (mtime($man) > mtime("Makefile")));
150
151         my $parser = Pod::Man->new(%options);
152         $parser->parse_from_file($pod, $man)
153           or do { warn("Could not install $man\n");  next };
154
155         if (exists $options{perm_rw}) {
156             chmod(oct($options{perm_rw}), $man)
157               or do { warn("chmod $options{perm_rw} $man: $!\n"); next };
158         }
159     }} while @ARGV;
160
161     return 1;
162 }
163
164
165 =item B<warn_if_old_packlist>
166
167   perl "-MExtUtils::Command::MM" -e warn_if_old_packlist <somefile>
168
169 Displays a warning that an old packlist file was found.  Reads the
170 filename from @ARGV.
171
172 =cut
173
174 sub warn_if_old_packlist {
175     my $packlist = $ARGV[0];
176
177     return unless -f $packlist;
178     print <<"PACKLIST_WARNING";
179 WARNING: I have found an old package in
180     $packlist.
181 Please make sure the two installations are not conflicting
182 PACKLIST_WARNING
183
184 }
185
186
187 =item B<perllocal_install>
188
189     perl "-MExtUtils::Command::MM" -e perllocal_install
190         <type> <module name> <key> <value> ...
191
192     # VMS only, key|value pairs come on STDIN
193     perl "-MExtUtils::Command::MM" -e perllocal_install
194         <type> <module name> < <key>|<value> ...
195
196 Prints a fragment of POD suitable for appending to perllocal.pod.
197 Arguments are read from @ARGV.
198
199 'type' is the type of what you're installing.  Usually 'Module'.
200
201 'module name' is simply the name of your module.  (Foo::Bar)
202
203 Key/value pairs are extra information about the module.  Fields include:
204
205     installed into      which directory your module was out into
206     LINKTYPE            dynamic or static linking
207     VERSION             module version number
208     EXE_FILES           any executables installed in a space seperated
209                         list
210
211 =cut
212
213 sub perllocal_install {
214     my($type, $name) = splice(@ARGV, 0, 2);
215
216     # VMS feeds args as a piped file on STDIN since it usually can't
217     # fit all the args on a single command line.
218     my @mod_info = $Is_VMS ? split /\|/, <STDIN>
219                            : @ARGV;
220
221     my $pod;
222     my $time = gmtime($ENV{SOURCE_DATE_EPOCH} || time);
223     $pod = sprintf <<'POD', scalar($time), $type, $name, $name;
224  =head2 %s: C<%s> L<%s|%s>
225
226  =over 4
227
228 POD
229
230     do {
231         my($key, $val) = splice(@mod_info, 0, 2);
232
233         $pod .= <<POD
234  =item *
235
236  C<$key: $val>
237
238 POD
239
240     } while(@mod_info);
241
242     $pod .= "=back\n\n";
243     $pod =~ s/^ //mg;
244     print $pod;
245
246     return 1;
247 }
248
249 =item B<uninstall>
250
251     perl "-MExtUtils::Command::MM" -e uninstall <packlist>
252
253 A wrapper around ExtUtils::Install::uninstall().  Warns that
254 uninstallation is deprecated and doesn't actually perform the
255 uninstallation.
256
257 =cut
258
259 sub uninstall {
260     my($packlist) = shift @ARGV;
261
262     require ExtUtils::Install;
263
264     print <<'WARNING';
265
266 Uninstall is unsafe and deprecated, the uninstallation was not performed.
267 We will show what would have been done.
268
269 WARNING
270
271     ExtUtils::Install::uninstall($packlist, 1, 1);
272
273     print <<'WARNING';
274
275 Uninstall is unsafe and deprecated, the uninstallation was not performed.
276 Please check the list above carefully, there may be errors.
277 Remove the appropriate files manually.
278 Sorry for the inconvenience.
279
280 WARNING
281
282 }
283
284 =item B<test_s>
285
286    perl "-MExtUtils::Command::MM" -e test_s <file>
287
288 Tests if a file exists and is not empty (size > 0).
289 I<Exits> with 0 if it does, 1 if it does not.
290
291 =cut
292
293 sub test_s {
294   exit(-s $ARGV[0] ? 0 : 1);
295 }
296
297 =item B<cp_nonempty>
298
299   perl "-MExtUtils::Command::MM" -e cp_nonempty <srcfile> <dstfile> <perm>
300
301 Tests if the source file exists and is not empty (size > 0). If it is not empty
302 it copies it to the given destination with the given permissions.
303
304 =back
305
306 =cut
307
308 sub cp_nonempty {
309   my @args = @ARGV;
310   return 0 unless -s $args[0];
311   require ExtUtils::Command;
312   {
313     local @ARGV = @args[0,1];
314     ExtUtils::Command::cp(@ARGV);
315   }
316   {
317     local @ARGV = @args[2,1];
318     ExtUtils::Command::chmod(@ARGV);
319   }
320 }
321
322
323 1;