This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade to ExtUtils::MakeMaker 6.27,
[perl5.git] / lib / ExtUtils / Command / MM.pm
1 package ExtUtils::Command::MM;
2
3 use strict;
4
5 require 5.005_03;
6 require Exporter;
7 use vars qw($VERSION @ISA @EXPORT);
8 @ISA = qw(Exporter);
9
10 @EXPORT  = qw(test_harness pod2man perllocal_install uninstall 
11               warn_if_old_packlist);
12 $VERSION = '0.05';
13
14 my $Is_VMS = $^O eq 'VMS';
15
16
17 =head1 NAME
18
19 ExtUtils::Command::MM - Commands for the MM's to use in Makefiles
20
21 =head1 SYNOPSIS
22
23   perl "-MExtUtils::Command::MM" -e "function" "--" arguments...
24
25
26 =head1 DESCRIPTION
27
28 B<FOR INTERNAL USE ONLY!>  The interface is not stable.
29
30 ExtUtils::Command::MM encapsulates code which would otherwise have to
31 be done with large "one" liners.
32
33 Any $(FOO) used in the examples are make variables, not Perl.
34
35 =over 4
36
37 =item B<test_harness>
38
39   test_harness($verbose, @test_libs);
40
41 Runs the tests on @ARGV via Test::Harness passing through the $verbose
42 flag.  Any @test_libs will be unshifted onto the test's @INC.
43
44 @test_libs are run in alphabetical order.
45
46 =cut
47
48 sub test_harness {
49     require Test::Harness;
50     require File::Spec;
51
52     $Test::Harness::verbose = shift;
53
54     # Because Windows doesn't do this for us and listing all the *.t files
55     # out on the command line can blow over its exec limit.
56     require ExtUtils::Command;
57     my @argv = ExtUtils::Command::expand_wildcards(@ARGV);
58
59     local @INC = @INC;
60     unshift @INC, map { File::Spec->rel2abs($_) } @_;
61     Test::Harness::runtests(sort { lc $a cmp lc $b } @argv);
62 }
63
64
65
66 =item B<pod2man>
67
68   pod2man( '--option=value',
69            $podfile1 => $manpage1,
70            $podfile2 => $manpage2,
71            ...
72          );
73
74   # or args on @ARGV
75
76 pod2man() is a function performing most of the duties of the pod2man
77 program.  Its arguments are exactly the same as pod2man as of 5.8.0
78 with the addition of:
79
80     --perm_rw   octal permission to set the resulting manpage to
81
82 And the removal of:
83
84     --verbose/-v
85     --help/-h
86
87 If no arguments are given to pod2man it will read from @ARGV.
88
89 =cut
90
91 sub pod2man {
92     require Pod::Man;
93     require Getopt::Long;
94
95     my %options = ();
96
97     # We will cheat and just use Getopt::Long.  We fool it by putting
98     # our arguments into @ARGV.  Should be safe.
99     local @ARGV = @_ ? @_ : @ARGV;
100     Getopt::Long::config ('bundling_override');
101     Getopt::Long::GetOptions (\%options, 
102                 'section|s=s', 'release|r=s', 'center|c=s',
103                 'date|d=s', 'fixed=s', 'fixedbold=s', 'fixeditalic=s',
104                 'fixedbolditalic=s', 'official|o', 'quotes|q=s', 'lax|l',
105                 'name|n=s', 'perm_rw:i'
106     );
107
108     # If there's no files, don't bother going further.
109     return 0 unless @ARGV;
110
111     # Official sets --center, but don't override things explicitly set.
112     if ($options{official} && !defined $options{center}) {
113         $options{center} = q[Perl Programmer's Reference Guide];
114     }
115
116     # This isn't a valid Pod::Man option and is only accepted for backwards
117     # compatibility.
118     delete $options{lax};
119
120     my $parser = Pod::Man->new(%options);
121
122     do {{  # so 'next' works
123         my ($pod, $man) = splice(@ARGV, 0, 2);
124
125         next if ((-e $man) &&
126                  (-M $man < -M $pod) &&
127                  (-M $man < -M "Makefile"));
128
129         print "Manifying $man\n";
130
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     @ARGV = split /\|/, <STDIN> if $Is_VMS;
198
199     my $pod;
200     $pod = sprintf <<POD, scalar localtime;
201  =head2 %s: C<$type> L<$name|$name>
202  
203  =over 4
204  
205 POD
206
207     do {
208         my($key, $val) = splice(@ARGV, 0, 2);
209
210         $pod .= <<POD
211  =item *
212  
213  C<$key: $val>
214  
215 POD
216
217     } while(@ARGV);
218
219     $pod .= "=back\n\n";
220     $pod =~ s/^ //mg;
221     print $pod;
222
223     return 1;
224 }
225
226 =item B<uninstall>
227
228     perl "-MExtUtils::Command::MM" -e uninstall <packlist>
229
230 A wrapper around ExtUtils::Install::uninstall().  Warns that
231 uninstallation is deprecated and doesn't actually perform the
232 uninstallation.
233
234 =cut
235
236 sub uninstall {
237     my($packlist) = shift @ARGV;
238
239     require ExtUtils::Install;
240
241     print <<'WARNING';
242
243 Uninstall is unsafe and deprecated, the uninstallation was not performed.
244 We will show what would have been done.
245
246 WARNING
247
248     ExtUtils::Install::uninstall($packlist, 1, 1);
249
250     print <<'WARNING';
251
252 Uninstall is unsafe and deprecated, the uninstallation was not performed.
253 Please check the list above carefully, there may be errors.
254 Remove the appropriate files manually.
255 Sorry for the inconvenience.
256
257 WARNING
258
259 }
260
261 =back
262
263 =cut
264
265 1;