xref: /onnv-gate/usr/src/cmd/perl/5.8.4/distrib/lib/Pod/Perldoc/ToMan.pm (revision 0:68f95e015346)
1*0Sstevel@tonic-gate
2*0Sstevel@tonic-gaterequire 5;
3*0Sstevel@tonic-gatepackage Pod::Perldoc::ToMan;
4*0Sstevel@tonic-gateuse strict;
5*0Sstevel@tonic-gateuse warnings;
6*0Sstevel@tonic-gate
7*0Sstevel@tonic-gate# This class is unlike ToText.pm et al, because we're NOT paging thru
8*0Sstevel@tonic-gate# the output in our particular format -- we make the output and
9*0Sstevel@tonic-gate# then we run nroff (or whatever) on it, and then page thru the
10*0Sstevel@tonic-gate# (plaintext) output of THAT!
11*0Sstevel@tonic-gate
12*0Sstevel@tonic-gateuse base qw(Pod::Perldoc::BaseTo);
13*0Sstevel@tonic-gatesub is_pageable        { 1 }
14*0Sstevel@tonic-gatesub write_with_binmode { 0 }
15*0Sstevel@tonic-gatesub output_extension   { 'txt' }
16*0Sstevel@tonic-gate
17*0Sstevel@tonic-gatesub __filter_nroff  { shift->_perldoc_elem('__filter_nroff'  , @_) }
18*0Sstevel@tonic-gatesub __nroffer       { shift->_perldoc_elem('__nroffer'       , @_) }
19*0Sstevel@tonic-gatesub __bindir        { shift->_perldoc_elem('__bindir'        , @_) }
20*0Sstevel@tonic-gatesub __pod2man       { shift->_perldoc_elem('__pod2man'       , @_) }
21*0Sstevel@tonic-gatesub __output_file   { shift->_perldoc_elem('__output_file'   , @_) }
22*0Sstevel@tonic-gate
23*0Sstevel@tonic-gatesub center          { shift->_perldoc_elem('center'         , @_) }
24*0Sstevel@tonic-gatesub date            { shift->_perldoc_elem('date'           , @_) }
25*0Sstevel@tonic-gatesub fixed           { shift->_perldoc_elem('fixed'          , @_) }
26*0Sstevel@tonic-gatesub fixedbold       { shift->_perldoc_elem('fixedbold'      , @_) }
27*0Sstevel@tonic-gatesub fixeditalic     { shift->_perldoc_elem('fixeditalic'    , @_) }
28*0Sstevel@tonic-gatesub fixedbolditalic { shift->_perldoc_elem('fixedbolditalic', @_) }
29*0Sstevel@tonic-gatesub quotes          { shift->_perldoc_elem('quotes'         , @_) }
30*0Sstevel@tonic-gatesub release         { shift->_perldoc_elem('release'        , @_) }
31*0Sstevel@tonic-gatesub section         { shift->_perldoc_elem('section'        , @_) }
32*0Sstevel@tonic-gate
33*0Sstevel@tonic-gatesub new { return bless {}, ref($_[0]) || $_[0] }
34*0Sstevel@tonic-gate
35*0Sstevel@tonic-gateuse File::Spec::Functions qw(catfile);
36*0Sstevel@tonic-gate
37*0Sstevel@tonic-gatesub parse_from_file {
38*0Sstevel@tonic-gate  my $self = shift;
39*0Sstevel@tonic-gate  my($file, $outfh) = @_;
40*0Sstevel@tonic-gate
41*0Sstevel@tonic-gate  my $render = $self->{'__nroffer'} || die "no nroffer set!?";
42*0Sstevel@tonic-gate
43*0Sstevel@tonic-gate  # turn the switches into CLIs
44*0Sstevel@tonic-gate  my $switches = join ' ',
45*0Sstevel@tonic-gate    map qq{"--$_=$self->{$_}"},
46*0Sstevel@tonic-gate      grep !m/^_/s,
47*0Sstevel@tonic-gate        keys %$self
48*0Sstevel@tonic-gate  ;
49*0Sstevel@tonic-gate
50*0Sstevel@tonic-gate  my $command =
51*0Sstevel@tonic-gate    catfile(
52*0Sstevel@tonic-gate      ($self->{'__bindir'}  || die "no bindir set?!"  ),
53*0Sstevel@tonic-gate      ($self->{'__pod2man'} || die "no pod2man set?!" ),
54*0Sstevel@tonic-gate    )
55*0Sstevel@tonic-gate    . " $switches --lax $file | $render -man"
56*0Sstevel@tonic-gate  ;               # no temp file, just a pipe!
57*0Sstevel@tonic-gate
58*0Sstevel@tonic-gate  # Thanks to Brendan O'Dea for contributing the following block
59*0Sstevel@tonic-gate  if(Pod::Perldoc::IS_Linux and -t STDOUT
60*0Sstevel@tonic-gate    and my ($cols) = `stty -a` =~ m/\bcolumns\s+(\d+)/
61*0Sstevel@tonic-gate  ) {
62*0Sstevel@tonic-gate    my $c = $cols * 39 / 40;
63*0Sstevel@tonic-gate    $cols = $c > $cols - 2 ? $c : $cols -2;
64*0Sstevel@tonic-gate    $command .= ' -rLL=' . (int $c) . 'n' if $cols > 80;
65*0Sstevel@tonic-gate  }
66*0Sstevel@tonic-gate
67*0Sstevel@tonic-gate  # I hear persistent reports that adding a -c switch to $render
68*0Sstevel@tonic-gate  # solves many people's problems.  But I also hear that some mans
69*0Sstevel@tonic-gate  # don't have a -c switch, so that adding it here would presumably
70*0Sstevel@tonic-gate  # be a Bad Thing   -- sburke@cpan.org
71*0Sstevel@tonic-gate
72*0Sstevel@tonic-gate  $command .= " | col -x" if Pod::Perldoc::IS_HPUX;
73*0Sstevel@tonic-gate
74*0Sstevel@tonic-gate  defined(&Pod::Perldoc::DEBUG)
75*0Sstevel@tonic-gate   and Pod::Perldoc::DEBUG()
76*0Sstevel@tonic-gate   and print "About to run $command\n";
77*0Sstevel@tonic-gate  ;
78*0Sstevel@tonic-gate
79*0Sstevel@tonic-gate  my $rslt = `$command`;
80*0Sstevel@tonic-gate
81*0Sstevel@tonic-gate  my $err;
82*0Sstevel@tonic-gate
83*0Sstevel@tonic-gate  if( $self->{'__filter_nroff'} ) {
84*0Sstevel@tonic-gate    defined(&Pod::Perldoc::DEBUG)
85*0Sstevel@tonic-gate     and &Pod::Perldoc::DEBUG()
86*0Sstevel@tonic-gate     and print "filter_nroff is set, so filtering...\n";
87*0Sstevel@tonic-gate    $rslt = $self->___Do_filter_nroff($rslt);
88*0Sstevel@tonic-gate  } else {
89*0Sstevel@tonic-gate    defined(&Pod::Perldoc::DEBUG)
90*0Sstevel@tonic-gate     and Pod::Perldoc::DEBUG()
91*0Sstevel@tonic-gate     and print "filter_nroff isn't set, so not filtering.\n";
92*0Sstevel@tonic-gate  }
93*0Sstevel@tonic-gate
94*0Sstevel@tonic-gate  if (($err = $?)) {
95*0Sstevel@tonic-gate    defined(&Pod::Perldoc::DEBUG)
96*0Sstevel@tonic-gate     and Pod::Perldoc::DEBUG()
97*0Sstevel@tonic-gate     and print "Nonzero exit ($?) while running $command.\n",
98*0Sstevel@tonic-gate               "Falling back to Pod::Perldoc::ToPod\n ",
99*0Sstevel@tonic-gate    ;
100*0Sstevel@tonic-gate    # A desperate fallthru:
101*0Sstevel@tonic-gate    require Pod::Perldoc::ToPod;
102*0Sstevel@tonic-gate    return  Pod::Perldoc::ToPod->new->parse_from_file(@_);
103*0Sstevel@tonic-gate
104*0Sstevel@tonic-gate  } else {
105*0Sstevel@tonic-gate    print $outfh $rslt
106*0Sstevel@tonic-gate     or die "Can't print to $$self{__output_file}: $!";
107*0Sstevel@tonic-gate  }
108*0Sstevel@tonic-gate
109*0Sstevel@tonic-gate  return;
110*0Sstevel@tonic-gate}
111*0Sstevel@tonic-gate
112*0Sstevel@tonic-gate
113*0Sstevel@tonic-gatesub ___Do_filter_nroff {
114*0Sstevel@tonic-gate  my $self = shift;
115*0Sstevel@tonic-gate  my @data = split /\n{2,}/, shift;
116*0Sstevel@tonic-gate
117*0Sstevel@tonic-gate  shift @data while @data and $data[0] !~ /\S/; # Go to header
118*0Sstevel@tonic-gate  shift @data if @data and $data[0] =~ /Contributed\s+Perl/; # Skip header
119*0Sstevel@tonic-gate  pop @data if @data and $data[-1] =~ /^\w/; # Skip footer, like
120*0Sstevel@tonic-gate				# 28/Jan/99 perl 5.005, patch 53 1
121*0Sstevel@tonic-gate  join "\n\n", @data;
122*0Sstevel@tonic-gate}
123*0Sstevel@tonic-gate
124*0Sstevel@tonic-gate1;
125*0Sstevel@tonic-gate
126*0Sstevel@tonic-gate__END__
127*0Sstevel@tonic-gate
128*0Sstevel@tonic-gate=head1 NAME
129*0Sstevel@tonic-gate
130*0Sstevel@tonic-gatePod::Perldoc::ToMan - let Perldoc render Pod as man pages
131*0Sstevel@tonic-gate
132*0Sstevel@tonic-gate=head1 SYNOPSIS
133*0Sstevel@tonic-gate
134*0Sstevel@tonic-gate  perldoc -o man Some::Modulename
135*0Sstevel@tonic-gate
136*0Sstevel@tonic-gate=head1 DESCRIPTION
137*0Sstevel@tonic-gate
138*0Sstevel@tonic-gateThis is a "plug-in" class that allows Perldoc to use
139*0Sstevel@tonic-gatePod::Man and C<nroff> for reading Pod pages.
140*0Sstevel@tonic-gate
141*0Sstevel@tonic-gateThe following options are supported:  center, date, fixed, fixedbold,
142*0Sstevel@tonic-gatefixeditalic, fixedbolditalic, quotes, release, section
143*0Sstevel@tonic-gate
144*0Sstevel@tonic-gate(Those options are explained in L<Pod::Man>.)
145*0Sstevel@tonic-gate
146*0Sstevel@tonic-gateFor example:
147*0Sstevel@tonic-gate
148*0Sstevel@tonic-gate  perldoc -o man -w center:Pod Some::Modulename
149*0Sstevel@tonic-gate
150*0Sstevel@tonic-gate=head1 CAVEAT
151*0Sstevel@tonic-gate
152*0Sstevel@tonic-gateThis module may change to use a different pod-to-nroff formatter class
153*0Sstevel@tonic-gatein the future, and this may change what options are supported.
154*0Sstevel@tonic-gate
155*0Sstevel@tonic-gate=head1 SEE ALSO
156*0Sstevel@tonic-gate
157*0Sstevel@tonic-gateL<Pod::Man>, L<Pod::Perldoc>, L<Pod::Perldoc::ToNroff>
158*0Sstevel@tonic-gate
159*0Sstevel@tonic-gate=head1 COPYRIGHT AND DISCLAIMERS
160*0Sstevel@tonic-gate
161*0Sstevel@tonic-gateCopyright (c) 2002 Sean M. Burke.  All rights reserved.
162*0Sstevel@tonic-gate
163*0Sstevel@tonic-gateThis library is free software; you can redistribute it and/or modify it
164*0Sstevel@tonic-gateunder the same terms as Perl itself.
165*0Sstevel@tonic-gate
166*0Sstevel@tonic-gateThis program is distributed in the hope that it will be useful, but
167*0Sstevel@tonic-gatewithout any warranty; without even the implied warranty of
168*0Sstevel@tonic-gatemerchantability or fitness for a particular purpose.
169*0Sstevel@tonic-gate
170*0Sstevel@tonic-gate=head1 AUTHOR
171*0Sstevel@tonic-gate
172*0Sstevel@tonic-gateSean M. Burke C<sburke@cpan.org>
173*0Sstevel@tonic-gate
174*0Sstevel@tonic-gate=cut
175*0Sstevel@tonic-gate
176