home *** CD-ROM | disk | FTP | other *** search
/ PC World 2005 December (Special) / PCWorld_2005-12_Special_cd.bin / Bezpecnost / lsti / lsti.exe / framework-2.5.exe / ToMan.pm < prev    next >
Text File  |  2005-01-27  |  5KB  |  184 lines
  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.  
  184.