dslinux/user/perl/lib/Pod/Perldoc BaseTo.pm GetOptsOO.pm ToChecker.pm ToMan.pm ToNroff.pm ToPod.pm ToRtf.pm ToText.pm ToTk.pm ToXml.pm

cayenne dslinux_cayenne at user.in-berlin.de
Mon Dec 4 18:00:58 CET 2006


Update of /cvsroot/dslinux/dslinux/user/perl/lib/Pod/Perldoc
In directory antilope:/tmp/cvs-serv17422/lib/Pod/Perldoc

Added Files:
	BaseTo.pm GetOptsOO.pm ToChecker.pm ToMan.pm ToNroff.pm 
	ToPod.pm ToRtf.pm ToText.pm ToTk.pm ToXml.pm 
Log Message:
Adding fresh perl source to HEAD to branch from

--- NEW FILE: ToTk.pm ---

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

use base qw(Pod::Perldoc::BaseTo);

sub is_pageable        { 1 }
sub write_with_binmode { 0 }
sub output_extension   { 'txt' } # doesn't matter
sub if_zero_length { }  # because it will be 0-length!
sub new { return bless {}, ref($_[0]) || $_[0] }

# TODO: document these and their meanings...
sub tree      { shift->_perldoc_elem('tree'    , @_) }
sub tk_opt    { shift->_perldoc_elem('tk_opt'  , @_) }
sub forky     { shift->_perldoc_elem('forky'   , @_) }

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

use Tk;
die join '', __PACKAGE__, " doesn't work nice with Tk.pm verison $Tk::VERSION"
 if $Tk::VERSION eq '800.003';

BEGIN { eval { require Tk::FcyEntry; }; };
use Tk::Pod;

# The following was adapted from "tkpod" in the Tk-Pod dist.

sub parse_from_file {

    my($self, $Input_File) = @_;
    if($self->{'forky'}) {
      return if fork;  # i.e., parent process returns
    }
    
    $Input_File =~ s{\\}{/}g
     if Pod::Perldoc::IS_MSWin32 or Pod::Perldoc::IS_Dos
     # and maybe OS/2
    ;
    
    my($tk_opt, $tree);
    $tree   = $self->{'tree'  };
    $tk_opt = $self->{'tk_opt'};
    
    #require Tk::ErrorDialog;
    
    # Add 'Tk' subdirectories to search path so, e.g.,
    # 'Scrolled' will find doc in 'Tk/Scrolled'
    
    if( $tk_opt ) {
      push @INC, grep -d $_, map catfile($_,'Tk'), @INC;
    }
    
    my $mw = MainWindow->new();
    #eval 'use blib "/home/e/eserte/src/perl/Tk-App";require Tk::App::Debug';
    $mw->withdraw;
    
    # CDE use Font Settings if available
    my $ufont = $mw->optionGet('userFont','UserFont');     # fixed width
    my $sfont = $mw->optionGet('systemFont','SystemFont'); # proportional
    if (defined($ufont) and defined($sfont)) {
        foreach ($ufont, $sfont) { s/:$//; };
        $mw->optionAdd('*Font',       $sfont);
        $mw->optionAdd('*Entry.Font', $ufont);
        $mw->optionAdd('*Text.Font',  $ufont);
    }
    
    $mw->optionAdd('*Menu.tearOff', $Tk::platform ne 'MSWin32' ? 1 : 0);
    
    $mw->Pod(
      '-file' => $Input_File,
      (($Tk::Pod::VERSION >= 4) ? ('-tree' => $tree) : ())
    )->focusNext;
    
    # xxx dirty but it works. A simple $mw->destroy if $mw->children
    # does not work because Tk::ErrorDialogs could be created.
    # (they are withdrawn after Ok instead of destory'ed I guess)
    
    if ($mw->children) {
        $mw->repeat(1000, sub {
                    # ErrorDialog is withdrawn not deleted :-(
                    foreach ($mw->children) {
                            return if "$_" =~ /^Tk::Pod/  # ->isa('Tk::Pod')
                    }
                    $mw->destroy;
                });
    } else {
        $mw->destroy;
    }
    #$mw->WidgetDump;
    MainLoop();

    exit if $self->{'forky'}; # we were the child!  so exit now!
    return;
}

1;
__END__


=head1 NAME

Pod::Perldoc::ToTk - let Perldoc use Tk::Pod to render Pod

=head1 SYNOPSIS

  perldoc -o tk Some::Modulename &

=head1 DESCRIPTION

This is a "plug-in" class that allows Perldoc to use
Tk::Pod as a formatter class.

You have to have installed Tk::Pod first, or this class won't load.

=head1 SEE ALSO

L<Tk::Pod>, L<Pod::Perldoc>

=head1 AUTHOR

Sean M. Burke C<sburke at cpan.org>, with significant portions copied from
F<tkpod> in the Tk::Pod dist, by Nick Ing-Simmons, Slaven Rezic, et al.

=cut


--- NEW FILE: ToPod.pm ---

# This class is just a hack to act as a "formatter" for
# actually unformatted Pod.
# 
# Note that this isn't the same as just passing thru whatever
# we're given -- we pass thru only the pod source, and suppress
# the Perl code (or whatever non-pod stuff is in the source file).


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

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

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

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

  open(IN, "<", $in) or die "Can't read-open $in: $!\nAborting";

  my $cut_mode = 1;
  
  # A hack for finding things between =foo and =cut, inclusive
  local $_;
  while (<IN>) {
    if(  m/^=(\w+)/s ) {
      if($cut_mode = ($1 eq 'cut')) {
        print $outfh "\n=cut\n\n";
         # Pass thru the =cut line with some harmless
         #  (and occasionally helpful) padding
      }
    }
    next if $cut_mode;
    print $outfh $_ or die "Can't print to $outfh: $!";
  }
  
  close IN or die "Can't close $in: $!";
  return;
}

