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