This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade to ExtUtils-MakeMaker-6.48
[perl5.git] / lib / ExtUtils / Command / MM.pm
CommitLineData
f6d6199c
MS
1package ExtUtils::Command::MM;
2
a592ba15
RGS
3require 5.006;
4
f6d6199c 5use strict;
a592ba15 6use warnings;
f6d6199c 7
f6d6199c 8require Exporter;
a592ba15 9our @ISA = qw(Exporter);
f6d6199c 10
a592ba15
RGS
11our @EXPORT = qw(test_harness pod2man perllocal_install uninstall
12 warn_if_old_packlist);
b5b9b385 13our $VERSION = '6.48';
479d2113
MS
14
15my $Is_VMS = $^O eq 'VMS';
f6d6199c 16
7292dc67 17
f6d6199c
MS
18=head1 NAME
19
20ExtUtils::Command::MM - Commands for the MM's to use in Makefiles
21
22=head1 SYNOPSIS
23
479d2113 24 perl "-MExtUtils::Command::MM" -e "function" "--" arguments...
f6d6199c
MS
25
26
27=head1 DESCRIPTION
28
29B<FOR INTERNAL USE ONLY!> The interface is not stable.
30
31ExtUtils::Command::MM encapsulates code which would otherwise have to
32be done with large "one" liners.
33
f6d6199c
MS
34Any $(FOO) used in the examples are make variables, not Perl.
35
36=over 4
37
38=item B<test_harness>
39
e0678a30 40 test_harness($verbose, @test_libs);
f6d6199c 41
e0678a30
MS
42Runs the tests on @ARGV via Test::Harness passing through the $verbose
43flag. Any @test_libs will be unshifted onto the test's @INC.
f6d6199c 44
45bc4d3a
JH
45@test_libs are run in alphabetical order.
46
f6d6199c
MS
47=cut
48
49sub test_harness {
50 require Test::Harness;
e0678a30
MS
51 require File::Spec;
52
f6d6199c 53 $Test::Harness::verbose = shift;
e0678a30 54
7292dc67
RGS
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
e0678a30
MS
60 local @INC = @INC;
61 unshift @INC, map { File::Spec->rel2abs($_) } @_;
7292dc67 62 Test::Harness::runtests(sort { lc $a cmp lc $b } @argv);
f6d6199c
MS
63}
64
479d2113
MS
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
77pod2man() is a function performing most of the duties of the pod2man
78program. Its arguments are exactly the same as pod2man as of 5.8.0
79with the addition of:
80
81 --perm_rw octal permission to set the resulting manpage to
82
83And the removal of:
84
85 --verbose/-v
86 --help/-h
87
88If no arguments are given to pod2man it will read from @ARGV.
89
90=cut
91
92sub pod2man {
a592ba15
RGS
93 local @ARGV = @_ ? @_ : @ARGV;
94
479d2113
MS
95 require Pod::Man;
96 require Getopt::Long;
97
479d2113
MS
98 # We will cheat and just use Getopt::Long. We fool it by putting
99 # our arguments into @ARGV. Should be safe.
a592ba15 100 my %options = ();
479d2113
MS
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}) {
5dca256e 114 $options{center} = q[Perl Programmer's Reference Guide];
479d2113
MS
115 }
116
117 # This isn't a valid Pod::Man option and is only accepted for backwards
118 # compatibility.
119 delete $options{lax};
120
479d2113
MS
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
66112e6b 130 my $parser = Pod::Man->new(%options);
479d2113
MS
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
148Displays a warning that an old packlist file was found. Reads the
149filename from @ARGV.
150
151=cut
152
153sub warn_if_old_packlist {
154 my $packlist = $ARGV[0];
155
156 return unless -f $packlist;
157 print <<"PACKLIST_WARNING";
158WARNING: I have found an old package in
159 $packlist.
160Please make sure the two installations are not conflicting
161PACKLIST_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
7292dc67 171 # VMS only, key|value pairs come on STDIN
479d2113 172 perl "-MExtUtils::Command::MM" -e perllocal_install
7292dc67 173 <type> <module name> < <key>|<value> ...
479d2113
MS
174
175Prints a fragment of POD suitable for appending to perllocal.pod.
176Arguments 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
182Key/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
192sub 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.
a592ba15
RGS
197 my @mod_info = $Is_VMS ? split /\|/, <STDIN>
198 : @ARGV;
479d2113
MS
199
200 my $pod;
201 $pod = sprintf <<POD, scalar localtime;
202 =head2 %s: C<$type> L<$name|$name>
203
204 =over 4
205
206POD
207
208 do {
a592ba15 209 my($key, $val) = splice(@mod_info, 0, 2);
479d2113
MS
210
211 $pod .= <<POD
212 =item *
213
214 C<$key: $val>
215
216POD
217
a592ba15 218 } while(@mod_info);
479d2113
MS
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
231A wrapper around ExtUtils::Install::uninstall(). Warns that
232uninstallation is deprecated and doesn't actually perform the
233uninstallation.
234
235=cut
236
237sub uninstall {
a7d1454b 238 my($packlist) = shift @ARGV;
479d2113
MS
239
240 require ExtUtils::Install;
241
242 print <<'WARNING';
243
244Uninstall is unsafe and deprecated, the uninstallation was not performed.
245We will show what would have been done.
246
247WARNING
248
249 ExtUtils::Install::uninstall($packlist, 1, 1);
250
251 print <<'WARNING';
252
253Uninstall is unsafe and deprecated, the uninstallation was not performed.
254Please check the list above carefully, there may be errors.
255Remove the appropriate files manually.
256Sorry for the inconvenience.
257
258WARNING
259
260}
261
f6d6199c
MS
262=back
263
264=cut
265
2661;