1;
__END__

=head1 NAME

Pod::Perldoc::ToPod - let Perldoc render Pod as ... Pod!

=head1 SYNOPSIS

  perldoc -opod Some::Modulename

(That's currently the same as the following:)

  perldoc -u Some::Modulename

=head1 DESCRIPTION

This is a "plug-in" class that allows Perldoc to display Pod source as
itself!  Pretty Zen, huh?

Currently this class works by just filtering out the non-Pod stuff from
a given input file.

=head1 SEE ALSO

L<Pod::Perldoc>

=head1 COPYRIGHT AND DISCLAIMERS

Copyright (c) 2002 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 at cpan.org>

=cut


--- NEW FILE: ToChecker.pm ---

require 5;
package Pod::Perldoc::ToChecker;
use strict;
use warnings;
use vars qw(@ISA);

# Pick our superclass...
#
eval 'require Pod::Simple::Checker';
if($@) {
  require Pod::Checker;
  @ISA = ('Pod::Checker');
} else {
  @ISA = ('Pod::Simple::Checker');
}

sub is_pageable        { 1 }
sub write_with_binmode { 0 }
sub output_extension   { 'txt' }

sub if_zero_length {
  my( $self, $file, $tmp, $tmpfd ) = @_;
  print "No Pod errors in $file\n";
}


1;

__END__

=head1 NAME

Pod::Perldoc::ToChecker - let Perldoc check Pod for errors

=head1 SYNOPSIS

  % perldoc -o checker SomeFile.pod
  No Pod errors in SomeFile.pod
  (or an error report)

=head1 DESCRIPTION

This is a "plug-in" class that allows Perldoc to use
Pod::Simple::Checker as a "formatter" class (or if that is
not available, then Pod::Checker), to check for errors in a given
Pod file.

This is actually a Pod::Simple::Checker (or Pod::Checker) subclass, and
inherits all its options.

=head1 SEE ALSO

L<Pod::Simple::Checker>, L<Pod::Simple>, L<Pod::Checker>, L<Pod::Perldoc>

=head1 COPYRIGHT AND DISCLAIMERS

Copyright (c) 2002 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 at cpan.org>

=cut


--- NEW FILE: ToXml.pm ---

require 5;
package Pod::Perldoc::ToXml;
use strict;
use warnings;
use vars qw($VERSION);

use base qw( Pod::Simple::XMLOutStream );

$VERSION   # so that ->VERSION is happy
# stop CPAN from seeing this
 =
$Pod::Simple::XMLOutStream::VERSION;


sub is_pageable        { 0 }
sub write_with_binmode { 0 }
sub output_extension   { 'xml' }

1;
__END__

=head1 NAME

Pod::Perldoc::ToXml - let Perldoc render Pod as XML

=head1 SYNOPSIS

  perldoc -o xml -d out.xml Some::Modulename

=head1 DESCRIPTION

This is a "plug-in" class that allows Perldoc to use
Pod::Simple::XMLOutStream as a formatter class.

This is actually a Pod::Simple::XMLOutStream subclass, and inherits
all its options.

You have to have installed Pod::Simple::XMLOutStream (from the Pod::Simple
dist), or this class won't work.


=head1 SEE ALSO

L<Pod::Simple::XMLOutStream>, L<Pod::Simple>, L<Pod::Perldoc>

=head1 COPYRIGHT AND DISCLAIMERS

Copyright (c) 2002 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 at cpan.org>

=cut


--- NEW FILE: GetOptsOO.pm ---

require 5;
package Pod::Perldoc::GetOptsOO;
use strict;

# Rather like Getopt::Std's getopts
#  Call Pod::Perldoc::GetOptsOO::getopts($object, \@ARGV, $truth)
#  Given -n, if there's a opt_n_with, it'll call $object->opt_n_with( ARGUMENT )
#    (e.g., "-n foo" => $object->opt_n_with('foo').  Ditto "-nfoo")
#  Otherwise (given -n) if there's an opt_n, we'll call it $object->opt_n($truth)
#    (Truth defaults to 1)
#  Otherwise we try calling $object->handle_unknown_option('n')
#    (and we increment the error count by the return value of it)
#  If there's no handle_unknown_option, then we just warn, and then increment
#    the error counter
# 
#  The return value of Pod::Perldoc::GetOptsOO::getopts is true if no errors,
#   otherwise it's false.
#
## sburke at cpan.org 2002-10-31

BEGIN { # Make a DEBUG constant ASAP
  *DEBUG = defined( &Pod::Perldoc::DEBUG )
   ? \&Pod::Perldoc::DEBUG
   : sub(){10};
}


sub getopts {
  my($target, $args, $truth) = @_;
  
  $args ||= \@ARGV;

  $target->aside(
    "Starting switch processing.  Scanning arguments [@$args]\n"
  ) if $target->can('aside');

  return unless @$args;

  $truth = 1 unless @_ > 2;

  DEBUG > 3 and print "   Truth is $truth\n";


  my $error_count = 0;

  while( @$args  and  ($_ = $args->[0]) =~ m/^-(.)(.*)/s ) {
    my($first,$rest) = ($1,$2);
    if ($_ eq '--') {	# early exit if "--"
      shift @$args;
      last;
    }
    my $method = "opt_${first}_with";
    if( $target->can($method) ) {  # it's argumental
      if($rest eq '') {   # like -f bar
        shift @$args;
        warn "Option $first needs a following argument!\n" unless @$args;
        $rest = shift @$args;
      } else {            # like -fbar  (== -f bar)
        shift @$args;
      }

      DEBUG > 3 and print " $method => $rest\n";
      $target->$method( $rest );

    # Otherwise, it's not argumental...
    } else {

      if( $target->can( $method = "opt_$first" ) ) {
        DEBUG > 3 and print " $method is true ($truth)\n";
        $target->$method( $truth );

      # Otherwise it's an unknown option...

      } elsif( $target->can('handle_unknown_option') ) {
        DEBUG > 3
         and print " calling handle_unknown_option('$first')\n";
         
        $error_count += (
          $target->handle_unknown_option( $first ) || 0
        );

      } else {
        ++$error_count;
        warn "Unknown option: $first\n";
      }

      if($rest eq '') {   # like -f
        shift @$args
      } else {            # like -fbar  (== -f -bar )
        DEBUG > 2 and print "   Setting args->[0] to \"-$rest\"\n";
        $args->[0] = "-$rest";
      }
    }
  }
  

  $target->aside(
    "Ending switch processing.  Args are [@$args] with $error_count errors.\n"
  ) if $target->can('aside');

  $error_count == 0;
}

1;


--- NEW FILE: ToText.pm ---

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

use base qw(Pod::Perldoc::BaseTo);

sub is_pageable        { 1 }
sub write_with_binmode { 0 }
sub output_extension   { 'txt' }

use Pod::Text ();

sub alt       { shift->_perldoc_elem('alt'     , @_) }
sub indent    { shift->_perldoc_elem('indent'  , @_) }
sub loose     { shift->_perldoc_elem('loose'   , @_) }
sub quotes    { shift->_perldoc_elem('quotes'  , @_) }
sub sentence  { shift->_perldoc_elem('sentence', @_) }
sub width     { shift->_perldoc_elem('width'   , @_) }

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

sub parse_from_file {
  my $self = shift;
  
  my @options =
    map {; $_, $self->{$_} }
      grep !m/^_/s,
        keys %$self
  ;
  
  defined(&Pod::Perldoc::DEBUG)
   and Pod::Perldoc::DEBUG()
   and print "About to call new Pod::Text ",
    $Pod::Text::VERSION ? "(v$Pod::Text::VERSION) " : '',
    "with options: ",
    @options ? "[@options]" : "(nil)", "\n";
  ;

  Pod::Text->new(@options)->parse_from_file(@_);
}

1;

=head1 NAME

Pod::Perldoc::ToText - let Perldoc render Pod as plaintext

=head1 SYNOPSIS

  perldoc -o text Some::Modulename

=head1 DESCRIPTION

This is a "plug-in" class that allows Perldoc to use
Pod::Text as a formatter class.

It supports the following options, which are explained in
L<Pod::Text>: alt, indent, loose, quotes, sentence, width

For example:

  perldoc -o text -w indent:5 Some::Modulename

=head1 CAVEAT

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

=head1 SEE ALSO

L<Pod::Text>, L<Pod::Perldoc>

=head1 COPYRIGHT AND DISCLAIMERS

Copyright (c) 2002 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 at cpan.org>

=cut


--- NEW FILE: 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 at 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 at cpan.org>

=cut


--- NEW FILE: ToNroff.pm ---

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

# This is unlike ToMan.pm in that it emits the raw nroff source!

use base qw(Pod::Perldoc::BaseTo);

sub is_pageable        { 1 }  # well, if you ask for it...
sub write_with_binmode { 0 }
sub output_extension   { 'man' }

use Pod::Man ();

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] }

