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