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