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