diff options
Diffstat (limited to 'gnu/usr.bin/perl/cpan/Pod-Perldoc/lib/Pod/Perldoc')
12 files changed, 1743 insertions, 0 deletions
diff --git a/gnu/usr.bin/perl/cpan/Pod-Perldoc/lib/Pod/Perldoc/BaseTo.pm b/gnu/usr.bin/perl/cpan/Pod-Perldoc/lib/Pod/Perldoc/BaseTo.pm new file mode 100644 index 00000000000..aa8d84493ff --- /dev/null +++ b/gnu/usr.bin/perl/cpan/Pod-Perldoc/lib/Pod/Perldoc/BaseTo.pm @@ -0,0 +1,152 @@ +package Pod::Perldoc::BaseTo; +use strict; +use warnings; + +use vars qw($VERSION); +$VERSION = '3.17'; + +use Carp qw(croak carp); +use Config qw(%Config); +use File::Spec::Functions qw(catfile); + +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] } + +# this is also in Perldoc.pm, but why look there when you're a +# subclass of this? +sub TRUE () {1} +sub FALSE () {return} + +BEGIN { + *is_vms = $^O eq 'VMS' ? \&TRUE : \&FALSE unless defined &is_vms; + *is_mswin32 = $^O eq 'MSWin32' ? \&TRUE : \&FALSE unless defined &is_mswin32; + *is_dos = $^O eq 'dos' ? \&TRUE : \&FALSE unless defined &is_dos; + *is_os2 = $^O eq 'os2' ? \&TRUE : \&FALSE unless defined &is_os2; + *is_cygwin = $^O eq 'cygwin' ? \&TRUE : \&FALSE unless defined &is_cygwin; + *is_linux = $^O eq 'linux' ? \&TRUE : \&FALSE unless defined &is_linux; + *is_hpux = $^O =~ m/hpux/ ? \&TRUE : \&FALSE unless defined &is_hpux; + *is_openbsd = $^O =~ m/openbsd/ ? \&TRUE : \&FALSE unless defined &is_openbsd; +} + +sub _perldoc_elem { + my($self, $name) = splice @_,0,2; + if(@_) { + $self->{$name} = $_[0]; + } else { + $self->{$name}; + } +} + +sub debugging { + my( $self, @messages ) = @_; + + ( defined(&Pod::Perldoc::DEBUG) and &Pod::Perldoc::DEBUG() ) + } + +sub debug { + my( $self, @messages ) = @_; + return unless $self->debugging; + print STDERR map { "DEBUG $_" } @messages; + } + +sub warn { + my( $self, @messages ) = @_; + carp join "\n", @messages, ''; + } + +sub die { + my( $self, @messages ) = @_; + croak join "\n", @messages, ''; + } + +sub _get_path_components { + my( $self ) = @_; + + my @paths = split /\Q$Config{path_sep}/, $ENV{PATH}; + + return @paths; + } + +sub _find_executable_in_path { + my( $self, $program ) = @_; + + my @found = (); + foreach my $dir ( $self->_get_path_components ) { + my $binary = catfile( $dir, $program ); + $self->debug( "Looking for $binary\n" ); + next unless -e $binary; + unless( -x $binary ) { + $self->warn( "Found $binary but it's not executable. Skipping.\n" ); + next; + } + $self->debug( "Found $binary\n" ); + push @found, $binary; + } + + return @found; + } + +1; + +__END__ + +=head1 NAME + +Pod::Perldoc::BaseTo - Base for Pod::Perldoc formatters + +=head1 SYNOPSIS + + package Pod::Perldoc::ToMyFormat; + + use base qw( Pod::Perldoc::BaseTo ); + ... + +=head1 DESCRIPTION + +This package is meant as a base of Pod::Perldoc formatters, +like L<Pod::Perldoc::ToText>, L<Pod::Perldoc::ToMan>, etc. + +It provides default implementations for the methods + + is_pageable + write_with_binmode + output_extension + _perldoc_elem + +The concrete formatter must implement + + new + parse_from_file + +=head1 SEE ALSO + +L<perldoc> + +=head1 COPYRIGHT AND DISCLAIMERS + +Copyright (c) 2002-2007 Sean M. Burke. + +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 + +Current maintainer: Mark Allen C<< <mallen@cpan.org> >> + +Past contributions from: +brian d foy C<< <bdfoy@cpan.org> >> +Adriano R. Ferreira C<< <ferreira@cpan.org> >>, +Sean M. Burke C<< <sburke@cpan.org> >> + +=cut diff --git a/gnu/usr.bin/perl/cpan/Pod-Perldoc/lib/Pod/Perldoc/GetOptsOO.pm b/gnu/usr.bin/perl/cpan/Pod-Perldoc/lib/Pod/Perldoc/GetOptsOO.pm new file mode 100644 index 00000000000..c77d5460483 --- /dev/null +++ b/gnu/usr.bin/perl/cpan/Pod-Perldoc/lib/Pod/Perldoc/GetOptsOO.pm @@ -0,0 +1,161 @@ +package Pod::Perldoc::GetOptsOO; +use strict; + +use vars qw($VERSION); +$VERSION = '3.17'; + +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; + } + if ($first eq '-' and $rest) { # GNU style long param names + ($first, $rest) = split '=', $rest, 2; + } + my $method = "opt_${first}_with"; + if( $target->can($method) ) { # it's argumental + if($rest eq '') { # like -f bar + shift @$args; + $target->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; + $target->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; + +__END__ + +=head1 NAME + +Pod::Perldoc::GetOptsOO - Customized option parser for Pod::Perldoc + +=head1 SYNOPSIS + + use Pod::Perldoc::GetOptsOO (); + + Pod::Perldoc::GetOptsOO::getopts( $obj, \@args, $truth ) + or die "wrong usage"; + + +=head1 DESCRIPTION + +Implements a customized option parser used for +L<Pod::Perldoc>. + +Rather like Getopt::Std's getopts: + +=over + +=item Call Pod::Perldoc::GetOptsOO::getopts($object, \@ARGV, $truth) + +=item 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") + +=item Otherwise (given -n) if there's an opt_n, we'll call it $object->opt_n($truth) + (Truth defaults to 1) + +=item Otherwise we try calling $object->handle_unknown_option('n') + (and we increment the error count by the return value of it) + +=item If there's no handle_unknown_option, then we just warn, and then increment + the error counter + +=back + +The return value of Pod::Perldoc::GetOptsOO::getopts is true if no errors, +otherwise it's false. + +=head1 SEE ALSO + +L<Pod::Perldoc> + +=head1 COPYRIGHT AND DISCLAIMERS + +Copyright (c) 2002-2007 Sean M. Burke. + +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 + +Current maintainer: Mark Allen C<< <mallen@cpan.org> >> + +Past contributions from: +brian d foy C<< <bdfoy@cpan.org> >> +Adriano R. Ferreira C<< <ferreira@cpan.org> >>, +Sean M. Burke C<< <sburke@cpan.org> >> + +=cut diff --git a/gnu/usr.bin/perl/cpan/Pod-Perldoc/lib/Pod/Perldoc/ToANSI.pm b/gnu/usr.bin/perl/cpan/Pod-Perldoc/lib/Pod/Perldoc/ToANSI.pm new file mode 100644 index 00000000000..7be62e23589 --- /dev/null +++ b/gnu/usr.bin/perl/cpan/Pod-Perldoc/lib/Pod/Perldoc/ToANSI.pm @@ -0,0 +1,96 @@ +package Pod::Perldoc::ToANSI; +use strict; +use warnings; +use parent qw(Pod::Perldoc::BaseTo); + +use vars qw($VERSION); +$VERSION = '3.17'; + +sub is_pageable { 1 } +sub write_with_binmode { 0 } +sub output_extension { 'txt' } + +use Pod::Text::Color (); + +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::Color ", + $Pod::Text::VERSION ? "(v$Pod::Text::VERSION) " : '', + "with options: ", + @options ? "[@options]" : "(nil)", "\n"; + ; + + Pod::Text::Color->new(@options)->parse_from_file(@_); +} + +1; + +=head1 NAME + +Pod::Perldoc::ToANSI - render Pod with ANSI color escapes + +=head1 SYNOPSIS + + perldoc -o ansi 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 term -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::Text::Color>, L<Pod::Perldoc> + +=head1 COPYRIGHT AND DISCLAIMERS + +Copyright (c) 2011 Mark Allen. 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 + +Current maintainer: Mark Allen C<< <mallen@cpan.org> >> + +Past contributions from: +brian d foy C<< <bdfoy@cpan.org> >> +Adriano R. Ferreira C<< <ferreira@cpan.org> >>, +Sean M. Burke C<< <sburke@cpan.org> >> + + +=cut diff --git a/gnu/usr.bin/perl/cpan/Pod-Perldoc/lib/Pod/Perldoc/ToChecker.pm b/gnu/usr.bin/perl/cpan/Pod-Perldoc/lib/Pod/Perldoc/ToChecker.pm new file mode 100644 index 00000000000..32c309bd445 --- /dev/null +++ b/gnu/usr.bin/perl/cpan/Pod-Perldoc/lib/Pod/Perldoc/ToChecker.pm @@ -0,0 +1,78 @@ +package Pod::Perldoc::ToChecker; +use strict; +use warnings; +use vars qw(@ISA); + +use vars qw($VERSION); +$VERSION = '3.17'; + +# 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 + +Current maintainer: Mark Allen C<< <mallen@cpan.org> >> + +Past contributions from: +brian d foy C<< <bdfoy@cpan.org> >> +Adriano R. Ferreira C<< <ferreira@cpan.org> >>, +Sean M. Burke C<< <sburke@cpan.org> >> + +=cut + diff --git a/gnu/usr.bin/perl/cpan/Pod-Perldoc/lib/Pod/Perldoc/ToMan.pm b/gnu/usr.bin/perl/cpan/Pod-Perldoc/lib/Pod/Perldoc/ToMan.pm new file mode 100644 index 00000000000..55616e8b899 --- /dev/null +++ b/gnu/usr.bin/perl/cpan/Pod-Perldoc/lib/Pod/Perldoc/ToMan.pm @@ -0,0 +1,575 @@ +require 5.006; +package Pod::Perldoc::ToMan; +use strict; +use warnings; +use parent qw(Pod::Perldoc::BaseTo); + +use vars qw($VERSION); +$VERSION = '3.17'; + +use File::Spec::Functions qw(catfile); +use Pod::Man 2.18; +# 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! + +sub SUCCESS () { 1 } +sub FAILED () { 0 } + +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 name { shift->_perldoc_elem('name' , @_) } +sub quotes { shift->_perldoc_elem('quotes' , @_) } +sub release { shift->_perldoc_elem('release' , @_) } +sub section { shift->_perldoc_elem('section' , @_) } + +sub new { + my( $either ) = shift; + my $self = bless {}, ref($either) || $either; + $self->init( @_ ); + return $self; + } + +sub init { + my( $self, @args ) = @_; + + unless( $self->__nroffer ) { + my $roffer = $self->_find_roffer( $self->_roffer_candidates ); + $self->debug( "Using $roffer\n" ); + $self->__nroffer( $roffer ); + } + else { + $self->debug( "__nroffer is " . $self->__nroffer() . "\n" ); + } + + $self->_check_nroffer; + } + +sub _roffer_candidates { + my( $self ) = @_; + + if( $self->is_openbsd ) { qw( mandoc groff nroff ) } + else { qw( groff nroff mandoc ) } + } + +sub _find_roffer { + my( $self, @candidates ) = @_; + + my @found = (); + foreach my $candidate ( @candidates ) { + push @found, $self->_find_executable_in_path( $candidate ); + } + + return wantarray ? @found : $found[0]; + } + +sub _check_nroffer { + return 1; + # where is it in the PATH? + + # is it executable? + + # what is its real name? + + # what is its version? + + # does it support the flags we need? + + # is it good enough for us? + } + +sub _get_stty { `stty -a` } + +sub _get_columns_from_stty { + my $output = $_[0]->_get_stty; + + if( $output =~ /\bcolumns\s+(\d+)/ ) { return $1 } + elsif( $output =~ /;\s*(\d+)\s+columns;/ ) { return $1 } + else { return 0 } + } + +sub _get_columns_from_manwidth { + my( $self ) = @_; + + return 0 unless defined $ENV{MANWIDTH}; + + unless( $ENV{MANWIDTH} =~ m/\A\d+\z/ ) { + $self->warn( "Ignoring non-numeric MANWIDTH ($ENV{MANWIDTH})\n" ); + return 0; + } + + if( $ENV{MANWIDTH} == 0 ) { + $self->warn( "Ignoring MANWIDTH of 0. Really? Why even run the program? :)\n" ); + return 0; + } + + if( $ENV{MANWIDTH} =~ m/\A(\d+)\z/ ) { return $1 } + + return 0; + } + +sub _get_default_width { + 73 + } + +sub _get_columns { + $_[0]->_get_columns_from_manwidth || + $_[0]->_get_columns_from_stty || + $_[0]->_get_default_width; + } + +sub _get_podman_switches { + my( $self ) = @_; + + my @switches = grep !m/^_/s, keys %$self; + + push @switches, 'utf8' => 1; + $self->debug( "Pod::Man switches are [@switches]\n" ); + + return @switches; + } + +sub _parse_with_pod_man { + my( $self, $file ) = @_; + + #->output_fh and ->output_string from Pod::Simple aren't + # working, apparently, so there's this ugly hack: + local *STDOUT; + open STDOUT, '>', $self->{_text_ref}; + my $parser = Pod::Man->new( $self->_get_podman_switches ); + $self->debug( "Parsing $file\n" ); + $parser->parse_from_file( $file ); + $self->debug( "Done parsing $file\n" ); + close STDOUT; + + $self->die( "No output from Pod::Man!\n" ) + unless length $self->{_text_ref}; + + $self->_save_pod_man_output if $self->debugging; + + return SUCCESS; + } + +sub _save_pod_man_output { + my( $self, $fh ) = @_; + + $fh = do { + my $file = "podman.out.$$.txt"; + $self->debug( "Writing $file with Pod::Man output\n" ); + open my $fh2, '>', $file; + $fh2; + } unless $fh; + + print { $fh } ${ $self->{_text_ref} }; + } + +sub _have_groff_with_utf8 { + my( $self ) = @_; + + return 0 unless $self->_is_groff; + my $roffer = $self->__nroffer; + + my $minimum_groff_version = '1.20.1'; + + my $version_string = `$roffer -v`; + my( $version ) = $version_string =~ /\(?groff\)? version (\d+\.\d+(?:\.\d+)?)/; + $self->debug( "Found groff $version\n" ); + + # is a string comparison good enough? + if( $version lt $minimum_groff_version ) { + $self->warn( + "You have an old groff." . + " Update to version $minimum_groff_version for good Unicode support.\n" . + "If you don't upgrade, wide characters may come out oddly.\n" + ); + } + + $version ge $minimum_groff_version; + } + +sub _have_mandoc_with_utf8 { + my( $self ) = @_; + + return 0 unless $self->_is_mandoc; + my $roffer = $self->__nroffer; + + my $minimum_mandoc_version = '1.11'; + + my $version_string = `$roffer -V`; + my( $version ) = $version_string =~ /mandoc ((\d+)\.(\d+))/; + $self->debug( "Found mandoc $version\n" ); + + # is a string comparison good enough? + if( $version lt $minimum_mandoc_version ) { + $self->warn( + "You have an older mandoc." . + " Update to version $minimum_mandoc_version for better Unicode support.\n" . + "If you don't upgrade, wide characters may come out oddly.\n" . + "Your results still might be odd. If you have groff, that's even better.\n" + ); + } + + $version ge $minimum_mandoc_version; + } + +sub _collect_nroff_switches { + my( $self ) = shift; + + my @render_switches = $self->_is_mandoc ? qw(-mandoc) : qw(-man); + + push @render_switches, $self->_get_device_switches; + + # Thanks to Brendan O'Dea for contributing the following block + if( $self->_is_roff and $self->is_linux and -t STDOUT and my ($cols) = $self->_get_columns ) { + my $c = $cols * 39 / 40; + $cols = $c > $cols - 2 ? $c : $cols -2; + push @render_switches, '-rLL=' . (int $c) . 'n' if $cols > 80; + } + + # 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 + push @render_switches, '-c' if( $self->_is_roff and $self->is_cygwin ); + + return @render_switches; + } + +sub _get_device_switches { + my( $self ) = @_; + + if( $self->_is_nroff ) { qw() } + elsif( $self->_have_groff_with_utf8 ) { qw(-Kutf8 -Tutf8) } + elsif( $self->_is_ebcdic ) { qw(-Tcp1047) } + elsif( $self->_have_mandoc_with_utf8 ) { qw(-Tutf8) } + elsif( $self->_is_mandoc ) { qw() } + else { qw(-Tlatin1) } + } + +sub _is_roff { + my( $self ) = @_; + + $self->_is_nroff or $self->_is_groff; + } + +sub _is_nroff { + my( $self ) = @_; + + $self->__nroffer =~ /\bnroff\b/; + } + +sub _is_groff { + my( $self ) = @_; + + $self->__nroffer =~ /\bgroff\b/; + } + +sub _is_mandoc { + my ( $self ) = @_; + + $self->__nroffer =~ /\bmandoc\b/; + } + +sub _is_ebcdic { + my( $self ) = @_; + + return 0; + } + +sub _filter_through_nroff { + my( $self ) = shift; + $self->debug( "Filtering through " . $self->__nroffer() . "\n" ); + + # Maybe someone set rendering switches as part of the opt_n value + # Deal with that here. + + my ($render, $switches) = $self->__nroffer() =~ /\A([\/a-zA-Z0-9_-]+)\b(.+)?\z/; + + $self->die("no nroffer!?") unless $render; + my @render_switches = $self->_collect_nroff_switches; + + if ( $switches ) { + # Eliminate whitespace + $switches =~ s/\s//g; + + # Then seperate the switches with a zero-width positive + # lookahead on the dash. + # + # See: + # http://www.effectiveperlprogramming.com/blog/1411 + # for a good discussion of this technique + + push @render_switches, split(/(?=-)/, $switches); + } + + $self->debug( "render is $render\n" ); + $self->debug( "render options are @render_switches\n" ); + + require Symbol; + require IPC::Open3; + require IO::Handle; + + my $pid = IPC::Open3::open3( + my $writer, + my $reader, + my $err = Symbol::gensym(), + $render, + @render_switches + ); + + $reader->autoflush(1); + + use IO::Select; + my $selector = IO::Select->new( $reader ); + + $self->debug( "Writing to pipe to $render\n" ); + + my $offset = 0; + my $chunk_size = 4096; + my $length = length( ${ $self->{_text_ref} } ); + my $chunks = $length / $chunk_size; + my $done; + my $buffer; + while( $offset <= $length ) { + $self->debug( "Writing chunk $chunks\n" ); $chunks++; + syswrite $writer, ${ $self->{_text_ref} }, $chunk_size, $offset + or $self->die( $! ); + $offset += $chunk_size; + $self->debug( "Checking read\n" ); + READ: { + last READ unless $selector->can_read( 0.01 ); + $self->debug( "Reading\n" ); + my $bytes = sysread $reader, $buffer, 4096; + $self->debug( "Read $bytes bytes\n" ); + $done .= $buffer; + $self->debug( sprintf "Output is %d bytes\n", + length $done + ); + next READ; + } + } + close $writer; + $self->debug( "Done writing\n" ); + + # read any leftovers + $done .= do { local $/; <$reader> }; + $self->debug( sprintf "Done reading. Output is %d bytes\n", + length $done + ); + + if( $? ) { + $self->warn( "Error from pipe to $render!\n" ); + $self->debug( 'Error: ' . do { local $/; <$err> } ); + } + + + close $reader; + if( my $err = $? ) { + $self->debug( + "Nonzero exit ($?) while running `$render @render_switches`.\n" . + "Falling back to Pod::Perldoc::ToPod\n" + ); + return $self->_fallback_to_pod( @_ ); + } + + $self->debug( "Output:\n----\n$done\n----\n" ); + + ${ $self->{_text_ref} } = $done; + + return length ${ $self->{_text_ref} } ? SUCCESS : FAILED; + } + +sub parse_from_file { + my( $self, $file, $outfh) = @_; + + # We have a pipeline of filters each affecting the reference + # in $self->{_text_ref} + $self->{_text_ref} = \my $output; + + $self->_parse_with_pod_man( $file ); + # so far, nroff is an external command so we ensure it worked + my $result = $self->_filter_through_nroff; + return $self->_fallback_to_pod( @_ ) unless $result == SUCCESS; + + $self->_post_nroff_processing; + + print { $outfh } $output or + $self->die( "Can't print to $$self{__output_file}: $!" ); + + return; + } + +sub _fallback_to_pod { + my( $self, @args ) = @_; + $self->warn( "Falling back to Pod because there was a problem!\n" ); + require Pod::Perldoc::ToPod; + return Pod::Perldoc::ToPod->new->parse_from_file(@_); + } + +# maybe there's a user setting we should check? +sub _get_tab_width { 4 } + +sub _expand_tabs { + my( $self ) = @_; + + my $tab_width = ' ' x $self->_get_tab_width; + + ${ $self->{_text_ref} } =~ s/\t/$tab_width/g; + } + +sub _post_nroff_processing { + my( $self ) = @_; + + if( $self->is_hpux ) { + $self->debug( "On HP-UX, I'm going to expand tabs for you\n" ); + # this used to be a pipe to `col -x` for HP-UX + $self->_expand_tabs; + } + + if( $self->{'__filter_nroff'} ) { + $self->debug( "filter_nroff is set, so filtering\n" ); + $self->_remove_nroff_header; + $self->_remove_nroff_footer; + } + else { + $self->debug( "filter_nroff is not set, so not filtering\n" ); + } + + $self->_handle_unicode; + + return 1; + } + +# I don't think this does anything since there aren't two consecutive +# newlines in the Pod::Man output +sub _remove_nroff_header { + my( $self ) = @_; + $self->debug( "_remove_nroff_header is still a stub!\n" ); + return 1; + +# 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 + } + +# I don't think this does anything since there aren't two consecutive +# newlines in the Pod::Man output +sub _remove_nroff_footer { + my( $self ) = @_; + $self->debug( "_remove_nroff_footer is still a stub!\n" ); + return 1; + ${ $self->{_text_ref} } =~ s/\n\n+.*\w.*\Z//m; + +# my @data = split /\n{2,}/, shift; +# pop @data if @data and $data[-1] =~ /^\w/; # Skip footer, like + # 28/Jan/99 perl 5.005, patch 53 1 + } + +sub _unicode_already_handled { + my( $self ) = @_; + + $self->_have_groff_with_utf8 || + 1 # so, we don't have a case that needs _handle_unicode + ; + } + +sub _handle_unicode { +# this is the job of preconv +# we don't need this with groff 1.20 and later. + my( $self ) = @_; + + return 1 if $self->_unicode_already_handled; + + require Encode; + + # it's UTF-8 here, but we need character data + my $text = Encode::decode( 'UTF-8', ${ $self->{_text_ref} } ) ; + +# http://www.mail-archive.com/groff@gnu.org/msg01378.html +# http://linux.die.net/man/7/groff_char +# http://www.gnu.org/software/groff/manual/html_node/Using-Symbols.html +# http://lists.gnu.org/archive/html/groff/2011-05/msg00007.html +# http://www.simplicidade.org/notes/archives/2009/05/fixing_the_pod.html +# http://lists.freebsd.org/pipermail/freebsd-questions/2011-July/232239.html + $text =~ s/(\P{ASCII})/ + sprintf '\\[u%04X]', ord $1 + /eg; + + # should we encode? + ${ $self->{_text_ref} } = $text; + } + +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<groff> 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) 2011 brian d foy. All rights reserved. + +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 + +Current maintainer: Mark Allen C<< <mallen@cpan.org> >> + +Past contributions from: +brian d foy C<< <bdfoy@cpan.org> >> +Adriano R. Ferreira C<< <ferreira@cpan.org> >>, +Sean M. Burke C<< <sburke@cpan.org> >> + +=cut + diff --git a/gnu/usr.bin/perl/cpan/Pod-Perldoc/lib/Pod/Perldoc/ToNroff.pm b/gnu/usr.bin/perl/cpan/Pod-Perldoc/lib/Pod/Perldoc/ToNroff.pm new file mode 100644 index 00000000000..2e92f2a134e --- /dev/null +++ b/gnu/usr.bin/perl/cpan/Pod-Perldoc/lib/Pod/Perldoc/ToNroff.pm @@ -0,0 +1,105 @@ +package Pod::Perldoc::ToNroff; +use strict; +use warnings; +use parent qw(Pod::Perldoc::BaseTo); + +use vars qw($VERSION); +$VERSION = '3.17'; + +# This is unlike ToMan.pm in that it emits the raw nroff source! + +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 + +Current maintainer: Mark Allen C<< <mallen@cpan.org> >> + +Past contributions from: +brian d foy C<< <bdfoy@cpan.org> >> +Adriano R. Ferreira C<< <ferreira@cpan.org> >>, +Sean M. Burke C<< <sburke@cpan.org> >> + +=cut + diff --git a/gnu/usr.bin/perl/cpan/Pod-Perldoc/lib/Pod/Perldoc/ToPod.pm b/gnu/usr.bin/perl/cpan/Pod-Perldoc/lib/Pod/Perldoc/ToPod.pm new file mode 100644 index 00000000000..6c15c02a781 --- /dev/null +++ b/gnu/usr.bin/perl/cpan/Pod-Perldoc/lib/Pod/Perldoc/ToPod.pm @@ -0,0 +1,88 @@ +package Pod::Perldoc::ToPod; +use strict; +use warnings; +use parent qw(Pod::Perldoc::BaseTo); + +use vars qw($VERSION); +$VERSION = '3.17'; + +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 $self->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 $self->die( "Can't print to $outfh: $!" ); + } + + close IN or $self->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 + +Current maintainer: Mark Allen C<< <mallencpan.org> >> + +Past contributions from: +brian d foy C<< <bdfoy@cpan.org> >> +Adriano R. Ferreira C<< <ferreira@cpan.org> >>, +Sean M. Burke C<< <sburke@cpan.org> >> + +=cut + diff --git a/gnu/usr.bin/perl/cpan/Pod-Perldoc/lib/Pod/Perldoc/ToRtf.pm b/gnu/usr.bin/perl/cpan/Pod-Perldoc/lib/Pod/Perldoc/ToRtf.pm new file mode 100644 index 00000000000..a7d4739a6f0 --- /dev/null +++ b/gnu/usr.bin/perl/cpan/Pod-Perldoc/lib/Pod/Perldoc/ToRtf.pm @@ -0,0 +1,83 @@ +package Pod::Perldoc::ToRtf; +use strict; +use warnings; +use parent qw( Pod::Simple::RTF ); + +use vars qw($VERSION); +$VERSION = '3.17'; + +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 + +Current maintainer: Mark Allen C<< <mallen@cpan.org> >> + +Past contributions from: +brian d foy C<< <bdfoy@cpan.org> >> +Adriano R. Ferreira C<< <ferreira@cpan.org> >>, +Sean M. Burke C<< <sburke@cpan.org> >> + +=cut + diff --git a/gnu/usr.bin/perl/cpan/Pod-Perldoc/lib/Pod/Perldoc/ToTerm.pm b/gnu/usr.bin/perl/cpan/Pod-Perldoc/lib/Pod/Perldoc/ToTerm.pm new file mode 100644 index 00000000000..dddc4c8fce7 --- /dev/null +++ b/gnu/usr.bin/perl/cpan/Pod-Perldoc/lib/Pod/Perldoc/ToTerm.pm @@ -0,0 +1,90 @@ +package Pod::Perldoc::ToTerm; +use strict; +use warnings; + +use vars qw($VERSION); +$VERSION = '3.17'; + +use parent qw(Pod::Perldoc::BaseTo); + +sub is_pageable { 1 } +sub write_with_binmode { 0 } +sub output_extension { 'txt' } + +use Pod::Text::Termcap (); + +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::Termcap ", + $Pod::Text::VERSION ? "(v$Pod::Text::VERSION) " : '', + "with options: ", + @options ? "[@options]" : "(nil)", "\n"; + ; + + Pod::Text::Termcap->new(@options)->parse_from_file(@_); +} + +1; + +=head1 NAME + +Pod::Perldoc::ToTerm - render Pod with terminal escapes + +=head1 SYNOPSIS + + perldoc -o term 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 term -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::Text::Termcap>, L<Pod::Perldoc> + +=head1 COPYRIGHT AND DISCLAIMERS + +Copyright (c) 2011 Mark Allen. + +This program is free software; you can redistribute it and/or modify it +under the terms of either: the GNU General Public License as published +by the Free Software Foundation; or the Artistic License. + +See http://dev.perl.org/licenses/ for more information. + +=head1 AUTHOR + +Mark Allen C<< <mallen@cpan.org> >> + +=cut diff --git a/gnu/usr.bin/perl/cpan/Pod-Perldoc/lib/Pod/Perldoc/ToText.pm b/gnu/usr.bin/perl/cpan/Pod-Perldoc/lib/Pod/Perldoc/ToText.pm new file mode 100644 index 00000000000..0e4e2dacf4d --- /dev/null +++ b/gnu/usr.bin/perl/cpan/Pod-Perldoc/lib/Pod/Perldoc/ToText.pm @@ -0,0 +1,98 @@ +package Pod::Perldoc::ToText; +use strict; +use warnings; + +use vars qw($VERSION); +$VERSION = '3.17'; + +use parent 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 + +Current maintainer: Mark Allen C<< <mallen@cpan.org> >> + +Past contributions from: +brian d foy C<< <bdfoy@cpan.org> >> +Adriano R. Ferreira C<< <ferreira@cpan.org> >>, +Sean M. Burke C<< <sburke@cpan.org> >> + + +=cut + diff --git a/gnu/usr.bin/perl/cpan/Pod-Perldoc/lib/Pod/Perldoc/ToTk.pm b/gnu/usr.bin/perl/cpan/Pod-Perldoc/lib/Pod/Perldoc/ToTk.pm new file mode 100644 index 00000000000..fb8da15c245 --- /dev/null +++ b/gnu/usr.bin/perl/cpan/Pod-Perldoc/lib/Pod/Perldoc/ToTk.pm @@ -0,0 +1,154 @@ +package Pod::Perldoc::ToTk; +use strict; +use warnings; + +use vars qw($VERSION); +$VERSION = '3.17'; + +use parent 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); + +BEGIN{ # Tk is not core, but this is + eval { require Tk } || + __PACKAGE__->die( <<"HERE" ); +You must have the Tk module to use Pod::Perldoc::ToTk. +If you have it installed, ensure it's in your Perl library +path. +HERE + + __PACKAGE__->die( + __PACKAGE__, + " doesn't work nice with Tk.pm version $Tk::VERSION" + ) if $Tk::VERSION eq '800.003'; + } + + +BEGIN { eval { require Tk::FcyEntry; }; }; +BEGIN{ # Tk::Pod is not core, but this is + eval { require Tk::Pod } || + __PACKAGE__->die( <<"HERE" ); +You must have the Tk::Pod module to use Pod::Perldoc::ToTk. +If you have it installed, ensure it's in your Perl library +path. +HERE + } + +# 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 $self->is_mswin32 or $self->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 + +Current maintainer: Mark Allen C<< <mallen@cpan.org> >> + +Past contributions from: +brian d foy C<< <bdfoy@cpan.org> >> +Adriano R. Ferreira C<< <ferreira@cpan.org> >>; +Sean M. Burke C<< <sburke@cpan.org> >>; +significant portions copied from +F<tkpod> in the Tk::Pod dist, by Nick Ing-Simmons, Slaven Rezic, et al. + +=cut + diff --git a/gnu/usr.bin/perl/cpan/Pod-Perldoc/lib/Pod/Perldoc/ToXml.pm b/gnu/usr.bin/perl/cpan/Pod-Perldoc/lib/Pod/Perldoc/ToXml.pm new file mode 100644 index 00000000000..96f35c4f4b7 --- /dev/null +++ b/gnu/usr.bin/perl/cpan/Pod-Perldoc/lib/Pod/Perldoc/ToXml.pm @@ -0,0 +1,63 @@ +package Pod::Perldoc::ToXml; +use strict; +use warnings; +use vars qw($VERSION); + +use parent qw( Pod::Simple::XMLOutStream ); + +use vars qw($VERSION); +$VERSION = '3.17'; + +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 + +Current maintainer: Mark Allen C<< <mallen@cpan.org> >> + +Past contributions from: +brian d foy C<< <bdfoy@cpan.org> >> +Adriano R. Ferreira C<< <ferreira@cpan.org> >>, +Sean M. Burke C<< <sburke@cpan.org> >> + +=cut + |