sub parse_from_file {
  my $self = shift;
  my $file = $_[0];
  
  my @options =
    map {; $_, $self->{$_} }
      grep !m/^_/s,
        keys %$self
  ;
  
  defined(&Pod::Perldoc::DEBUG)
   and Pod::Perldoc::DEBUG()
   and print "About to call new Pod::Man ",
    $Pod::Man::VERSION ? "(v$Pod::Man::VERSION) " : '',
    "with options: ",
    @options ? "[@options]" : "(nil)", "\n";
  ;

  Pod::Man->new(@options)->parse_from_file(@_);
}

1;
__END__

=head1 NAME

Pod::Perldoc::ToNroff - let Perldoc convert Pod to nroff

=head1 SYNOPSIS

  perldoc -o nroff -d something.3 Some::Modulename

=head1 DESCRIPTION

This is a "plug-in" class that allows Perldoc to use
Pod::Man as a formatter class.

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 nroff -w center:Pod -d something.3 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::ToMan>

=head1 COPYRIGHT AND DISCLAIMERS

Copyright (c) 2002 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 at cpan.org>

=cut


--- NEW FILE: ToRtf.pm ---

require 5;
package Pod::Perldoc::ToRtf;
use strict;
use warnings;
use vars qw($VERSION);

use base qw( Pod::Simple::RTF );

