Commit | Line | Data |
---|---|---|
920dae64 AT |
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 -- sburke@cpan.org | |
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<sburke@cpan.org> | |
185 | ||
186 | =cut | |
187 |