summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Pod/Perldoc
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2012-11-20 18:08:54 +0000
committerKarl Berry <karl@freefriends.org>2012-11-20 18:08:54 +0000
commitc5add2ea5067382269ae6f19e345fda0b9a7bd21 (patch)
tree02f512fda46d93079c9dc59c0d76f0e398150f83 /Master/tlpkg/tlperl/lib/Pod/Perldoc
parent6c35e87bdc5a3f64833dbbc42e7d42e683db9d5b (diff)
perl 5.16.2, compiled without optimization for Windows (from siep)
git-svn-id: svn://tug.org/texlive/trunk@28315 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Pod/Perldoc')
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/Perldoc/BaseTo.pm79
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/Perldoc/GetOptsOO.pm63
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/Perldoc/ToANSI.pm96
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/Perldoc/ToChecker.pm11
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/Perldoc/ToMan.pm595
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/Perldoc/ToNroff.pm18
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/Perldoc/ToPod.pm31
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/Perldoc/ToRtf.pm25
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/Perldoc/ToTerm.pm90
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/Perldoc/ToText.pm17
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/Perldoc/ToTk.pm64
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/Perldoc/ToXml.pm17
12 files changed, 889 insertions, 217 deletions
diff --git a/Master/tlpkg/tlperl/lib/Pod/Perldoc/BaseTo.pm b/Master/tlpkg/tlperl/lib/Pod/Perldoc/BaseTo.pm
index 29a3b7d108e..aa8d84493ff 100644
--- a/Master/tlpkg/tlperl/lib/Pod/Perldoc/BaseTo.pm
+++ b/Master/tlpkg/tlperl/lib/Pod/Perldoc/BaseTo.pm
@@ -1,9 +1,14 @@
-
-require 5;
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 }
@@ -14,6 +19,22 @@ sub output_extension { 'txt' } # override in subclass!
#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(@_) {
@@ -23,6 +44,54 @@ sub _perldoc_elem {
}
}
+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;
@@ -73,9 +142,11 @@ merchantability or fitness for a particular purpose.
=head1 AUTHOR
-Current maintainer: Adriano R. Ferreira <ferreira@cpan.org>
+Current maintainer: Mark Allen C<< <mallen@cpan.org> >>
Past contributions from:
-Sean M. Burke <sburke@cpan.org>
+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/Master/tlpkg/tlperl/lib/Pod/Perldoc/GetOptsOO.pm b/Master/tlpkg/tlperl/lib/Pod/Perldoc/GetOptsOO.pm
index fa83fb74ccf..c77d5460483 100644
--- a/Master/tlpkg/tlperl/lib/Pod/Perldoc/GetOptsOO.pm
+++ b/Master/tlpkg/tlperl/lib/Pod/Perldoc/GetOptsOO.pm
@@ -1,23 +1,8 @@
-
-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@cpan.org 2002-10-31
+use vars qw($VERSION);
+$VERSION = '3.17';
BEGIN { # Make a DEBUG constant ASAP
*DEBUG = defined( &Pod::Perldoc::DEBUG )
@@ -28,7 +13,7 @@ BEGIN { # Make a DEBUG constant ASAP
sub getopts {
my($target, $args, $truth) = @_;
-
+
$args ||= \@ARGV;
$target->aside(
@@ -50,11 +35,14 @@ sub getopts {
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;
- warn "Option $first needs a following argument!\n" unless @$args;
+ $target->warn( "Option $first needs a following argument!\n" ) unless @$args;
$rest = shift @$args;
} else { # like -fbar (== -f bar)
shift @$args;
@@ -75,14 +63,14 @@ sub getopts {
} 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";
+ $target->warn( "Unknown option: $first\n" );
}
if($rest eq '') { # like -f
@@ -93,7 +81,7 @@ sub getopts {
}
}
}
-
+
$target->aside(
"Ending switch processing. Args are [@$args] with $error_count errors.\n"
@@ -123,9 +111,32 @@ Pod::Perldoc::GetOptsOO - Customized option parser for Pod::Perldoc
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
- Pod::Perldoc
+L<Pod::Perldoc>
=head1 COPYRIGHT AND DISCLAIMERS
@@ -140,9 +151,11 @@ merchantability or fitness for a particular purpose.
=head1 AUTHOR
-Current maintainer: Adriano R. Ferreira <ferreira@cpan.org>
+Current maintainer: Mark Allen C<< <mallen@cpan.org> >>
Past contributions from:
-Sean M. Burke <sburke@cpan.org>
+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/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToANSI.pm b/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToANSI.pm
new file mode 100644
index 00000000000..7be62e23589
--- /dev/null
+++ b/Master/tlpkg/tlperl/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/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToChecker.pm b/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToChecker.pm
index 10870109e60..32c309bd445 100644
--- a/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToChecker.pm
+++ b/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToChecker.pm
@@ -1,10 +1,11 @@
-
-require 5;
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';
@@ -66,10 +67,12 @@ merchantability or fitness for a particular purpose.
=head1 AUTHOR
-Current maintainer: Adriano R. Ferreira <ferreira@cpan.org>
+Current maintainer: Mark Allen C<< <mallen@cpan.org> >>
Past contributions from:
-Sean M. Burke <sburke@cpan.org>
+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/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToMan.pm b/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToMan.pm
index 09b0e817377..55616e8b899 100644
--- a/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToMan.pm
+++ b/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToMan.pm
@@ -1,15 +1,22 @@
-
-require 5;
+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!
-use base qw(Pod::Perldoc::BaseTo);
+sub SUCCESS () { 1 }
+sub FAILED () { 0 }
+
sub is_pageable { 1 }
sub write_with_binmode { 0 }
sub output_extension { 'txt' }
@@ -26,112 +33,486 @@ 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 { return bless {}, ref($_[0]) || $_[0] }
+sub new {
+ my( $either ) = shift;
+ my $self = bless {}, ref($either) || $either;
+ $self->init( @_ );
+ return $self;
+ }
-use File::Spec::Functions qw(catfile);
+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 = 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;
-}
+ 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;
@@ -148,7 +529,7 @@ Pod::Perldoc::ToMan - let Perldoc render Pod as man pages
=head1 DESCRIPTION
This is a "plug-in" class that allows Perldoc to use
-Pod::Man and C<nroff> for reading Pod pages.
+Pod::Man and C<groff> for reading Pod pages.
The following options are supported: center, date, fixed, fixedbold,
fixeditalic, fixedbolditalic, quotes, release, section
@@ -170,6 +551,8 @@ 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
@@ -181,10 +564,12 @@ merchantability or fitness for a particular purpose.
=head1 AUTHOR
-Current maintainer: Adriano R. Ferreira <ferreira@cpan.org>
+Current maintainer: Mark Allen C<< <mallen@cpan.org> >>
Past contributions from:
-Sean M. Burke <sburke@cpan.org>
+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/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToNroff.pm b/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToNroff.pm
index 991c1e3269c..2e92f2a134e 100644
--- a/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToNroff.pm
+++ b/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToNroff.pm
@@ -1,12 +1,12 @@
-
-require 5;
package Pod::Perldoc::ToNroff;
use strict;
use warnings;
+use parent qw(Pod::Perldoc::BaseTo);
-# This is unlike ToMan.pm in that it emits the raw nroff source!
+use vars qw($VERSION);
+$VERSION = '3.17';
-use base qw(Pod::Perldoc::BaseTo);
+# 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 }
@@ -29,13 +29,13 @@ 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 ",
@@ -94,10 +94,12 @@ merchantability or fitness for a particular purpose.
=head1 AUTHOR
-Current maintainer: Adriano R. Ferreira <ferreira@cpan.org>
+Current maintainer: Mark Allen C<< <mallen@cpan.org> >>
Past contributions from:
-Sean M. Burke <sburke@cpan.org>
+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/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToPod.pm b/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToPod.pm
index c3173d43702..6c15c02a781 100644
--- a/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToPod.pm
+++ b/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToPod.pm
@@ -1,18 +1,11 @@
-
-# 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 parent qw(Pod::Perldoc::BaseTo);
+
+use vars qw($VERSION);
+$VERSION = '3.17';
-use base qw(Pod::Perldoc::BaseTo);
sub is_pageable { 1 }
sub write_with_binmode { 0 }
sub output_extension { 'pod' }
@@ -22,10 +15,10 @@ 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";
+ 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>) {
@@ -37,10 +30,10 @@ sub parse_from_file {
}
}
next if $cut_mode;
- print $outfh $_ or die "Can't print to $outfh: $!";
+ print $outfh $_ or $self->die( "Can't print to $outfh: $!" );
}
-
- close IN or die "Can't close $in: $!";
+
+ close IN or $self->die( "Can't close $in: $!" );
return;
}
@@ -84,10 +77,12 @@ merchantability or fitness for a particular purpose.
=head1 AUTHOR
-Current maintainer: Adriano R. Ferreira <ferreira@cpan.org>
+Current maintainer: Mark Allen C<< <mallencpan.org> >>
Past contributions from:
-Sean M. Burke <sburke@cpan.org>
+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/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToRtf.pm b/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToRtf.pm
index 14d419fc313..a7d4739a6f0 100644
--- a/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToRtf.pm
+++ b/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToRtf.pm
@@ -1,17 +1,10 @@
-
-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;
+use parent qw( Pod::Simple::RTF );
+use vars qw($VERSION);
+$VERSION = '3.17';
sub is_pageable { 0 }
sub write_with_binmode { 0 }
@@ -20,11 +13,11 @@ 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;
}
@@ -79,10 +72,12 @@ merchantability or fitness for a particular purpose.
=head1 AUTHOR
-Current maintainer: Adriano R. Ferreira <ferreira@cpan.org>
+Current maintainer: Mark Allen C<< <mallen@cpan.org> >>
Past contributions from:
-Sean M. Burke <sburke@cpan.org>
+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/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToTerm.pm b/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToTerm.pm
new file mode 100644
index 00000000000..dddc4c8fce7
--- /dev/null
+++ b/Master/tlpkg/tlperl/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/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToText.pm b/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToText.pm
index 7d1784cd59a..0e4e2dacf4d 100644
--- a/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToText.pm
+++ b/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToText.pm
@@ -1,10 +1,11 @@
-
-require 5;
package Pod::Perldoc::ToText;
use strict;
use warnings;
-use base qw(Pod::Perldoc::BaseTo);
+use vars qw($VERSION);
+$VERSION = '3.17';
+
+use parent qw(Pod::Perldoc::BaseTo);
sub is_pageable { 1 }
sub write_with_binmode { 0 }
@@ -23,13 +24,13 @@ 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 ",
@@ -85,10 +86,12 @@ merchantability or fitness for a particular purpose.
=head1 AUTHOR
-Current maintainer: Adriano R. Ferreira <ferreira@cpan.org>
+Current maintainer: Mark Allen C<< <mallen@cpan.org> >>
Past contributions from:
-Sean M. Burke <sburke@cpan.org>
+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/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToTk.pm b/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToTk.pm
index 5b29fd996e5..fb8da15c245 100644
--- a/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToTk.pm
+++ b/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToTk.pm
@@ -1,10 +1,11 @@
-
-require 5;
package Pod::Perldoc::ToTk;
use strict;
use warnings;
-use base qw(Pod::Perldoc::BaseTo);
+use vars qw($VERSION);
+$VERSION = '3.17';
+
+use parent qw(Pod::Perldoc::BaseTo);
sub is_pageable { 1 }
sub write_with_binmode { 0 }
@@ -20,12 +21,30 @@ 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 version $Tk::VERSION"
- if $Tk::VERSION eq '800.003';
+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; }; };
-use Tk::Pod;
+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.
@@ -35,29 +54,29 @@ sub parse_from_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
+ 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
@@ -67,18 +86,18 @@ sub parse_from_file {
$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 :-(
@@ -122,10 +141,13 @@ L<Tk::Pod>, L<Pod::Perldoc>
=head1 AUTHOR
-Current maintainer: Adriano R. Ferreira <ferreira@cpan.org>
+Current maintainer: Mark Allen C<< <mallen@cpan.org> >>
Past contributions from:
-Sean M. Burke C<sburke@cpan.org>, with significant portions copied 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/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToXml.pm b/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToXml.pm
index 439e736c20e..96f35c4f4b7 100644
--- a/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToXml.pm
+++ b/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToXml.pm
@@ -1,17 +1,12 @@
-
-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;
+use parent qw( Pod::Simple::XMLOutStream );
+use vars qw($VERSION);
+$VERSION = '3.17';
sub is_pageable { 0 }
sub write_with_binmode { 0 }
@@ -57,10 +52,12 @@ merchantability or fitness for a particular purpose.
=head1 AUTHOR
-Current maintainer: Adriano R. Ferreira <ferreira@cpan.org>
+Current maintainer: Mark Allen C<< <mallen@cpan.org> >>
Past contributions from:
-Sean M. Burke <sburke@cpan.org>
+brian d foy C<< <bdfoy@cpan.org> >>
+Adriano R. Ferreira C<< <ferreira@cpan.org> >>,
+Sean M. Burke C<< <sburke@cpan.org> >>
=cut