$VERSION   # so that ->VERSION is happy
# stop CPAN from seeing this
 =
$Pod::Simple::RTF::VERSION;


sub is_pageable        { 0 }
sub write_with_binmode { 0 }
sub output_extension   { 'rtf' }

sub page_for_perldoc {
  my($self, $tempfile, $perldoc) = @_;
  return unless $perldoc->IS_MSWin32;
  
  my $rtf_pager = $ENV{'RTFREADER'} || 'write.exe';
  
  $perldoc->aside( "About to launch <\"$rtf_pager\" \"$tempfile\">\n" );
  
  return 1 if system( qq{"$rtf_pager"}, qq{"$tempfile"} ) == 0;
  return 0;
}

1;
__END__

=head1 NAME

Pod::Perldoc::ToRtf - let Perldoc render Pod as RTF

=head1 SYNOPSIS

  perldoc -o rtf Some::Modulename

=head1 DESCRIPTION

This is a "plug-in" class that allows Perldoc to use
Pod::Simple::RTF as a formatter class.

This is actually a Pod::Simple::RTF subclass, and inherits
all its options.

You have to have Pod::Simple::RTF installed (from the Pod::Simple dist),
or this module won't work.

If Perldoc is running under MSWin and uses this class as a formatter,
the output will be opened with F<write.exe> or whatever program is
specified in the environment variable C<RTFREADER>. For example, to
specify that RTF files should be opened the same as they are when you
double-click them, you would do C<set RTFREADER=start.exe> in your
F<autoexec.bat>.

Handy tip: put C<set PERLDOC=-ortf> in your F<autoexec.bat>
and that will set this class as the default formatter to run when
you do C<perldoc whatever>.

=head1 SEE ALSO

L<Pod::Simple::RTF>, L<Pod::Simple>, L<Pod::Perldoc>

=head1 COPYRIGHT AND DISCLAIMERS

Copyright (c) 2002 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 at cpan.org>

=cut


--- NEW FILE: BaseTo.pm ---

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

sub is_pageable        { '' }
sub write_with_binmode {  1 }

sub output_extension   { 'txt' }  # override in subclass!

# sub new { my $self = shift; ...  }
# sub parse_from_file( my($class, $in, $out) = ...; ... }

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

sub _perldoc_elem {
  my($self, $name) = splice @_,0,2;
  if(@_) {
    $self->{$name} = $_[0];
  } else {
    $self->{$name};
  }
}


1;





More information about the dslinux-commit mailing list