[Summary view] [Print] [Text view]

   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