Re: lib, ext, cpan and dist [PATCH] (take 2)
[perl.git] / ext / 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);
13 our $VERSION = '6.55_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 If Pod::Man is unavailable, this function will warn and return undef.
91
92 =cut
93
94 sub pod2man {
95     local @ARGV = @_ ? @_ : @ARGV;
96
97     {
98         local $@;
99         if( !eval { require Pod::Man } ) {
100             warn "Pod::Man is not available: $@".
101                  "Man pages will not be generated during this install.\n";
102             return undef;
103         }
104     }
105     require Getopt::Long;
106
107     # We will cheat and just use Getopt::Long.  We fool it by putting
108     # our arguments into @ARGV.  Should be safe.
109     my %options = ();
110     Getopt::Long::config ('bundling_override');
111     Getopt::Long::GetOptions (\%options, 
112                 'section|s=s', 'release|r=s', 'center|c=s',
113                 'date|d=s', 'fixed=s', 'fixedbold=s', 'fixeditalic=s',
114                 'fixedbolditalic=s', 'official|o', 'quotes|q=s', 'lax|l',
115                 'name|n=s', 'perm_rw=i'
116     );
117
118     # If there's no files, don't bother going further.
119     return 0 unless @ARGV;
120
121     # Official sets --center, but don't override things explicitly set.
122     if ($options{official} && !defined $options{center}) {
123         $options{center} = q[Perl Programmer's Reference Guide];
124     }
125
126     # This isn't a valid Pod::Man option and is only accepted for backwards
127     # compatibility.
128     delete $options{lax};
129
130     do {{  # so 'next' works
131         my ($pod, $man) = splice(@ARGV, 0, 2);
132
133         next if ((-e $man) &&
134                  (-M $man < -M $pod) &&
135                  (-M $man < -M "Makefile"));
136
137         print "Manifying $man\n";
138
139         my $parser = Pod::Man->new(%options);
140         $parser->parse_from_file($pod, $man)
141           or do { warn("Could not install $man\n");  next };
142
143         if (exists $options{perm_rw}) {
144             chmod(oct($options{perm_rw}), $man)
145               or do { warn("chmod $options{perm_rw} $man: $!\n"); next };
146         }
147     }} while @ARGV;
148
149     return 1;
150 }
151
152
153 =item B<warn_if_old_packlist>
154
155   perl "-MExtUtils::Command::MM" -e warn_if_old_packlist <somefile>
156
157 Displays a warning that an old packlist file was found.  Reads the
158 filename from @ARGV.
159
160 =cut
161
162 sub warn_if_old_packlist {
163     my $packlist = $ARGV[0];
164
165     return unless -f $packlist;
166     print <<"PACKLIST_WARNING";
167 WARNING: I have found an old package in
168     $packlist.
169 Please make sure the two installations are not conflicting
170 PACKLIST_WARNING
171
172 }
173
174
175 =item B<perllocal_install>
176
177     perl "-MExtUtils::Command::MM" -e perllocal_install 
178         <type> <module name> <key> <value> ...
179
180     # VMS only, key|value pairs come on STDIN
181     perl "-MExtUtils::Command::MM" -e perllocal_install
182         <type> <module name> < <key>|<value> ...
183
184 Prints a fragment of POD suitable for appending to perllocal.pod.
185 Arguments are read from @ARGV.
186
187 'type' is the type of what you're installing.  Usually 'Module'.
188
189 'module name' is simply the name of your module.  (Foo::Bar)
190
191 Key/value pairs are extra information about the module.  Fields include:
192
193     installed into      which directory your module was out into
194     LINKTYPE            dynamic or static linking
195     VERSION             module version number
196     EXE_FILES           any executables installed in a space seperated 
197                         list
198
199 =cut
200
201 sub perllocal_install {
202     my($type, $name) = splice(@ARGV, 0, 2);
203
204     # VMS feeds args as a piped file on STDIN since it usually can't
205     # fit all the args on a single command line.
206     my @mod_info = $Is_VMS ? split /\|/, <STDIN>
207                            : @ARGV;
208
209     my $pod;
210     $pod = sprintf <<POD, scalar localtime;
211  =head2 %s: C<$type> L<$name|$name>
212  
213  =over 4
214  
215 POD
216
217     do {
218         my($key, $val) = splice(@mod_info, 0, 2);
219
220         $pod .= <<POD
221  =item *
222  
223  C<$key: $val>
224  
225 POD
226
227     } while(@mod_info);
228
229     $pod .= "=back\n\n";
230     $pod =~ s/^ //mg;
231     print $pod;
232
233     return 1;
234 }
235
236 =item B<uninstall>
237
238     perl "-MExtUtils::Command::MM" -e uninstall <packlist>
239
240 A wrapper around ExtUtils::Install::uninstall().  Warns that
241 uninstallation is deprecated and doesn't actually perform the
242 uninstallation.
243
244 =cut
245
246 sub uninstall {
247     my($packlist) = shift @ARGV;
248
249     require ExtUtils::Install;
250
251     print <<'WARNING';
252
253 Uninstall is unsafe and deprecated, the uninstallation was not performed.
254 We will show what would have been done.
255
256 WARNING
257
258     ExtUtils::Install::uninstall($packlist, 1, 1);
259
260     print <<'WARNING';
261
262 Uninstall is unsafe and deprecated, the uninstallation was not performed.
263 Please check the list above carefully, there may be errors.
264 Remove the appropriate files manually.
265 Sorry for the inconvenience.
266
267 WARNING
268
269 }
270
271 =back
272
273 =cut
274
275 1;