| 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 | |