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