Pod/Perldoc/ToMan.pm


require 5;
package Pod::Perldoc::ToMan;
use strict;
use warnings;

# This class is unlike ToText.pm et al, because we're NOT paging thru
# the output in our particular format -- we make the output and
# then we run nroff (or whatever) on it, and then page thru the
# (plaintext) output of THAT!

use base qw(Pod::Perldoc::BaseTo);
sub is_pageable        { 1 }
sub write_with_binmode { 0 }
sub output_extension   { 'txt' }

sub __filter_nroff  { shift->_perldoc_elem('__filter_nroff'  , @_) }
sub __nroffer       { shift->_perldoc_elem('__nroffer'       , @_) }
sub __bindir        { shift->_perldoc_elem('__bindir'        , @_) }
sub __pod2man       { shift->_perldoc_elem('__pod2man'       , @_) }
sub __output_file   { shift->_perldoc_elem('__output_file'   , @_) }

sub center          { shift->_perldoc_elem('center'         , @_) }
sub date            { shift->_perldoc_elem('date'           , @_) }
sub fixed           { shift->_perldoc_elem('fixed'          , @_) }
sub fixedbold       { shift->_perldoc_elem('fixedbold'      , @_) }
sub fixeditalic     { shift->_perldoc_elem('fixeditalic'    , @_) }
sub fixedbolditalic { shift->_perldoc_elem('fixedbolditalic', @_) }
sub quotes          { shift->_perldoc_elem('quotes'         , @_) }
sub release         { shift->_perldoc_elem('release'        , @_) }
sub section         { shift->_perldoc_elem('section'        , @_) }

sub new { return bless {}, ref($_[0]) || $_[0] }

use File::Spec::Functions qw(catfile);

sub parse_from_file {
  my $self = shift;
  my($file, $outfh) = @_;

  my $render = $self->{'__nroffer'} || die "no nroffer set!?";
  
  # turn the switches into CLIs
  my $switches = join ' ',
    map qq{"--$_=$self->{$_}"},
      grep !m/^_/s,
        keys %$self
  ;

  my $pod2man =
    catfile(
      ($self->{'__bindir'}  || die "no bindir set?!"  ),
      ($self->{'__pod2man'} || die "no pod2man set?!" ),
    )
  ;
  unless(-e $pod2man) {
    # This is rarely needed, I think.
    $pod2man = $self->{'__pod2man'} || die "no pod2man set?!";
    die "Can't find a pod2man?! (". $self->{'__pod2man'} .")\nAborting"
      unless -e $pod2man;
  }

  my $command = "$pod2man $switches --lax $file | $render -man";
         # no temp file, just a pipe!

  # Thanks to Brendan O'Dea for contributing the following block
  if(Pod::Perldoc::IS_Linux and -t STDOUT
    and my ($cols) = `stty -a` =~ m/\bcolumns\s+(\d+)/
  ) {
    my $c = $cols * 39 / 40;
    $cols = $c > $cols - 2 ? $c : $cols -2;
    $command .= ' -rLL=' . (int $c) . 'n' if $cols > 80;
  }

  if(Pod::Perldoc::IS_Cygwin) {
    $command .= ' -c';
  }

  # I hear persistent reports that adding a -c switch to $render
  # solves many people's problems.  But I also hear that some mans
  # don't have a -c switch, so that unconditionally adding it here
  # would presumably be a Bad Thing   -- sburke@cpan.org

  $command .= " | col -x" if Pod::Perldoc::IS_HPUX;
  
  defined(&Pod::Perldoc::DEBUG)
   and Pod::Perldoc::DEBUG()
   and print "About to run $command\n";
  ;
  
  my $rslt = `$command`;

  my $err;

  if( $self->{'__filter_nroff'} ) {
    defined(&Pod::Perldoc::DEBUG)
     and &Pod::Perldoc::DEBUG()
     and print "filter_nroff is set, so filtering...\n";
    $rslt = $self->___Do_filter_nroff($rslt);
  } else {
    defined(&Pod::Perldoc::DEBUG)
     and Pod::Perldoc::DEBUG()
     and print "filter_nroff isn't set, so not filtering.\n";
  }

  if (($err = $?)) {
    defined(&Pod::Perldoc::DEBUG)
     and Pod::Perldoc::DEBUG()
     and print "Nonzero exit ($?) while running $command.\n",
               "Falling back to Pod::Perldoc::ToPod\n ",
    ;
    # A desperate fallthru:
    require Pod::Perldoc::ToPod;
    return  Pod::Perldoc::ToPod->new->parse_from_file(@_);
    
  } else {
    print $outfh $rslt
     or die "Can't print to $$self{__output_file}: $!";
  }
  
  return;
}


sub ___Do_filter_nroff {
  my $self = shift;
  my @data = split /\n{2,}/, shift;
  
  shift @data while @data and $data[0] !~ /\S/; # Go to header
  shift @data if @data and $data[0] =~ /Contributed\s+Perl/; # Skip header
  pop @data if @data and $data[-1] =~ /^\w/; # Skip footer, like
                                # 28/Jan/99 perl 5.005, patch 53 1
  join "\n\n", @data;
}

1;

__END__

=head1 NAME

Pod::Perldoc::ToMan - let Perldoc render Pod as man pages

=head1 SYNOPSIS

  perldoc -o man Some::Modulename

=head1 DESCRIPTION

This is a "plug-in" class that allows Perldoc to use
Pod::Man and C<nroff> for reading Pod pages.

The following options are supported:  center, date, fixed, fixedbold,
fixeditalic, fixedbolditalic, quotes, release, section

(Those options are explained in L<Pod::Man>.)

For example:

  perldoc -o man -w center:Pod Some::Modulename

=head1 CAVEAT

This module may change to use a different pod-to-nroff formatter class
in the future, and this may change what options are supported.

=head1 SEE ALSO

L<Pod::Man>, L<Pod::Perldoc>, L<Pod::Perldoc::ToNroff>

=head1 COPYRIGHT AND DISCLAIMERS

Copyright (c) 2002,3,4 Sean M. Burke.  All rights reserved.

This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

This program is distributed in the hope that it will be useful, but
without any warranty; without even the implied warranty of
merchantability or fitness for a particular purpose.

=head1 AUTHOR

Sean M. Burke C<sburke@cpan.org>

=cut

Revision:	1.1
Committed:	Thu Jun 30 14:27:15 2005 UTC (21 years, 4 months ago) by root
Branch:	MAIN
CVS Tags:	PERL-5-8-7, HEAD
Branch point for:	PERL
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.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