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 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 $pod2man =
|
---|
51 | catfile(
|
---|
52 | ($self->{'__bindir'} || die "no bindir set?!" ),
|
---|
53 | ($self->{'__pod2man'} || die "no pod2man set?!" ),
|
---|
54 | )
|
---|
55 | ;
|
---|
56 | unless(-e $pod2man) {
|
---|
57 | # This is rarely needed, I think.
|
---|
58 | $pod2man = $self->{'__pod2man'} || die "no pod2man set?!";
|
---|
59 | die "Can't find a pod2man?! (". $self->{'__pod2man'} .")\nAborting"
|
---|
60 | unless -e $pod2man;
|
---|
61 | }
|
---|
62 |
|
---|
63 | my $command = "$pod2man $switches --lax $file | $render -man";
|
---|
64 | # no temp file, just a pipe!
|
---|
65 |
|
---|
66 | # Thanks to Brendan O'Dea for contributing the following block
|
---|
67 | if(Pod::Perldoc::IS_Linux and -t STDOUT
|
---|
68 | and my ($cols) = `stty -a` =~ m/\bcolumns\s+(\d+)/
|
---|
69 | ) {
|
---|
70 | my $c = $cols * 39 / 40;
|
---|
71 | $cols = $c > $cols - 2 ? $c : $cols -2;
|
---|
72 | $command .= ' -rLL=' . (int $c) . 'n' if $cols > 80;
|
---|
73 | }
|
---|
74 |
|
---|
75 | if(Pod::Perldoc::IS_Cygwin) {
|
---|
76 | $command .= ' -c';
|
---|
77 | }
|
---|
78 |
|
---|
79 | # I hear persistent reports that adding a -c switch to $render
|
---|
80 | # solves many people's problems. But I also hear that some mans
|
---|
81 | # don't have a -c switch, so that unconditionally adding it here
|
---|
82 | # would presumably be a Bad Thing -- [email protected]
|
---|
83 |
|
---|
84 | $command .= " | col -x" if Pod::Perldoc::IS_HPUX;
|
---|
85 |
|
---|
86 | defined(&Pod::Perldoc::DEBUG)
|
---|
87 | and Pod::Perldoc::DEBUG()
|
---|
88 | and print "About to run $command\n";
|
---|
89 | ;
|
---|
90 |
|
---|
91 | my $rslt = `$command`;
|
---|
92 |
|
---|
93 | my $err;
|
---|
94 |
|
---|
95 | if( $self->{'__filter_nroff'} ) {
|
---|
96 | defined(&Pod::Perldoc::DEBUG)
|
---|
97 | and &Pod::Perldoc::DEBUG()
|
---|
98 | and print "filter_nroff is set, so filtering...\n";
|
---|
99 | $rslt = $self->___Do_filter_nroff($rslt);
|
---|
100 | } else {
|
---|
101 | defined(&Pod::Perldoc::DEBUG)
|
---|
102 | and Pod::Perldoc::DEBUG()
|
---|
103 | and print "filter_nroff isn't set, so not filtering.\n";
|
---|
104 | }
|
---|
105 |
|
---|
106 | if (($err = $?)) {
|
---|
107 | defined(&Pod::Perldoc::DEBUG)
|
---|
108 | and Pod::Perldoc::DEBUG()
|
---|
109 | and print "Nonzero exit ($?) while running $command.\n",
|
---|
110 | "Falling back to Pod::Perldoc::ToPod\n ",
|
---|
111 | ;
|
---|
112 | # A desperate fallthru:
|
---|
113 | require Pod::Perldoc::ToPod;
|
---|
114 | return Pod::Perldoc::ToPod->new->parse_from_file(@_);
|
---|
115 |
|
---|
116 | } else {
|
---|
117 | print $outfh $rslt
|
---|
118 | or die "Can't print to $$self{__output_file}: $!";
|
---|
119 | }
|
---|
120 |
|
---|
121 | return;
|
---|
122 | }
|
---|
123 |
|
---|
124 |
|
---|
125 | sub ___Do_filter_nroff {
|
---|
126 | my $self = shift;
|
---|
127 | my @data = split /\n{2,}/, shift;
|
---|
128 |
|
---|
129 | shift @data while @data and $data[0] !~ /\S/; # Go to header
|
---|
130 | shift @data if @data and $data[0] =~ /Contributed\s+Perl/; # Skip header
|
---|
131 | pop @data if @data and $data[-1] =~ /^\w/; # Skip footer, like
|
---|
132 | # 28/Jan/99 perl 5.005, patch 53 1
|
---|
133 | join "\n\n", @data;
|
---|
134 | }
|
---|
135 |
|
---|
136 | 1;
|
---|
137 |
|
---|
138 | __END__
|
---|
139 |
|
---|
140 | =head1 NAME
|
---|
141 |
|
---|
142 | Pod::Perldoc::ToMan - let Perldoc render Pod as man pages
|
---|
143 |
|
---|
144 | =head1 SYNOPSIS
|
---|
145 |
|
---|
146 | perldoc -o man Some::Modulename
|
---|
147 |
|
---|
148 | =head1 DESCRIPTION
|
---|
149 |
|
---|
150 | This is a "plug-in" class that allows Perldoc to use
|
---|
151 | Pod::Man and C<nroff> for reading Pod pages.
|
---|
152 |
|
---|
153 | The following options are supported: center, date, fixed, fixedbold,
|
---|
154 | fixeditalic, fixedbolditalic, quotes, release, section
|
---|
155 |
|
---|
156 | (Those options are explained in L<Pod::Man>.)
|
---|
157 |
|
---|
158 | For example:
|
---|
159 |
|
---|
160 | perldoc -o man -w center:Pod Some::Modulename
|
---|
161 |
|
---|
162 | =head1 CAVEAT
|
---|
163 |
|
---|
164 | This module may change to use a different pod-to-nroff formatter class
|
---|
165 | in the future, and this may change what options are supported.
|
---|
166 |
|
---|
167 | =head1 SEE ALSO
|
---|
168 |
|
---|
169 | L<Pod::Man>, L<Pod::Perldoc>, L<Pod::Perldoc::ToNroff>
|
---|
170 |
|
---|
171 | =head1 COPYRIGHT AND DISCLAIMERS
|
---|
172 |
|
---|
173 | Copyright (c) 2002,3,4 Sean M. Burke. All rights reserved.
|
---|
174 |
|
---|
175 | This library is free software; you can redistribute it and/or modify it
|
---|
176 | under the same terms as Perl itself.
|
---|
177 |
|
---|
178 | This program is distributed in the hope that it will be useful, but
|
---|
179 | without any warranty; without even the implied warranty of
|
---|
180 | merchantability or fitness for a particular purpose.
|
---|
181 |
|
---|
182 | =head1 AUTHOR
|
---|
183 |
|
---|
184 | Sean M. Burke C<[email protected]>
|
---|
185 |
|
---|
186 | =cut
|
---|
187 |
|
---|