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