summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Pod
diff options
context:
space:
mode:
authorSiep Kroonenberg <siepo@cybercomm.nl>2021-03-03 11:04:20 +0000
committerSiep Kroonenberg <siepo@cybercomm.nl>2021-03-03 11:04:20 +0000
commit13c3572d26e0868b9665513e4646ade860ae7810 (patch)
tree72f68d7c1270cc0a1d504f8eeb45d4de6b36f2d1 /Master/tlpkg/tlperl/lib/Pod
parent87d16a01498a53c4bb455d78ae7131370e47591e (diff)
Updated tlperl
git-svn-id: svn://tug.org/texlive/trunk@58075 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Pod')
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/Find.pm553
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/Html.pm27
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/InputObjects.pm946
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/Man.pm25
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/ParseLink.pm8
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/ParseUtils.pm861
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/Parser.pm1836
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/PlainText.pm748
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/Select.pm756
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/Simple.pm40
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/Simple.pod27
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/Simple/BlackBox.pm732
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/Simple/Checker.pm6
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/Simple/Debug.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/Simple/DumpAsText.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/Simple/DumpAsXML.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/Simple/HTML.pm4
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/Simple/HTMLBatch.pm30
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/Simple/JustPod.pm362
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/Simple/LinkSection.pm4
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/Simple/Methody.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/Simple/Progress.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/Simple/PullParser.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/Simple/PullParserEndToken.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/Simple/PullParserStartToken.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/Simple/PullParserTextToken.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/Simple/PullParserToken.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/Simple/RTF.pm179
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/Simple/Search.pm35
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/Simple/SimpleTree.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/Simple/Subclassing.pod14
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/Simple/Text.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/Simple/TextContent.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/Simple/TiedOutFH.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/Simple/Transcode.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/Simple/TranscodeDumb.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/Simple/TranscodeSmart.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/Simple/XHTML.pm10
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/Simple/XMLOutStream.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/Text.pm35
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/Text/Color.pm9
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/Text/Overstrike.pm6
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/Text/Termcap.pm72
43 files changed, 1204 insertions, 6157 deletions
diff --git a/Master/tlpkg/tlperl/lib/Pod/Find.pm b/Master/tlpkg/tlperl/lib/Pod/Find.pm
deleted file mode 100644
index f258f26df68..00000000000
--- a/Master/tlpkg/tlperl/lib/Pod/Find.pm
+++ /dev/null
@@ -1,553 +0,0 @@
-#############################################################################
-# Pod/Find.pm -- finds files containing POD documentation
-#
-# Author: Marek Rouchal <marekr@cpan.org>
-#
-# Copyright (C) 1999-2000 by Marek Rouchal (and borrowing code
-# from Nick Ing-Simmon's PodToHtml). All rights reserved.
-# This file is part of "PodParser". Pod::Find is free software;
-# you can redistribute it and/or modify it under the same terms
-# as Perl itself.
-#############################################################################
-
-package Pod::Find;
-use strict;
-
-use vars qw($VERSION);
-$VERSION = '1.63'; ## Current version of this package
-require 5.005; ## requires this Perl version or later
-use Carp;
-
-BEGIN {
- if ($] < 5.006) {
- require Symbol;
- import Symbol;
- }
-}
-
-#############################################################################
-
-=head1 NAME
-
-Pod::Find - find POD documents in directory trees
-
-=head1 SYNOPSIS
-
- use Pod::Find qw(pod_find simplify_name);
- my %pods = pod_find({ -verbose => 1, -inc => 1 });
- foreach(keys %pods) {
- print "found library POD `$pods{$_}' in $_\n";
- }
-
- print "podname=",simplify_name('a/b/c/mymodule.pod'),"\n";
-
- $location = pod_where( { -inc => 1 }, "Pod::Find" );
-
-=head1 DESCRIPTION
-
-B<NOTE: This module is considered legacy; modern Perl releases (5.18 and
-higher) are going to remove Pod-Parser from core and use L<Pod-Simple>
-for all things POD.>
-
-B<Pod::Find> provides a set of functions to locate POD files. Note that
-no function is exported by default to avoid pollution of your namespace,
-so be sure to specify them in the B<use> statement if you need them:
-
- use Pod::Find qw(pod_find);
-
-From this version on the typical SCM (software configuration management)
-directories are ignored. These are: RCS, CVS, SCCS, .svn, .hg, .git, .sync
-
-=cut
-
-#use diagnostics;
-use Exporter;
-use File::Spec;
-use File::Find;
-use Cwd qw(abs_path cwd);
-
-use vars qw(@ISA @EXPORT_OK $VERSION);
-@ISA = qw(Exporter);
-@EXPORT_OK = qw(&pod_find &simplify_name &pod_where &contains_pod);
-
-# package global variables
-my $SIMPLIFY_RX;
-
-=head2 C<pod_find( { %opts } , @directories )>
-
-The function B<pod_find> searches for POD documents in a given set of
-files and/or directories. It returns a hash with the file names as keys
-and the POD name as value. The POD name is derived from the file name
-and its position in the directory tree.
-
-E.g. when searching in F<$HOME/perl5lib>, the file
-F<$HOME/perl5lib/MyModule.pm> would get the POD name I<MyModule>,
-whereas F<$HOME/perl5lib/Myclass/Subclass.pm> would be
-I<Myclass::Subclass>. The name information can be used for POD
-translators.
-
-Only text files containing at least one valid POD command are found.
-
-A warning is printed if more than one POD file with the same POD name
-is found, e.g. F<CPAN.pm> in different directories. This usually
-indicates duplicate occurrences of modules in the I<@INC> search path.
-
-B<OPTIONS> The first argument for B<pod_find> may be a hash reference
-with options. The rest are either directories that are searched
-recursively or files. The POD names of files are the plain basenames
-with any Perl-like extension (.pm, .pl, .pod) stripped.
-
-=over 4
-
-=item C<-verbose =E<gt> 1>
-
-Print progress information while scanning.
-
-=item C<-perl =E<gt> 1>
-
-Apply Perl-specific heuristics to find the correct PODs. This includes
-stripping Perl-like extensions, omitting subdirectories that are numeric
-but do I<not> match the current Perl interpreter's version id, suppressing
-F<site_perl> as a module hierarchy name etc.
-
-=item C<-script =E<gt> 1>
-
-Search for PODs in the current Perl interpreter's installation
-B<scriptdir>. This is taken from the local L<Config|Config> module.
-
-=item C<-inc =E<gt> 1>
-
-Search for PODs in the current Perl interpreter's I<@INC> paths. This
-automatically considers paths specified in the C<PERL5LIB> environment
-as this is included in I<@INC> by the Perl interpreter itself.
-
-=back
-
-=cut
-
-# return a hash of the POD files found
-# first argument may be a hashref (options),
-# rest is a list of directories to search recursively
-sub pod_find
-{
- my %opts;
- if(ref $_[0]) {
- %opts = %{shift()};
- }
-
- $opts{-verbose} ||= 0;
- $opts{-perl} ||= 0;
-
- my (@search) = @_;
-
- if($opts{-script}) {
- require Config;
- push(@search, $Config::Config{scriptdir})
- if -d $Config::Config{scriptdir};
- $opts{-perl} = 1;
- }
-
- if($opts{-inc}) {
- if ($^O eq 'MacOS') {
- # tolerate '.', './some_dir' and '(../)+some_dir' on Mac OS
- my @new_INC = @INC;
- for (@new_INC) {
- if ( $_ eq '.' ) {
- $_ = ':';
- } elsif ( $_ =~ s{^((?:\.\./)+)}{':' x (length($1)/3)}e ) {
- $_ = ':'. $_;
- } else {
- $_ =~ s{^\./}{:};
- }
- }
- push(@search, grep($_ ne File::Spec->curdir, @new_INC));
- } else {
- my %seen;
- my $curdir = File::Spec->curdir;
- foreach(@INC) {
- next if $_ eq $curdir;
- my $path = abs_path($_);
- push(@search, $path) unless $seen{$path}++;
- }
- }
-
- $opts{-perl} = 1;
- }
-
- if($opts{-perl}) {
- require Config;
- # this code simplifies the POD name for Perl modules:
- # * remove "site_perl"
- # * remove e.g. "i586-linux" (from 'archname')
- # * remove e.g. 5.00503
- # * remove pod/ if followed by *.pod (e.g. in pod/perlfunc.pod)
-
- # Mac OS:
- # * remove ":?site_perl:"
- # * remove :?pod: if followed by *.pod (e.g. in :pod:perlfunc.pod)
-
- if ($^O eq 'MacOS') {
- $SIMPLIFY_RX =
- qq!^(?i:\:?site_perl\:|\:?pod\:(?=.*?\\.pod\\z))*!;
- } else {
- $SIMPLIFY_RX =
- qq!^(?i:site(_perl)?/|\Q$Config::Config{archname}\E/|\\d+\\.\\d+([_.]?\\d+)?/|pod/(?=.*?\\.pod\\z))*!;
- }
- }
-
- my %dirs_visited;
- my %pods;
- my %names;
- my $pwd = cwd();
-
- foreach my $try (@search) {
- unless(File::Spec->file_name_is_absolute($try)) {
- # make path absolute
- $try = File::Spec->catfile($pwd,$try);
- }
- # simplify path
- # on VMS canonpath will vmsify:[the.path], but File::Find::find
- # wants /unixy/paths
- if ($^O eq 'VMS') {
- $try = VMS::Filespec::unixify($try);
- }
- else {
- $try = File::Spec->canonpath($try);
- }
- my $name;
- if(-f $try) {
- if($name = _check_and_extract_name($try, $opts{-verbose})) {
- _check_for_duplicates($try, $name, \%names, \%pods);
- }
- next;
- }
- my $root_rx = $^O eq 'MacOS' ? qq!^\Q$try\E! : qq!^\Q$try\E/!;
- $root_rx=~ s|//$|/|; # remove trailing double slash
- File::Find::find( sub {
- my $item = $File::Find::name;
- if(-d) {
- if($item =~ m{/(?:RCS|CVS|SCCS|\.svn|\.hg|\.git|\.sync)$}) {
- $File::Find::prune = 1;
- return;
- }
- elsif($dirs_visited{$item}) {
- warn "Directory '$item' already seen, skipping.\n"
- if($opts{-verbose});
- $File::Find::prune = 1;
- return;
- }
- else {
- $dirs_visited{$item} = 1;
- }
- if($opts{-perl} && /^(\d+\.[\d_]+)\z/s && eval "$1" != $]) {
- $File::Find::prune = 1;
- warn "Perl $] version mismatch on $_, skipping.\n"
- if($opts{-verbose});
- }
- return;
- }
- if($name = _check_and_extract_name($item, $opts{-verbose}, $root_rx)) {
- _check_for_duplicates($item, $name, \%names, \%pods);
- }
- }, $try); # end of File::Find::find
- }
- chdir $pwd;
- return %pods;
-}
-
-sub _check_for_duplicates {
- my ($file, $name, $names_ref, $pods_ref) = @_;
- if($$names_ref{$name}) {
- warn "Duplicate POD found (shadowing?): $name ($file)\n";
- warn ' Already seen in ',
- join(' ', grep($$pods_ref{$_} eq $name, keys %$pods_ref)),"\n";
- }
- else {
- $$names_ref{$name} = 1;
- }
- return $$pods_ref{$file} = $name;
-}
-
-sub _check_and_extract_name {
- my ($file, $verbose, $root_rx) = @_;
-
- # check extension or executable flag
- # this involves testing the .bat extension on Win32!
- unless(-f $file && -T $file && ($file =~ /\.(pod|pm|plx?)\z/i || -x $file )) {
- return;
- }
-
- return unless contains_pod($file,$verbose);
-
- # strip non-significant path components
- # TODO what happens on e.g. Win32?
- my $name = $file;
- if(defined $root_rx) {
- $name =~ s/$root_rx//is;
- $name =~ s/$SIMPLIFY_RX//is if(defined $SIMPLIFY_RX);
- }
- else {
- if ($^O eq 'MacOS') {
- $name =~ s/^.*://s;
- } else {
- $name =~ s{^.*/}{}s;
- }
- }
- _simplify($name);
- $name =~ s{/+}{::}g;
- if ($^O eq 'MacOS') {
- $name =~ s{:+}{::}g; # : -> ::
- } else {
- $name =~ s{/+}{::}g; # / -> ::
- }
- return $name;
-}
-
-=head2 C<simplify_name( $str )>
-
-The function B<simplify_name> is equivalent to B<basename>, but also
-strips Perl-like extensions (.pm, .pl, .pod) and extensions like
-F<.bat>, F<.cmd> on Win32 and OS/2, or F<.com> on VMS, respectively.
-
-=cut
-
-# basic simplification of the POD name:
-# basename & strip extension
-sub simplify_name {
- my ($str) = @_;
- # remove all path components
- if ($^O eq 'MacOS') {
- $str =~ s/^.*://s;
- } else {
- $str =~ s{^.*/}{}s;
- }
- _simplify($str);
- return $str;
-}
-
-# internal sub only
-sub _simplify {
- # strip Perl's own extensions
- $_[0] =~ s/\.(pod|pm|plx?)\z//i;
- # strip meaningless extensions on Win32 and OS/2
- $_[0] =~ s/\.(bat|exe|cmd)\z//i if($^O =~ /mswin|os2/i);
- # strip meaningless extensions on VMS
- $_[0] =~ s/\.(com)\z//i if($^O eq 'VMS');
-}
-
-# contribution from Tim Jenness <t.jenness@jach.hawaii.edu>
-
-=head2 C<pod_where( { %opts }, $pod )>
-
-Returns the location of a pod document given a search directory
-and a module (e.g. C<File::Find>) or script (e.g. C<perldoc>) name.
-
-Options:
-
-=over 4
-
-=item C<-inc =E<gt> 1>
-
-Search @INC for the pod and also the C<scriptdir> defined in the
-L<Config|Config> module.
-
-=item C<-dirs =E<gt> [ $dir1, $dir2, ... ]>
-
-Reference to an array of search directories. These are searched in order
-before looking in C<@INC> (if B<-inc>). Current directory is used if
-none are specified.
-
-=item C<-verbose =E<gt> 1>
-
-List directories as they are searched
-
-=back
-
-Returns the full path of the first occurrence to the file.
-Package names (eg 'A::B') are automatically converted to directory
-names in the selected directory. (eg on unix 'A::B' is converted to
-'A/B'). Additionally, '.pm', '.pl' and '.pod' are appended to the
-search automatically if required.
-
-A subdirectory F<pod/> is also checked if it exists in any of the given
-search directories. This ensures that e.g. L<perlfunc|perlfunc> is
-found.
-
-It is assumed that if a module name is supplied, that that name
-matches the file name. Pods are not opened to check for the 'NAME'
-entry.
-
-A check is made to make sure that the file that is found does
-contain some pod documentation.
-
-=cut
-
-sub pod_where {
-
- # default options
- my %options = (
- '-inc' => 0,
- '-verbose' => 0,
- '-dirs' => [ File::Spec->curdir ],
- );
-
- # Check for an options hash as first argument
- if (defined $_[0] && ref($_[0]) eq 'HASH') {
- my $opt = shift;
-
- # Merge default options with supplied options
- %options = (%options, %$opt);
- }
-
- # Check usage
- carp 'Usage: pod_where({options}, $pod)' unless (scalar(@_));
-
- # Read argument
- my $pod = shift;
-
- # Split on :: and then join the name together using File::Spec
- my @parts = split (/::/, $pod);
-
- # Get full directory list
- my @search_dirs = @{ $options{'-dirs'} };
-
- if ($options{'-inc'}) {
-
- require Config;
-
- # Add @INC
- if ($^O eq 'MacOS' && $options{'-inc'}) {
- # tolerate '.', './some_dir' and '(../)+some_dir' on Mac OS
- my @new_INC = @INC;
- for (@new_INC) {
- if ( $_ eq '.' ) {
- $_ = ':';
- } elsif ( $_ =~ s{^((?:\.\./)+)}{':' x (length($1)/3)}e ) {
- $_ = ':'. $_;
- } else {
- $_ =~ s{^\./}{:};
- }
- }
- push (@search_dirs, @new_INC);
- } elsif ($options{'-inc'}) {
- push (@search_dirs, @INC);
- }
-
- # Add location of pod documentation for perl man pages (eg perlfunc)
- # This is a pod directory in the private install tree
- #my $perlpoddir = File::Spec->catdir($Config::Config{'installprivlib'},
- # 'pod');
- #push (@search_dirs, $perlpoddir)
- # if -d $perlpoddir;
-
- # Add location of binaries such as pod2text
- push (@search_dirs, $Config::Config{'scriptdir'})
- if -d $Config::Config{'scriptdir'};
- }
-
- warn 'Search path is: '.join(' ', @search_dirs)."\n"
- if $options{'-verbose'};
-
- # Loop over directories
- Dir: foreach my $dir ( @search_dirs ) {
-
- # Don't bother if can't find the directory
- if (-d $dir) {
- warn "Looking in directory $dir\n"
- if $options{'-verbose'};
-
- # Now concatenate this directory with the pod we are searching for
- my $fullname = File::Spec->catfile($dir, @parts);
- $fullname = VMS::Filespec::unixify($fullname) if $^O eq 'VMS';
- warn "Filename is now $fullname\n"
- if $options{'-verbose'};
-
- # Loop over possible extensions
- foreach my $ext ('', '.pod', '.pm', '.pl') {
- my $fullext = $fullname . $ext;
- if (-f $fullext &&
- contains_pod($fullext, $options{'-verbose'}) ) {
- warn "FOUND: $fullext\n" if $options{'-verbose'};
- return $fullext;
- }
- }
- } else {
- warn "Directory $dir does not exist\n"
- if $options{'-verbose'};
- next Dir;
- }
- # for some strange reason the path on MacOS/darwin/cygwin is
- # 'pods' not 'pod'
- # this could be the case also for other systems that
- # have a case-tolerant file system, but File::Spec
- # does not recognize 'darwin' yet. And cygwin also has "pods",
- # but is not case tolerant. Oh well...
- if((File::Spec->case_tolerant || $^O =~ /macos|darwin|cygwin/i)
- && -d File::Spec->catdir($dir,'pods')) {
- $dir = File::Spec->catdir($dir,'pods');
- redo Dir;
- }
- if(-d File::Spec->catdir($dir,'pod')) {
- $dir = File::Spec->catdir($dir,'pod');
- redo Dir;
- }
- }
- # No match;
- return;
-}
-
-=head2 C<contains_pod( $file , $verbose )>
-
-Returns true if the supplied filename (not POD module) contains some pod
-information.
-
-=cut
-
-sub contains_pod {
- my $file = shift;
- my $verbose = 0;
- $verbose = shift if @_;
-
- # check for one line of POD
- my $podfh;
- if ($] < 5.006) {
- $podfh = gensym();
- }
-
- unless(open($podfh,"<$file")) {
- warn "Error: $file is unreadable: $!\n";
- return;
- }
-
- local $/ = undef;
- my $pod = <$podfh>;
- close($podfh) || die "Error closing $file: $!\n";
- unless($pod =~ /^=(head\d|pod|over|item|cut)\b/m) {
- warn "No POD in $file, skipping.\n"
- if($verbose);
- return 0;
- }
-
- return 1;
-}
-
-=head1 AUTHOR
-
-Please report bugs using L<http://rt.cpan.org>.
-
-Marek Rouchal E<lt>marekr@cpan.orgE<gt>,
-heavily borrowing code from Nick Ing-Simmons' PodToHtml.
-
-Tim Jenness E<lt>t.jenness@jach.hawaii.eduE<gt> provided
-C<pod_where> and C<contains_pod>.
-
-B<Pod::Find> is part of the L<Pod::Parser> distribution.
-
-=head1 SEE ALSO
-
-L<Pod::Parser>, L<Pod::Checker>, L<perldoc>
-
-=cut
-
-1;
-
diff --git a/Master/tlpkg/tlperl/lib/Pod/Html.pm b/Master/tlpkg/tlperl/lib/Pod/Html.pm
index 64cf376f3c9..71555e723ca 100644
--- a/Master/tlpkg/tlperl/lib/Pod/Html.pm
+++ b/Master/tlpkg/tlperl/lib/Pod/Html.pm
@@ -2,7 +2,7 @@ package Pod::Html;
use strict;
require Exporter;
-our $VERSION = 1.24;
+our $VERSION = 1.25;
our @ISA = qw(Exporter);
our @EXPORT = qw(pod2html htmlify);
our @EXPORT_OK = qw(anchorify relativize_url);
@@ -766,22 +766,29 @@ sub resolve_pod_page_link {
push @matches, $modname if $modname =~ /::\Q$to\E\z/;
}
+ # make it look like a path instead of a namespace
+ my $modloc = File::Spec->catfile(split(/::/, $to));
+
if ($#matches == -1) {
- warn "Cannot find \"$to\" in podpath: " .
- "cannot find suitable replacement path, cannot resolve link\n"
- unless $self->quiet;
+ warn "Cannot find file \"$modloc.*\" directly under podpath, " .
+ "cannot find suitable replacement: link remains unresolved.\n"
+ if $self->verbose;
return '';
} elsif ($#matches == 0) {
- warn "Cannot find \"$to\" in podpath: " .
- "using $matches[0] as replacement path to $to\n"
- unless $self->quiet;
$path = $self->pages->{$matches[0]};
+ my $matchloc = File::Spec->catfile(split(/::/, $path));
+ warn "Cannot find file \"$modloc.*\" directly under podpath, but ".
+ "I did find \"$matchloc.*\", so I'll assume that is what you ".
+ "meant to link to.\n"
+ if $self->verbose;
} else {
- warn "Cannot find \"$to\" in podpath: " .
- "more than one possible replacement path to $to, " .
- "using $matches[-1]\n" unless $self->quiet;
# Use [-1] so newer (higher numbered) perl PODs are used
+ # XXX currently, @matches isn't sorted so this is not true
$path = $self->pages->{$matches[-1]};
+ my $matchloc = File::Spec->catfile(split(/::/, $path));
+ warn "Cannot find file \"$modloc.*\" directly under podpath, but ".
+ "I did find \"$matchloc.*\" (among others), so I'll use that " .
+ "to resolve the link.\n" if $self->verbose;
}
} else {
$path = $self->pages->{$to};
diff --git a/Master/tlpkg/tlperl/lib/Pod/InputObjects.pm b/Master/tlpkg/tlperl/lib/Pod/InputObjects.pm
deleted file mode 100644
index c4d6fc24691..00000000000
--- a/Master/tlpkg/tlperl/lib/Pod/InputObjects.pm
+++ /dev/null
@@ -1,946 +0,0 @@
-#############################################################################
-# Pod/InputObjects.pm -- package which defines objects for input streams
-# and paragraphs and commands when parsing POD docs.
-#
-# Copyright (C) 1996-2000 by Bradford Appleton. All rights reserved.
-# This file is part of "PodParser". PodParser is free software;
-# you can redistribute it and/or modify it under the same terms
-# as Perl itself.
-#############################################################################
-
-package Pod::InputObjects;
-use strict;
-
-use vars qw($VERSION);
-$VERSION = '1.63'; ## Current version of this package
-require 5.005; ## requires this Perl version or later
-
-#############################################################################
-
-=head1 NAME
-
-Pod::InputObjects - objects representing POD input paragraphs, commands, etc.
-
-=head1 SYNOPSIS
-
- use Pod::InputObjects;
-
-=head1 REQUIRES
-
-perl5.004, Carp
-
-=head1 EXPORTS
-
-Nothing.
-
-=head1 DESCRIPTION
-
-B<NOTE: This module is considered legacy; modern Perl releases (5.18 and
-higher) are going to remove Pod-Parser from core and use L<Pod-Simple>
-for all things POD.>
-
-This module defines some basic input objects used by B<Pod::Parser> when
-reading and parsing POD text from an input source. The following objects
-are defined:
-
-=begin __PRIVATE__
-
-=over 4
-
-=item package B<Pod::InputSource>
-
-An object corresponding to a source of POD input text. It is mostly a
-wrapper around a filehandle or C<IO::Handle>-type object (or anything
-that implements the C<getline()> method) which keeps track of some
-additional information relevant to the parsing of PODs.
-
-=back
-
-=end __PRIVATE__
-
-=over 4
-
-=item package B<Pod::Paragraph>
-
-An object corresponding to a paragraph of POD input text. It may be a
-plain paragraph, a verbatim paragraph, or a command paragraph (see
-L<perlpod>).
-
-=item package B<Pod::InteriorSequence>
-
-An object corresponding to an interior sequence command from the POD
-input text (see L<perlpod>).
-
-=item package B<Pod::ParseTree>
-
-An object corresponding to a tree of parsed POD text. Each "node" in
-a parse-tree (or I<ptree>) is either a text-string or a reference to
-a B<Pod::InteriorSequence> object. The nodes appear in the parse-tree
-in the order in which they were parsed from left-to-right.
-
-=back
-
-Each of these input objects are described in further detail in the
-sections which follow.
-
-=cut
-
-#############################################################################
-
-package Pod::InputSource;
-
-##---------------------------------------------------------------------------
-
-=begin __PRIVATE__
-
-=head1 B<Pod::InputSource>
-
-This object corresponds to an input source or stream of POD
-documentation. When parsing PODs, it is necessary to associate and store
-certain context information with each input source. All of this
-information is kept together with the stream itself in one of these
-C<Pod::InputSource> objects. Each such object is merely a wrapper around
-an C<IO::Handle> object of some kind (or at least something that
-implements the C<getline()> method). They have the following
-methods/attributes:
-
-=end __PRIVATE__
-
-=cut
-
-##---------------------------------------------------------------------------
-
-=begin __PRIVATE__
-
-=head2 B<new()>
-
- my $pod_input1 = Pod::InputSource->new(-handle => $filehandle);
- my $pod_input2 = new Pod::InputSource(-handle => $filehandle,
- -name => $name);
- my $pod_input3 = new Pod::InputSource(-handle => \*STDIN);
- my $pod_input4 = Pod::InputSource->new(-handle => \*STDIN,
- -name => "(STDIN)");
-
-This is a class method that constructs a C<Pod::InputSource> object and
-returns a reference to the new input source object. It takes one or more
-keyword arguments in the form of a hash. The keyword C<-handle> is
-required and designates the corresponding input handle. The keyword
-C<-name> is optional and specifies the name associated with the input
-handle (typically a file name).
-
-=end __PRIVATE__
-
-=cut
-
-sub new {
- ## Determine if we were called via an object-ref or a classname
- my $this = shift;
- my $class = ref($this) || $this;
-
- ## Any remaining arguments are treated as initial values for the
- ## hash that is used to represent this object. Note that we default
- ## certain values by specifying them *before* the arguments passed.
- ## If they are in the argument list, they will override the defaults.
- my $self = { -name => '(unknown)',
- -handle => undef,
- -was_cutting => 0,
- @_ };
-
- ## Bless ourselves into the desired class and perform any initialization
- bless $self, $class;
- return $self;
-}
-
-##---------------------------------------------------------------------------
-
-=begin __PRIVATE__
-
-=head2 B<name()>
-
- my $filename = $pod_input->name();
- $pod_input->name($new_filename_to_use);
-
-This method gets/sets the name of the input source (usually a filename).
-If no argument is given, it returns a string containing the name of
-the input source; otherwise it sets the name of the input source to the
-contents of the given argument.
-
-=end __PRIVATE__
-
-=cut
-
-sub name {
- (@_ > 1) and $_[0]->{'-name'} = $_[1];
- return $_[0]->{'-name'};
-}
-
-## allow 'filename' as an alias for 'name'
-*filename = \&name;
-
-##---------------------------------------------------------------------------
-
-=begin __PRIVATE__
-
-=head2 B<handle()>
-
- my $handle = $pod_input->handle();
-
-Returns a reference to the handle object from which input is read (the
-one used to contructed this input source object).
-
-=end __PRIVATE__
-
-=cut
-
-sub handle {
- return $_[0]->{'-handle'};
-}
-
-##---------------------------------------------------------------------------
-
-=begin __PRIVATE__
-
-=head2 B<was_cutting()>
-
- print "Yes.\n" if ($pod_input->was_cutting());
-
-The value of the C<cutting> state (that the B<cutting()> method would
-have returned) immediately before any input was read from this input
-stream. After all input from this stream has been read, the C<cutting>
-state is restored to this value.
-
-=end __PRIVATE__
-
-=cut
-
-sub was_cutting {
- (@_ > 1) and $_[0]->{-was_cutting} = $_[1];
- return $_[0]->{-was_cutting};
-}
-
-##---------------------------------------------------------------------------
-
-#############################################################################
-
-package Pod::Paragraph;
-
-##---------------------------------------------------------------------------
-
-=head1 B<Pod::Paragraph>
-
-An object representing a paragraph of POD input text.
-It has the following methods/attributes:
-
-=cut
-
-##---------------------------------------------------------------------------
-
-=head2 Pod::Paragraph-E<gt>B<new()>
-
- my $pod_para1 = Pod::Paragraph->new(-text => $text);
- my $pod_para2 = Pod::Paragraph->new(-name => $cmd,
- -text => $text);
- my $pod_para3 = new Pod::Paragraph(-text => $text);
- my $pod_para4 = new Pod::Paragraph(-name => $cmd,
- -text => $text);
- my $pod_para5 = Pod::Paragraph->new(-name => $cmd,
- -text => $text,
- -file => $filename,
- -line => $line_number);
-
-This is a class method that constructs a C<Pod::Paragraph> object and
-returns a reference to the new paragraph object. It may be given one or
-two keyword arguments. The C<-text> keyword indicates the corresponding
-text of the POD paragraph. The C<-name> keyword indicates the name of
-the corresponding POD command, such as C<head1> or C<item> (it should
-I<not> contain the C<=> prefix); this is needed only if the POD
-paragraph corresponds to a command paragraph. The C<-file> and C<-line>
-keywords indicate the filename and line number corresponding to the
-beginning of the paragraph
-
-=cut
-
-sub new {
- ## Determine if we were called via an object-ref or a classname
- my $this = shift;
- my $class = ref($this) || $this;
-
- ## Any remaining arguments are treated as initial values for the
- ## hash that is used to represent this object. Note that we default
- ## certain values by specifying them *before* the arguments passed.
- ## If they are in the argument list, they will override the defaults.
- my $self = {
- -name => undef,
- -text => (@_ == 1) ? shift : undef,
- -file => '<unknown-file>',
- -line => 0,
- -prefix => '=',
- -separator => ' ',
- -ptree => [],
- @_
- };
-
- ## Bless ourselves into the desired class and perform any initialization
- bless $self, $class;
- return $self;
-}
-
-##---------------------------------------------------------------------------
-
-=head2 $pod_para-E<gt>B<cmd_name()>
-
- my $para_cmd = $pod_para->cmd_name();
-
-If this paragraph is a command paragraph, then this method will return
-the name of the command (I<without> any leading C<=> prefix).
-
-=cut
-
-sub cmd_name {
- (@_ > 1) and $_[0]->{'-name'} = $_[1];
- return $_[0]->{'-name'};
-}
-
-## let name() be an alias for cmd_name()
-*name = \&cmd_name;
-
-##---------------------------------------------------------------------------
-
-=head2 $pod_para-E<gt>B<text()>
-
- my $para_text = $pod_para->text();
-
-This method will return the corresponding text of the paragraph.
-
-=cut
-
-sub text {
- (@_ > 1) and $_[0]->{'-text'} = $_[1];
- return $_[0]->{'-text'};
-}
-
-##---------------------------------------------------------------------------
-
-=head2 $pod_para-E<gt>B<raw_text()>
-
- my $raw_pod_para = $pod_para->raw_text();
-
-This method will return the I<raw> text of the POD paragraph, exactly
-as it appeared in the input.
-
-=cut
-
-sub raw_text {
- return $_[0]->{'-text'} unless (defined $_[0]->{'-name'});
- return $_[0]->{'-prefix'} . $_[0]->{'-name'} .
- $_[0]->{'-separator'} . $_[0]->{'-text'};
-}
-
-##---------------------------------------------------------------------------
-
-=head2 $pod_para-E<gt>B<cmd_prefix()>
-
- my $prefix = $pod_para->cmd_prefix();
-
-If this paragraph is a command paragraph, then this method will return
-the prefix used to denote the command (which should be the string "="
-or "==").
-
-=cut
-
-sub cmd_prefix {
- return $_[0]->{'-prefix'};
-}
-
-##---------------------------------------------------------------------------
-
-=head2 $pod_para-E<gt>B<cmd_separator()>
-
- my $separator = $pod_para->cmd_separator();
-
-If this paragraph is a command paragraph, then this method will return
-the text used to separate the command name from the rest of the
-paragraph (if any).
-
-=cut
-
-sub cmd_separator {
- return $_[0]->{'-separator'};
-}
-
-##---------------------------------------------------------------------------
-
-=head2 $pod_para-E<gt>B<parse_tree()>
-
- my $ptree = $pod_parser->parse_text( $pod_para->text() );
- $pod_para->parse_tree( $ptree );
- $ptree = $pod_para->parse_tree();
-
-This method will get/set the corresponding parse-tree of the paragraph's text.
-
-=cut
-
-sub parse_tree {
- (@_ > 1) and $_[0]->{'-ptree'} = $_[1];
- return $_[0]->{'-ptree'};
-}
-
-## let ptree() be an alias for parse_tree()
-*ptree = \&parse_tree;
-
-##---------------------------------------------------------------------------
-
-=head2 $pod_para-E<gt>B<file_line()>
-
- my ($filename, $line_number) = $pod_para->file_line();
- my $position = $pod_para->file_line();
-
-Returns the current filename and line number for the paragraph
-object. If called in a list context, it returns a list of two
-elements: first the filename, then the line number. If called in
-a scalar context, it returns a string containing the filename, followed
-by a colon (':'), followed by the line number.
-
-=cut
-
-sub file_line {
- my @loc = ($_[0]->{'-file'} || '<unknown-file>',
- $_[0]->{'-line'} || 0);
- return (wantarray) ? @loc : join(':', @loc);
-}
-
-##---------------------------------------------------------------------------
-
-#############################################################################
-
-package Pod::InteriorSequence;
-
-##---------------------------------------------------------------------------
-
-=head1 B<Pod::InteriorSequence>
-
-An object representing a POD interior sequence command.
-It has the following methods/attributes:
-
-=cut
-
-##---------------------------------------------------------------------------
-
-=head2 Pod::InteriorSequence-E<gt>B<new()>
-
- my $pod_seq1 = Pod::InteriorSequence->new(-name => $cmd
- -ldelim => $delimiter);
- my $pod_seq2 = new Pod::InteriorSequence(-name => $cmd,
- -ldelim => $delimiter);
- my $pod_seq3 = new Pod::InteriorSequence(-name => $cmd,
- -ldelim => $delimiter,
- -file => $filename,
- -line => $line_number);
-
- my $pod_seq4 = new Pod::InteriorSequence(-name => $cmd, $ptree);
- my $pod_seq5 = new Pod::InteriorSequence($cmd, $ptree);
-
-This is a class method that constructs a C<Pod::InteriorSequence> object
-and returns a reference to the new interior sequence object. It should
-be given two keyword arguments. The C<-ldelim> keyword indicates the
-corresponding left-delimiter of the interior sequence (e.g. 'E<lt>').
-The C<-name> keyword indicates the name of the corresponding interior
-sequence command, such as C<I> or C<B> or C<C>. The C<-file> and
-C<-line> keywords indicate the filename and line number corresponding
-to the beginning of the interior sequence. If the C<$ptree> argument is
-given, it must be the last argument, and it must be either string, or
-else an array-ref suitable for passing to B<Pod::ParseTree::new> (or
-it may be a reference to a Pod::ParseTree object).
-
-=cut
-
-sub new {
- ## Determine if we were called via an object-ref or a classname
- my $this = shift;
- my $class = ref($this) || $this;
-
- ## See if first argument has no keyword
- if (((@_ <= 2) or (@_ % 2)) and $_[0] !~ /^-\w/) {
- ## Yup - need an implicit '-name' before first parameter
- unshift @_, '-name';
- }
-
- ## See if odd number of args
- if ((@_ % 2) != 0) {
- ## Yup - need an implicit '-ptree' before the last parameter
- splice @_, $#_, 0, '-ptree';
- }
-
- ## Any remaining arguments are treated as initial values for the
- ## hash that is used to represent this object. Note that we default
- ## certain values by specifying them *before* the arguments passed.
- ## If they are in the argument list, they will override the defaults.
- my $self = {
- -name => (@_ == 1) ? $_[0] : undef,
- -file => '<unknown-file>',
- -line => 0,
- -ldelim => '<',
- -rdelim => '>',
- @_
- };
-
- ## Initialize contents if they haven't been already
- my $ptree = $self->{'-ptree'} || new Pod::ParseTree();
- if ( ref $ptree =~ /^(ARRAY)?$/ ) {
- ## We have an array-ref, or a normal scalar. Pass it as an
- ## an argument to the ptree-constructor
- $ptree = new Pod::ParseTree($1 ? [$ptree] : $ptree);
- }
- $self->{'-ptree'} = $ptree;
-
- ## Bless ourselves into the desired class and perform any initialization
- bless $self, $class;
- return $self;
-}
-
-##---------------------------------------------------------------------------
-
-=head2 $pod_seq-E<gt>B<cmd_name()>
-
- my $seq_cmd = $pod_seq->cmd_name();
-
-The name of the interior sequence command.
-
-=cut
-
-sub cmd_name {
- (@_ > 1) and $_[0]->{'-name'} = $_[1];
- return $_[0]->{'-name'};
-}
-
-## let name() be an alias for cmd_name()
-*name = \&cmd_name;
-
-##---------------------------------------------------------------------------
-
-## Private subroutine to set the parent pointer of all the given
-## children that are interior-sequences to be $self
-
-sub _set_child2parent_links {
- my ($self, @children) = @_;
- ## Make sure any sequences know who their parent is
- for (@children) {
- next unless (length and ref and ref ne 'SCALAR');
- if (UNIVERSAL::isa($_, 'Pod::InteriorSequence') or
- UNIVERSAL::can($_, 'nested'))
- {
- $_->nested($self);
- }
- }
-}
-
-## Private subroutine to unset child->parent links
-
-sub _unset_child2parent_links {
- my $self = shift;
- $self->{'-parent_sequence'} = undef;
- my $ptree = $self->{'-ptree'};
- for (@$ptree) {
- next unless (length and ref and ref ne 'SCALAR');
- $_->_unset_child2parent_links()
- if UNIVERSAL::isa($_, 'Pod::InteriorSequence');
- }
-}
-
-##---------------------------------------------------------------------------
-
-=head2 $pod_seq-E<gt>B<prepend()>
-
- $pod_seq->prepend($text);
- $pod_seq1->prepend($pod_seq2);
-
-Prepends the given string or parse-tree or sequence object to the parse-tree
-of this interior sequence.
-
-=cut
-
-sub prepend {
- my $self = shift;
- $self->{'-ptree'}->prepend(@_);
- _set_child2parent_links($self, @_);
- return $self;
-}
-
-##---------------------------------------------------------------------------
-
-=head2 $pod_seq-E<gt>B<append()>
-
- $pod_seq->append($text);
- $pod_seq1->append($pod_seq2);
-
-Appends the given string or parse-tree or sequence object to the parse-tree
-of this interior sequence.
-
-=cut
-
-sub append {
- my $self = shift;
- $self->{'-ptree'}->append(@_);
- _set_child2parent_links($self, @_);
- return $self;
-}
-
-##---------------------------------------------------------------------------
-
-=head2 $pod_seq-E<gt>B<nested()>
-
- $outer_seq = $pod_seq->nested || print "not nested";
-
-If this interior sequence is nested inside of another interior
-sequence, then the outer/parent sequence that contains it is
-returned. Otherwise C<undef> is returned.
-
-=cut
-
-sub nested {
- my $self = shift;
- (@_ == 1) and $self->{'-parent_sequence'} = shift;
- return $self->{'-parent_sequence'} || undef;
-}
-
-##---------------------------------------------------------------------------
-
-=head2 $pod_seq-E<gt>B<raw_text()>
-
- my $seq_raw_text = $pod_seq->raw_text();
-
-This method will return the I<raw> text of the POD interior sequence,
-exactly as it appeared in the input.
-
-=cut
-
-sub raw_text {
- my $self = shift;
- my $text = $self->{'-name'} . $self->{'-ldelim'};
- for ( $self->{'-ptree'}->children ) {
- $text .= (ref $_) ? $_->raw_text : $_;
- }
- $text .= $self->{'-rdelim'};
- return $text;
-}
-
-##---------------------------------------------------------------------------
-
-=head2 $pod_seq-E<gt>B<left_delimiter()>
-
- my $ldelim = $pod_seq->left_delimiter();
-
-The leftmost delimiter beginning the argument text to the interior
-sequence (should be "<").
-
-=cut
-
-sub left_delimiter {
- (@_ > 1) and $_[0]->{'-ldelim'} = $_[1];
- return $_[0]->{'-ldelim'};
-}
-
-## let ldelim() be an alias for left_delimiter()
-*ldelim = \&left_delimiter;
-
-##---------------------------------------------------------------------------
-
-=head2 $pod_seq-E<gt>B<right_delimiter()>
-
-The rightmost delimiter beginning the argument text to the interior
-sequence (should be ">").
-
-=cut
-
-sub right_delimiter {
- (@_ > 1) and $_[0]->{'-rdelim'} = $_[1];
- return $_[0]->{'-rdelim'};
-}
-
-## let rdelim() be an alias for right_delimiter()
-*rdelim = \&right_delimiter;
-
-##---------------------------------------------------------------------------
-
-=head2 $pod_seq-E<gt>B<parse_tree()>
-
- my $ptree = $pod_parser->parse_text($paragraph_text);
- $pod_seq->parse_tree( $ptree );
- $ptree = $pod_seq->parse_tree();
-
-This method will get/set the corresponding parse-tree of the interior
-sequence's text.
-
-=cut
-
-sub parse_tree {
- (@_ > 1) and $_[0]->{'-ptree'} = $_[1];
- return $_[0]->{'-ptree'};
-}
-
-## let ptree() be an alias for parse_tree()
-*ptree = \&parse_tree;
-
-##---------------------------------------------------------------------------
-
-=head2 $pod_seq-E<gt>B<file_line()>
-
- my ($filename, $line_number) = $pod_seq->file_line();
- my $position = $pod_seq->file_line();
-
-Returns the current filename and line number for the interior sequence
-object. If called in a list context, it returns a list of two
-elements: first the filename, then the line number. If called in
-a scalar context, it returns a string containing the filename, followed
-by a colon (':'), followed by the line number.
-
-=cut
-
-sub file_line {
- my @loc = ($_[0]->{'-file'} || '<unknown-file>',
- $_[0]->{'-line'} || 0);
- return (wantarray) ? @loc : join(':', @loc);
-}
-
-##---------------------------------------------------------------------------
-
-=head2 Pod::InteriorSequence::B<DESTROY()>
-
-This method performs any necessary cleanup for the interior-sequence.
-If you override this method then it is B<imperative> that you invoke
-the parent method from within your own method, otherwise
-I<interior-sequence storage will not be reclaimed upon destruction!>
-
-=cut
-
-sub DESTROY {
- ## We need to get rid of all child->parent pointers throughout the
- ## tree so their reference counts will go to zero and they can be
- ## garbage-collected
- _unset_child2parent_links(@_);
-}
-
-##---------------------------------------------------------------------------
-
-#############################################################################
-
-package Pod::ParseTree;
-
-##---------------------------------------------------------------------------
-
-=head1 B<Pod::ParseTree>
-
-This object corresponds to a tree of parsed POD text. As POD text is
-scanned from left to right, it is parsed into an ordered list of
-text-strings and B<Pod::InteriorSequence> objects (in order of
-appearance). A B<Pod::ParseTree> object corresponds to this list of
-strings and sequences. Each interior sequence in the parse-tree may
-itself contain a parse-tree (since interior sequences may be nested).
-
-=cut
-
-##---------------------------------------------------------------------------
-
-=head2 Pod::ParseTree-E<gt>B<new()>
-
- my $ptree1 = Pod::ParseTree->new;
- my $ptree2 = new Pod::ParseTree;
- my $ptree4 = Pod::ParseTree->new($array_ref);
- my $ptree3 = new Pod::ParseTree($array_ref);
-
-This is a class method that constructs a C<Pod::Parse_tree> object and
-returns a reference to the new parse-tree. If a single-argument is given,
-it must be a reference to an array, and is used to initialize the root
-(top) of the parse tree.
-
-=cut
-
-sub new {
- ## Determine if we were called via an object-ref or a classname
- my $this = shift;
- my $class = ref($this) || $this;
-
- my $self = (@_ == 1 and ref $_[0]) ? $_[0] : [];
-
- ## Bless ourselves into the desired class and perform any initialization
- bless $self, $class;
- return $self;
-}
-
-##---------------------------------------------------------------------------
-
-=head2 $ptree-E<gt>B<top()>
-
- my $top_node = $ptree->top();
- $ptree->top( $top_node );
- $ptree->top( @children );
-
-This method gets/sets the top node of the parse-tree. If no arguments are
-given, it returns the topmost node in the tree (the root), which is also
-a B<Pod::ParseTree>. If it is given a single argument that is a reference,
-then the reference is assumed to a parse-tree and becomes the new top node.
-Otherwise, if arguments are given, they are treated as the new list of
-children for the top node.
-
-=cut
-
-sub top {
- my $self = shift;
- if (@_ > 0) {
- @{ $self } = (@_ == 1 and ref $_[0]) ? ${ @_ } : @_;
- }
- return $self;
-}
-
-## let parse_tree() & ptree() be aliases for the 'top' method
-*parse_tree = *ptree = \&top;
-
-##---------------------------------------------------------------------------
-
-=head2 $ptree-E<gt>B<children()>
-
-This method gets/sets the children of the top node in the parse-tree.
-If no arguments are given, it returns the list (array) of children
-(each of which should be either a string or a B<Pod::InteriorSequence>.
-Otherwise, if arguments are given, they are treated as the new list of
-children for the top node.
-
-=cut
-
-sub children {
- my $self = shift;
- if (@_ > 0) {
- @{ $self } = (@_ == 1 and ref $_[0]) ? ${ @_ } : @_;
- }
- return @{ $self };
-}
-
-##---------------------------------------------------------------------------
-
-=head2 $ptree-E<gt>B<prepend()>
-
-This method prepends the given text or parse-tree to the current parse-tree.
-If the first item on the parse-tree is text and the argument is also text,
-then the text is prepended to the first item (not added as a separate string).
-Otherwise the argument is added as a new string or parse-tree I<before>
-the current one.
-
-=cut
-
-use vars qw(@ptree); ## an alias used for performance reasons
-
-sub prepend {
- my $self = shift;
- local *ptree = $self;
- for (@_) {
- next unless length;
- if (@ptree && !(ref $ptree[0]) && !(ref $_)) {
- $ptree[0] = $_ . $ptree[0];
- }
- else {
- unshift @ptree, $_;
- }
- }
-}
-
-##---------------------------------------------------------------------------
-
-=head2 $ptree-E<gt>B<append()>
-
-This method appends the given text or parse-tree to the current parse-tree.
-If the last item on the parse-tree is text and the argument is also text,
-then the text is appended to the last item (not added as a separate string).
-Otherwise the argument is added as a new string or parse-tree I<after>
-the current one.
-
-=cut
-
-sub append {
- my $self = shift;
- local *ptree = $self;
- my $can_append = @ptree && !(ref $ptree[-1]);
- for (@_) {
- if (ref) {
- push @ptree, $_;
- }
- elsif(!length) {
- next;
- }
- elsif ($can_append) {
- $ptree[-1] .= $_;
- }
- else {
- push @ptree, $_;
- }
- }
-}
-
-=head2 $ptree-E<gt>B<raw_text()>
-
- my $ptree_raw_text = $ptree->raw_text();
-
-This method will return the I<raw> text of the POD parse-tree
-exactly as it appeared in the input.
-
-=cut
-
-sub raw_text {
- my $self = shift;
- my $text = '';
- for ( @$self ) {
- $text .= (ref $_) ? $_->raw_text : $_;
- }
- return $text;
-}
-
-##---------------------------------------------------------------------------
-
-## Private routines to set/unset child->parent links
-
-sub _unset_child2parent_links {
- my $self = shift;
- local *ptree = $self;
- for (@ptree) {
- next unless (defined and length and ref and ref ne 'SCALAR');
- $_->_unset_child2parent_links()
- if UNIVERSAL::isa($_, 'Pod::InteriorSequence');
- }
-}
-
-sub _set_child2parent_links {
- ## nothing to do, Pod::ParseTrees cant have parent pointers
-}
-
-=head2 Pod::ParseTree::B<DESTROY()>
-
-This method performs any necessary cleanup for the parse-tree.
-If you override this method then it is B<imperative>
-that you invoke the parent method from within your own method,
-otherwise I<parse-tree storage will not be reclaimed upon destruction!>
-
-=cut
-
-sub DESTROY {
- ## We need to get rid of all child->parent pointers throughout the
- ## tree so their reference counts will go to zero and they can be
- ## garbage-collected
- _unset_child2parent_links(@_);
-}
-
-#############################################################################
-
-=head1 SEE ALSO
-
-B<Pod::InputObjects> is part of the L<Pod::Parser> distribution.
-
-See L<Pod::Parser>, L<Pod::Select>
-
-=head1 AUTHOR
-
-Please report bugs using L<http://rt.cpan.org>.
-
-Brad Appleton E<lt>bradapp@enteract.comE<gt>
-
-=cut
-
-1;
diff --git a/Master/tlpkg/tlperl/lib/Pod/Man.pm b/Master/tlpkg/tlperl/lib/Pod/Man.pm
index 6ebab1e0e5c..d7c029357a2 100644
--- a/Master/tlpkg/tlperl/lib/Pod/Man.pm
+++ b/Master/tlpkg/tlperl/lib/Pod/Man.pm
@@ -14,7 +14,7 @@
package Pod::Man;
-use 5.006;
+use 5.008;
use strict;
use warnings;
@@ -24,7 +24,9 @@ use vars qw(@ISA %ESCAPES $PREAMBLE $VERSION);
use Carp qw(carp croak);
use Pod::Simple ();
-# Conditionally import Encode and set $HAS_ENCODE if it is available.
+# Conditionally import Encode and set $HAS_ENCODE if it is available. This is
+# required to support building as part of Perl core, since podlators is built
+# before Encode is.
our $HAS_ENCODE;
BEGIN {
$HAS_ENCODE = eval { require Encode };
@@ -32,7 +34,7 @@ BEGIN {
@ISA = qw(Pod::Simple);
-$VERSION = '4.11';
+$VERSION = '4.14';
# Set the debugging level. If someone has inserted a debug function into this
# class already, use that. Otherwise, use any Pod::Simple debug function
@@ -245,13 +247,8 @@ sub init_quotes {
sub init_page {
my ($self) = @_;
- # We used to try first to get the version number from a local binary, but
- # we shouldn't need that any more. Get the version from the running Perl.
- # Work a little magic to handle subversions correctly under both the
- # pre-5.6 and the post-5.6 version numbering schemes.
- my @version = ($] =~ /^(\d+)\.(\d{3})(\d{0,3})$/);
- $version[2] ||= 0;
- $version[2] *= 10 ** (3 - length $version[2]);
+ # Get the version from the running Perl.
+ my @version = ($] =~ /^(\d+)\.(\d{3})(\d+)$/);
for (@version) { $_ += 0 }
my $version = join ('.', @version);
@@ -799,7 +796,7 @@ sub start_document {
eval {
my @options = (output => 1, details => 1);
my @layers = PerlIO::get_layers (*{$$self{output_fh}}, @options);
- if ($layers[-1] & PerlIO::F_UTF8 ()) {
+ if ($layers[-1] && ($layers[-1] & PerlIO::F_UTF8 ())) {
$$self{ENCODE} = 0;
}
}
@@ -1881,7 +1878,9 @@ being the file to write the formatted output to.
You can also call parse_lines() to parse an array of lines or
parse_string_document() to parse a document already in memory. As with
parse_file(), parse_lines() and parse_string_document() default to sending
-their output to C<STDOUT> unless changed with the output_fh() method.
+their output to C<STDOUT> unless changed with the output_fh() method. Be
+aware that parse_lines() and parse_string_document() both expect raw bytes,
+not decoded characters.
To put the output from any parse method into a string instead of a file
handle, call the output_string() method instead of output_fh().
@@ -2012,7 +2011,7 @@ are mine).
=head1 COPYRIGHT AND LICENSE
-Copyright 1999-2010, 2012-2018 Russ Allbery <rra@cpan.org>
+Copyright 1999-2010, 2012-2019 Russ Allbery <rra@cpan.org>
Substantial contributions by Sean Burke <sburke@cpan.org>.
diff --git a/Master/tlpkg/tlperl/lib/Pod/ParseLink.pm b/Master/tlpkg/tlperl/lib/Pod/ParseLink.pm
index 0be5323973b..273c95847ac 100644
--- a/Master/tlpkg/tlperl/lib/Pod/ParseLink.pm
+++ b/Master/tlpkg/tlperl/lib/Pod/ParseLink.pm
@@ -13,7 +13,7 @@
package Pod::ParseLink;
-use 5.006;
+use 5.008;
use strict;
use warnings;
@@ -23,7 +23,7 @@ use Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(parselink);
-$VERSION = '4.11';
+$VERSION = '4.14';
##############################################################################
# Implementation
@@ -167,11 +167,11 @@ L<perlpodspec> for more information.
=head1 AUTHOR
-Russ Allbery <rra@cpan.org>.
+Russ Allbery <rra@cpan.org>
=head1 COPYRIGHT AND LICENSE
-Copyright 2001, 2008, 2009, 2014, 2018 Russ Allbery <rra@cpan.org>
+Copyright 2001, 2008, 2009, 2014, 2018-2019 Russ Allbery <rra@cpan.org>
This program is free software; you may redistribute it and/or modify it
under the same terms as Perl itself.
diff --git a/Master/tlpkg/tlperl/lib/Pod/ParseUtils.pm b/Master/tlpkg/tlperl/lib/Pod/ParseUtils.pm
deleted file mode 100644
index 2afd0cd420e..00000000000
--- a/Master/tlpkg/tlperl/lib/Pod/ParseUtils.pm
+++ /dev/null
@@ -1,861 +0,0 @@
-#############################################################################
-# Pod/ParseUtils.pm -- helpers for POD parsing and conversion
-#
-# Copyright (C) 1999-2000 by Marek Rouchal. All rights reserved.
-# This file is part of "PodParser". PodParser is free software;
-# you can redistribute it and/or modify it under the same terms
-# as Perl itself.
-#############################################################################
-
-package Pod::ParseUtils;
-use strict;
-
-use vars qw($VERSION);
-$VERSION = '1.63'; ## Current version of this package
-require 5.005; ## requires this Perl version or later
-
-=head1 NAME
-
-Pod::ParseUtils - helpers for POD parsing and conversion
-
-=head1 SYNOPSIS
-
- use Pod::ParseUtils;
-
- my $list = new Pod::List;
- my $link = Pod::Hyperlink->new('Pod::Parser');
-
-=head1 DESCRIPTION
-
-B<NOTE: This module is considered legacy; modern Perl releases (5.18 and
-higher) are going to remove Pod-Parser from core and use L<Pod-Simple>
-for all things POD.>
-
-B<Pod::ParseUtils> contains a few object-oriented helper packages for
-POD parsing and processing (i.e. in POD formatters and translators).
-
-=cut
-
-#-----------------------------------------------------------------------------
-# Pod::List
-#
-# class to hold POD list info (=over, =item, =back)
-#-----------------------------------------------------------------------------
-
-package Pod::List;
-
-use Carp;
-
-=head2 Pod::List
-
-B<Pod::List> can be used to hold information about POD lists
-(written as =over ... =item ... =back) for further processing.
-The following methods are available:
-
-=over 4
-
-=item Pod::List-E<gt>new()
-
-Create a new list object. Properties may be specified through a hash
-reference like this:
-
- my $list = Pod::List->new({ -start => $., -indent => 4 });
-
-See the individual methods/properties for details.
-
-=cut
-
-sub new {
- my $this = shift;
- my $class = ref($this) || $this;
- my %params = @_;
- my $self = {%params};
- bless $self, $class;
- $self->initialize();
- return $self;
-}
-
-sub initialize {
- my $self = shift;
- $self->{-file} ||= 'unknown';
- $self->{-start} ||= 'unknown';
- $self->{-indent} ||= 4; # perlpod: "should be the default"
- $self->{_items} = [];
- $self->{-type} ||= '';
-}
-
-=item $list-E<gt>file()
-
-Without argument, retrieves the file name the list is in. This must
-have been set before by either specifying B<-file> in the B<new()>
-method or by calling the B<file()> method with a scalar argument.
-
-=cut
-
-# The POD file name the list appears in
-sub file {
- return (@_ > 1) ? ($_[0]->{-file} = $_[1]) : $_[0]->{-file};
-}
-
-=item $list-E<gt>start()
-
-Without argument, retrieves the line number where the list started.
-This must have been set before by either specifying B<-start> in the
-B<new()> method or by calling the B<start()> method with a scalar
-argument.
-
-=cut
-
-# The line in the file the node appears
-sub start {
- return (@_ > 1) ? ($_[0]->{-start} = $_[1]) : $_[0]->{-start};
-}
-
-=item $list-E<gt>indent()
-
-Without argument, retrieves the indent level of the list as specified
-in C<=over n>. This must have been set before by either specifying
-B<-indent> in the B<new()> method or by calling the B<indent()> method
-with a scalar argument.
-
-=cut
-
-# indent level
-sub indent {
- return (@_ > 1) ? ($_[0]->{-indent} = $_[1]) : $_[0]->{-indent};
-}
-
-=item $list-E<gt>type()
-
-Without argument, retrieves the list type, which can be an arbitrary value,
-e.g. C<OL>, C<UL>, ... when thinking the HTML way.
-This must have been set before by either specifying
-B<-type> in the B<new()> method or by calling the B<type()> method
-with a scalar argument.
-
-=cut
-
-# The type of the list (UL, OL, ...)
-sub type {
- return (@_ > 1) ? ($_[0]->{-type} = $_[1]) : $_[0]->{-type};
-}
-
-=item $list-E<gt>rx()
-
-Without argument, retrieves a regular expression for simplifying the
-individual item strings once the list type has been determined. Usage:
-E.g. when converting to HTML, one might strip the leading number in
-an ordered list as C<E<lt>OLE<gt>> already prints numbers itself.
-This must have been set before by either specifying
-B<-rx> in the B<new()> method or by calling the B<rx()> method
-with a scalar argument.
-
-=cut
-
-# The regular expression to simplify the items
-sub rx {
- return (@_ > 1) ? ($_[0]->{-rx} = $_[1]) : $_[0]->{-rx};
-}
-
-=item $list-E<gt>item()
-
-Without argument, retrieves the array of the items in this list.
-The items may be represented by any scalar.
-If an argument has been given, it is pushed on the list of items.
-
-=cut
-
-# The individual =items of this list
-sub item {
- my ($self,$item) = @_;
- if(defined $item) {
- push(@{$self->{_items}}, $item);
- return $item;
- }
- else {
- return @{$self->{_items}};
- }
-}
-
-=item $list-E<gt>parent()
-
-Without argument, retrieves information about the parent holding this
-list, which is represented as an arbitrary scalar.
-This must have been set before by either specifying
-B<-parent> in the B<new()> method or by calling the B<parent()> method
-with a scalar argument.
-
-=cut
-
-# possibility for parsers/translators to store information about the
-# lists's parent object
-sub parent {
- return (@_ > 1) ? ($_[0]->{-parent} = $_[1]) : $_[0]->{-parent};
-}
-
-=item $list-E<gt>tag()
-
-Without argument, retrieves information about the list tag, which can be
-any scalar.
-This must have been set before by either specifying
-B<-tag> in the B<new()> method or by calling the B<tag()> method
-with a scalar argument.
-
-=back
-
-=cut
-
-# possibility for parsers/translators to store information about the
-# list's object
-sub tag {
- return (@_ > 1) ? ($_[0]->{-tag} = $_[1]) : $_[0]->{-tag};
-}
-
-#-----------------------------------------------------------------------------
-# Pod::Hyperlink
-#
-# class to manipulate POD hyperlinks (L<>)
-#-----------------------------------------------------------------------------
-
-package Pod::Hyperlink;
-
-=head2 Pod::Hyperlink
-
-B<Pod::Hyperlink> is a class for manipulation of POD hyperlinks. Usage:
-
- my $link = Pod::Hyperlink->new('alternative text|page/"section in page"');
-
-The B<Pod::Hyperlink> class is mainly designed to parse the contents of the
-C<LE<lt>...E<gt>> sequence, providing a simple interface for accessing the
-different parts of a POD hyperlink for further processing. It can also be
-used to construct hyperlinks.
-
-=over 4
-
-=item Pod::Hyperlink-E<gt>new()
-
-The B<new()> method can either be passed a set of key/value pairs or a single
-scalar value, namely the contents of a C<LE<lt>...E<gt>> sequence. An object
-of the class C<Pod::Hyperlink> is returned. The value C<undef> indicates a
-failure, the error message is stored in C<$@>.
-
-=cut
-
-use Carp;
-
-sub new {
- my $this = shift;
- my $class = ref($this) || $this;
- my $self = +{};
- bless $self, $class;
- $self->initialize();
- if(defined $_[0]) {
- if(ref($_[0])) {
- # called with a list of parameters
- %$self = %{$_[0]};
- $self->_construct_text();
- }
- else {
- # called with L<> contents
- return unless($self->parse($_[0]));
- }
- }
- return $self;
-}
-
-sub initialize {
- my $self = shift;
- $self->{-line} ||= 'undef';
- $self->{-file} ||= 'undef';
- $self->{-page} ||= '';
- $self->{-node} ||= '';
- $self->{-alttext} ||= '';
- $self->{-type} ||= 'undef';
- $self->{_warnings} = [];
-}
-
-=item $link-E<gt>parse($string)
-
-This method can be used to (re)parse a (new) hyperlink, i.e. the contents
-of a C<LE<lt>...E<gt>> sequence. The result is stored in the current object.
-Warnings are stored in the B<warnings> property.
-E.g. sections like C<LE<lt>open(2)E<gt>> are deprecated, as they do not point
-to Perl documents. C<LE<lt>DBI::foo(3p)E<gt>> is wrong as well, the manpage
-section can simply be dropped.
-
-=cut
-
-sub parse {
- my $self = shift;
- local($_) = $_[0];
- # syntax check the link and extract destination
- my ($alttext,$page,$node,$type,$quoted) = (undef,'','','',0);
-
- $self->{_warnings} = [];
-
- # collapse newlines with whitespace
- s/\s*\n+\s*/ /g;
-
- # strip leading/trailing whitespace
- if(s/^[\s\n]+//) {
- $self->warning('ignoring leading whitespace in link');
- }
- if(s/[\s\n]+$//) {
- $self->warning('ignoring trailing whitespace in link');
- }
- unless(length($_)) {
- _invalid_link('empty link');
- return;
- }
-
- ## Check for different possibilities. This is tedious and error-prone
- # we match all possibilities (alttext, page, section/item)
- #warn "DEBUG: link=$_\n";
-
- # only page
- # problem: a lot of people use (), or (1) or the like to indicate
- # man page sections. But this collides with L<func()> that is supposed
- # to point to an internal function...
- my $page_rx = '[\w.-]+(?:::[\w.-]+)*(?:[(](?:\d\w*|)[)]|)';
- # page name only
- if(/^($page_rx)$/o) {
- $page = $1;
- $type = 'page';
- }
- # alttext, page and "section"
- elsif(m{^(.*?)\s*[|]\s*($page_rx)\s*/\s*"(.+)"$}o) {
- ($alttext, $page, $node) = ($1, $2, $3);
- $type = 'section';
- $quoted = 1; #... therefore | and / are allowed
- }
- # alttext and page
- elsif(/^(.*?)\s*[|]\s*($page_rx)$/o) {
- ($alttext, $page) = ($1, $2);
- $type = 'page';
- }
- # alttext and "section"
- elsif(m{^(.*?)\s*[|]\s*(?:/\s*|)"(.+)"$}) {
- ($alttext, $node) = ($1,$2);
- $type = 'section';
- $quoted = 1;
- }
- # page and "section"
- elsif(m{^($page_rx)\s*/\s*"(.+)"$}o) {
- ($page, $node) = ($1, $2);
- $type = 'section';
- $quoted = 1;
- }
- # page and item
- elsif(m{^($page_rx)\s*/\s*(.+)$}o) {
- ($page, $node) = ($1, $2);
- $type = 'item';
- }
- # only "section"
- elsif(m{^/?"(.+)"$}) {
- $node = $1;
- $type = 'section';
- $quoted = 1;
- }
- # only item
- elsif(m{^\s*/(.+)$}) {
- $node = $1;
- $type = 'item';
- }
-
- # non-standard: Hyperlink with alt-text - doesn't remove protocol prefix, maybe it should?
- elsif(/^ \s* (.*?) \s* [|] \s* (\w+:[^:\s] [^\s|]*?) \s* $/ix) {
- ($alttext,$node) = ($1,$2);
- $type = 'hyperlink';
- }
-
- # non-standard: Hyperlink
- elsif(/^(\w+:[^:\s]\S*)$/i) {
- $node = $1;
- $type = 'hyperlink';
- }
- # alttext, page and item
- elsif(m{^(.*?)\s*[|]\s*($page_rx)\s*/\s*(.+)$}o) {
- ($alttext, $page, $node) = ($1, $2, $3);
- $type = 'item';
- }
- # alttext and item
- elsif(m{^(.*?)\s*[|]\s*/(.+)$}) {
- ($alttext, $node) = ($1,$2);
- }
- # must be an item or a "malformed" section (without "")
- else {
- $node = $_;
- $type = 'item';
- }
- # collapse whitespace in nodes
- $node =~ s/\s+/ /gs;
-
- # empty alternative text expands to node name
- if(defined $alttext) {
- if(!length($alttext)) {
- $alttext = $node || $page;
- }
- }
- else {
- $alttext = '';
- }
-
- if($page =~ /[(]\w*[)]$/) {
- $self->warning("(section) in '$page' deprecated");
- }
- if(!$quoted && $node =~ m{[|/]} && $type ne 'hyperlink') {
- $self->warning("node '$node' contains non-escaped | or /");
- }
- if($alttext =~ m{[|/]}) {
- $self->warning("alternative text '$node' contains non-escaped | or /");
- }
- $self->{-page} = $page;
- $self->{-node} = $node;
- $self->{-alttext} = $alttext;
- #warn "DEBUG: page=$page section=$section item=$item alttext=$alttext\n";
- $self->{-type} = $type;
- $self->_construct_text();
- 1;
-}
-
-sub _construct_text {
- my $self = shift;
- my $alttext = $self->alttext();
- my $type = $self->type();
- my $section = $self->node();
- my $page = $self->page();
- my $page_ext = '';
- $page =~ s/([(]\w*[)])$// && ($page_ext = $1);
- if($alttext) {
- $self->{_text} = $alttext;
- }
- elsif($type eq 'hyperlink') {
- $self->{_text} = $section;
- }
- else {
- $self->{_text} = ($section || '') .
- (($page && $section) ? ' in ' : '') .
- "$page$page_ext";
- }
- # for being marked up later
- # use the non-standard markers P<> and Q<>, so that the resulting
- # text can be parsed by the translators. It's their job to put
- # the correct hypertext around the linktext
- if($alttext) {
- $self->{_markup} = "Q<$alttext>";
- }
- elsif($type eq 'hyperlink') {
- $self->{_markup} = "Q<$section>";
- }
- else {
- $self->{_markup} = (!$section ? '' : "Q<$section>") .
- ($page ? ($section ? ' in ':'') . "P<$page>$page_ext" : '');
- }
-}
-
-=item $link-E<gt>markup($string)
-
-Set/retrieve the textual value of the link. This string contains special
-markers C<PE<lt>E<gt>> and C<QE<lt>E<gt>> that should be expanded by the
-translator's interior sequence expansion engine to the
-formatter-specific code to highlight/activate the hyperlink. The details
-have to be implemented in the translator.
-
-=cut
-
-#' retrieve/set markuped text
-sub markup {
- return (@_ > 1) ? ($_[0]->{_markup} = $_[1]) : $_[0]->{_markup};
-}
-
-=item $link-E<gt>text()
-
-This method returns the textual representation of the hyperlink as above,
-but without markers (read only). Depending on the link type this is one of
-the following alternatives (the + and * denote the portions of the text
-that are marked up):
-
- +perl+ L<perl>
- *$|* in +perlvar+ L<perlvar/$|>
- *OPTIONS* in +perldoc+ L<perldoc/"OPTIONS">
- *DESCRIPTION* L<"DESCRIPTION">
-
-=cut
-
-# The complete link's text
-sub text {
- return $_[0]->{_text};
-}
-
-=item $link-E<gt>warning()
-
-After parsing, this method returns any warnings encountered during the
-parsing process.
-
-=cut
-
-# Set/retrieve warnings
-sub warning {
- my $self = shift;
- if(@_) {
- push(@{$self->{_warnings}}, @_);
- return @_;
- }
- return @{$self->{_warnings}};
-}
-
-=item $link-E<gt>file()
-
-=item $link-E<gt>line()
-
-Just simple slots for storing information about the line and the file
-the link was encountered in. Has to be filled in manually.
-
-=cut
-
-# The line in the file the link appears
-sub line {
- return (@_ > 1) ? ($_[0]->{-line} = $_[1]) : $_[0]->{-line};
-}
-
-# The POD file name the link appears in
-sub file {
- return (@_ > 1) ? ($_[0]->{-file} = $_[1]) : $_[0]->{-file};
-}
-
-=item $link-E<gt>page()
-
-This method sets or returns the POD page this link points to.
-
-=cut
-
-# The POD page the link appears on
-sub page {
- if (@_ > 1) {
- $_[0]->{-page} = $_[1];
- $_[0]->_construct_text();
- }
- return $_[0]->{-page};
-}
-
-=item $link-E<gt>node()
-
-As above, but the destination node text of the link.
-
-=cut
-
-# The link destination
-sub node {
- if (@_ > 1) {
- $_[0]->{-node} = $_[1];
- $_[0]->_construct_text();
- }
- return $_[0]->{-node};
-}
-
-=item $link-E<gt>alttext()
-
-Sets or returns an alternative text specified in the link.
-
-=cut
-
-# Potential alternative text
-sub alttext {
- if (@_ > 1) {
- $_[0]->{-alttext} = $_[1];
- $_[0]->_construct_text();
- }
- return $_[0]->{-alttext};
-}
-
-=item $link-E<gt>type()
-
-The node type, either C<section> or C<item>. As an unofficial type,
-there is also C<hyperlink>, derived from e.g. C<LE<lt>http://perl.comE<gt>>
-
-=cut
-
-# The type: item or headn
-sub type {
- return (@_ > 1) ? ($_[0]->{-type} = $_[1]) : $_[0]->{-type};
-}
-
-=item $link-E<gt>link()
-
-Returns the link as contents of C<LE<lt>E<gt>>. Reciprocal to B<parse()>.
-
-=back
-
-=cut
-
-# The link itself
-sub link {
- my $self = shift;
- my $link = $self->page() || '';
- if($self->node()) {
- my $node = $self->node();
- $node =~ s/\|/E<verbar>/g;
- $node =~ s{/}{E<sol>}g;
- if($self->type() eq 'section') {
- $link .= ($link ? '/' : '') . '"' . $node . '"';
- }
- elsif($self->type() eq 'hyperlink') {
- $link = $self->node();
- }
- else { # item
- $link .= '/' . $node;
- }
- }
- if($self->alttext()) {
- my $text = $self->alttext();
- $text =~ s/\|/E<verbar>/g;
- $text =~ s{/}{E<sol>}g;
- $link = "$text|$link";
- }
- return $link;
-}
-
-sub _invalid_link {
- my ($msg) = @_;
- # this sets @_
- #eval { die "$msg\n" };
- #chomp $@;
- $@ = $msg; # this seems to work, too!
- return;
-}
-
-#-----------------------------------------------------------------------------
-# Pod::Cache
-#
-# class to hold POD page details
-#-----------------------------------------------------------------------------
-
-package Pod::Cache;
-
-=head2 Pod::Cache
-
-B<Pod::Cache> holds information about a set of POD documents,
-especially the nodes for hyperlinks.
-The following methods are available:
-
-=over 4
-
-=item Pod::Cache-E<gt>new()
-
-Create a new cache object. This object can hold an arbitrary number of
-POD documents of class Pod::Cache::Item.
-
-=cut
-
-sub new {
- my $this = shift;
- my $class = ref($this) || $this;
- my $self = [];
- bless $self, $class;
- return $self;
-}
-
-=item $cache-E<gt>item()
-
-Add a new item to the cache. Without arguments, this method returns a
-list of all cache elements.
-
-=cut
-
-sub item {
- my ($self,%param) = @_;
- if(%param) {
- my $item = Pod::Cache::Item->new(%param);
- push(@$self, $item);
- return $item;
- }
- else {
- return @{$self};
- }
-}
-
-=item $cache-E<gt>find_page($name)
-
-Look for a POD document named C<$name> in the cache. Returns the
-reference to the corresponding Pod::Cache::Item object or undef if
-not found.
-
-=back
-
-=cut
-
-sub find_page {
- my ($self,$page) = @_;
- foreach(@$self) {
- if($_->page() eq $page) {
- return $_;
- }
- }
- return;
-}
-
-package Pod::Cache::Item;
-
-=head2 Pod::Cache::Item
-
-B<Pod::Cache::Item> holds information about individual POD documents,
-that can be grouped in a Pod::Cache object.
-It is intended to hold information about the hyperlink nodes of POD
-documents.
-The following methods are available:
-
-=over 4
-
-=item Pod::Cache::Item-E<gt>new()
-
-Create a new object.
-
-=cut
-
-sub new {
- my $this = shift;
- my $class = ref($this) || $this;
- my %params = @_;
- my $self = {%params};
- bless $self, $class;
- $self->initialize();
- return $self;
-}
-
-sub initialize {
- my $self = shift;
- $self->{-nodes} = [] unless(defined $self->{-nodes});
-}
-
-=item $cacheitem-E<gt>page()
-
-Set/retrieve the POD document name (e.g. "Pod::Parser").
-
-=cut
-
-# The POD page
-sub page {
- return (@_ > 1) ? ($_[0]->{-page} = $_[1]) : $_[0]->{-page};
-}
-
-=item $cacheitem-E<gt>description()
-
-Set/retrieve the POD short description as found in the C<=head1 NAME>
-section.
-
-=cut
-
-# The POD description, taken out of NAME if present
-sub description {
- return (@_ > 1) ? ($_[0]->{-description} = $_[1]) : $_[0]->{-description};
-}
-
-=item $cacheitem-E<gt>path()
-
-Set/retrieve the POD file storage path.
-
-=cut
-
-# The file path
-sub path {
- return (@_ > 1) ? ($_[0]->{-path} = $_[1]) : $_[0]->{-path};
-}
-
-=item $cacheitem-E<gt>file()
-
-Set/retrieve the POD file name.
-
-=cut
-
-# The POD file name
-sub file {
- return (@_ > 1) ? ($_[0]->{-file} = $_[1]) : $_[0]->{-file};
-}
-
-=item $cacheitem-E<gt>nodes()
-
-Add a node (or a list of nodes) to the document's node list. Note that
-the order is kept, i.e. start with the first node and end with the last.
-If no argument is given, the current list of nodes is returned in the
-same order the nodes have been added.
-A node can be any scalar, but usually is a pair of node string and
-unique id for the C<find_node> method to work correctly.
-
-=cut
-
-# The POD nodes
-sub nodes {
- my ($self,@nodes) = @_;
- if(@nodes) {
- push(@{$self->{-nodes}}, @nodes);
- return @nodes;
- }
- else {
- return @{$self->{-nodes}};
- }
-}
-
-=item $cacheitem-E<gt>find_node($name)
-
-Look for a node or index entry named C<$name> in the object.
-Returns the unique id of the node (i.e. the second element of the array
-stored in the node array) or undef if not found.
-
-=cut
-
-sub find_node {
- my ($self,$node) = @_;
- my @search;
- push(@search, @{$self->{-nodes}}) if($self->{-nodes});
- push(@search, @{$self->{-idx}}) if($self->{-idx});
- foreach(@search) {
- if($_->[0] eq $node) {
- return $_->[1]; # id
- }
- }
- return;
-}
-
-=item $cacheitem-E<gt>idx()
-
-Add an index entry (or a list of them) to the document's index list. Note that
-the order is kept, i.e. start with the first node and end with the last.
-If no argument is given, the current list of index entries is returned in the
-same order the entries have been added.
-An index entry can be any scalar, but usually is a pair of string and
-unique id.
-
-=back
-
-=cut
-
-# The POD index entries
-sub idx {
- my ($self,@idx) = @_;
- if(@idx) {
- push(@{$self->{-idx}}, @idx);
- return @idx;
- }
- else {
- return @{$self->{-idx}};
- }
-}
-
-=head1 AUTHOR
-
-Please report bugs using L<http://rt.cpan.org>.
-
-Marek Rouchal E<lt>marekr@cpan.orgE<gt>, borrowing
-a lot of things from L<pod2man> and L<pod2roff> as well as other POD
-processing tools by Tom Christiansen, Brad Appleton and Russ Allbery.
-
-B<Pod::ParseUtils> is part of the L<Pod::Parser> distribution.
-
-=head1 SEE ALSO
-
-L<pod2man>, L<pod2roff>, L<Pod::Parser>, L<Pod::Checker>,
-L<pod2html>
-
-=cut
-
-1;
diff --git a/Master/tlpkg/tlperl/lib/Pod/Parser.pm b/Master/tlpkg/tlperl/lib/Pod/Parser.pm
deleted file mode 100644
index 63edcd2e197..00000000000
--- a/Master/tlpkg/tlperl/lib/Pod/Parser.pm
+++ /dev/null
@@ -1,1836 +0,0 @@
-#############################################################################
-# Pod/Parser.pm -- package which defines a base class for parsing POD docs.
-#
-# Copyright (C) 1996-2000 by Bradford Appleton. All rights reserved.
-# This file is part of "PodParser". PodParser is free software;
-# you can redistribute it and/or modify it under the same terms
-# as Perl itself.
-#############################################################################
-
-package Pod::Parser;
-use strict;
-
-## These "variables" are used as local "glob aliases" for performance
-use vars qw($VERSION @ISA %myData %myOpts @input_stack);
-$VERSION = '1.63'; ## Current version of this package
-require 5.005; ## requires this Perl version or later
-
-#############################################################################
-
-=head1 NAME
-
-Pod::Parser - base class for creating POD filters and translators
-
-=head1 SYNOPSIS
-
- use Pod::Parser;
-
- package MyParser;
- @ISA = qw(Pod::Parser);
-
- sub command {
- my ($parser, $command, $paragraph, $line_num) = @_;
- ## Interpret the command and its text; sample actions might be:
- if ($command eq 'head1') { ... }
- elsif ($command eq 'head2') { ... }
- ## ... other commands and their actions
- my $out_fh = $parser->output_handle();
- my $expansion = $parser->interpolate($paragraph, $line_num);
- print $out_fh $expansion;
- }
-
- sub verbatim {
- my ($parser, $paragraph, $line_num) = @_;
- ## Format verbatim paragraph; sample actions might be:
- my $out_fh = $parser->output_handle();
- print $out_fh $paragraph;
- }
-
- sub textblock {
- my ($parser, $paragraph, $line_num) = @_;
- ## Translate/Format this block of text; sample actions might be:
- my $out_fh = $parser->output_handle();
- my $expansion = $parser->interpolate($paragraph, $line_num);
- print $out_fh $expansion;
- }
-
- sub interior_sequence {
- my ($parser, $seq_command, $seq_argument) = @_;
- ## Expand an interior sequence; sample actions might be:
- return "*$seq_argument*" if ($seq_command eq 'B');
- return "`$seq_argument'" if ($seq_command eq 'C');
- return "_${seq_argument}_'" if ($seq_command eq 'I');
- ## ... other sequence commands and their resulting text
- }
-
- package main;
-
- ## Create a parser object and have it parse file whose name was
- ## given on the command-line (use STDIN if no files were given).
- $parser = new MyParser();
- $parser->parse_from_filehandle(\*STDIN) if (@ARGV == 0);
- for (@ARGV) { $parser->parse_from_file($_); }
-
-=head1 REQUIRES
-
-perl5.005, Pod::InputObjects, Exporter, Symbol, Carp
-
-=head1 EXPORTS
-
-Nothing.
-
-=head1 DESCRIPTION
-
-B<NOTE: This module is considered legacy; modern Perl releases (5.18 and
-higher) are going to remove Pod-Parser from core and use L<Pod-Simple>
-for all things POD.>
-
-B<Pod::Parser> is a base class for creating POD filters and translators.
-It handles most of the effort involved with parsing the POD sections
-from an input stream, leaving subclasses free to be concerned only with
-performing the actual translation of text.
-
-B<Pod::Parser> parses PODs, and makes method calls to handle the various
-components of the POD. Subclasses of B<Pod::Parser> override these methods
-to translate the POD into whatever output format they desire.
-
-=head1 QUICK OVERVIEW
-
-To create a POD filter for translating POD documentation into some other
-format, you create a subclass of B<Pod::Parser> which typically overrides
-just the base class implementation for the following methods:
-
-=over 2
-
-=item *
-
-B<command()>
-
-=item *
-
-B<verbatim()>
-
-=item *
-
-B<textblock()>
-
-=item *
-
-B<interior_sequence()>
-
-=back
-
-You may also want to override the B<begin_input()> and B<end_input()>
-methods for your subclass (to perform any needed per-file and/or
-per-document initialization or cleanup).
-
-If you need to perform any preprocessing of input before it is parsed
-you may want to override one or more of B<preprocess_line()> and/or
-B<preprocess_paragraph()>.
-
-Sometimes it may be necessary to make more than one pass over the input
-files. If this is the case you have several options. You can make the
-first pass using B<Pod::Parser> and override your methods to store the
-intermediate results in memory somewhere for the B<end_pod()> method to
-process. You could use B<Pod::Parser> for several passes with an
-appropriate state variable to control the operation for each pass. If
-your input source can't be reset to start at the beginning, you can
-store it in some other structure as a string or an array and have that
-structure implement a B<getline()> method (which is all that
-B<parse_from_filehandle()> uses to read input).
-
-Feel free to add any member data fields you need to keep track of things
-like current font, indentation, horizontal or vertical position, or
-whatever else you like. Be sure to read L<"PRIVATE METHODS AND DATA">
-to avoid name collisions.
-
-For the most part, the B<Pod::Parser> base class should be able to
-do most of the input parsing for you and leave you free to worry about
-how to interpret the commands and translate the result.
-
-Note that all we have described here in this quick overview is the
-simplest most straightforward use of B<Pod::Parser> to do stream-based
-parsing. It is also possible to use the B<Pod::Parser::parse_text> function
-to do more sophisticated tree-based parsing. See L<"TREE-BASED PARSING">.
-
-=head1 PARSING OPTIONS
-
-A I<parse-option> is simply a named option of B<Pod::Parser> with a
-value that corresponds to a certain specified behavior. These various
-behaviors of B<Pod::Parser> may be enabled/disabled by setting
-or unsetting one or more I<parse-options> using the B<parseopts()> method.
-The set of currently accepted parse-options is as follows:
-
-=over 3
-
-=item B<-want_nonPODs> (default: unset)
-
-Normally (by default) B<Pod::Parser> will only provide access to
-the POD sections of the input. Input paragraphs that are not part
-of the POD-format documentation are not made available to the caller
-(not even using B<preprocess_paragraph()>). Setting this option to a
-non-empty, non-zero value will allow B<preprocess_paragraph()> to see
-non-POD sections of the input as well as POD sections. The B<cutting()>
-method can be used to determine if the corresponding paragraph is a POD
-paragraph, or some other input paragraph.
-
-=item B<-process_cut_cmd> (default: unset)
-
-Normally (by default) B<Pod::Parser> handles the C<=cut> POD directive
-by itself and does not pass it on to the caller for processing. Setting
-this option to a non-empty, non-zero value will cause B<Pod::Parser> to
-pass the C<=cut> directive to the caller just like any other POD command
-(and hence it may be processed by the B<command()> method).
-
-B<Pod::Parser> will still interpret the C<=cut> directive to mean that
-"cutting mode" has been (re)entered, but the caller will get a chance
-to capture the actual C<=cut> paragraph itself for whatever purpose
-it desires.
-
-=item B<-warnings> (default: unset)
-
-Normally (by default) B<Pod::Parser> recognizes a bare minimum of
-pod syntax errors and warnings and issues diagnostic messages
-for errors, but not for warnings. (Use B<Pod::Checker> to do more
-thorough checking of POD syntax.) Setting this option to a non-empty,
-non-zero value will cause B<Pod::Parser> to issue diagnostics for
-the few warnings it recognizes as well as the errors.
-
-=back
-
-Please see L<"parseopts()"> for a complete description of the interface
-for the setting and unsetting of parse-options.
-
-=cut
-
-#############################################################################
-
-#use diagnostics;
-use Pod::InputObjects;
-use Carp;
-use Exporter;
-BEGIN {
- if ($] < 5.006) {
- require Symbol;
- import Symbol;
- }
-}
-@ISA = qw(Exporter);
-
-#############################################################################
-
-=head1 RECOMMENDED SUBROUTINE/METHOD OVERRIDES
-
-B<Pod::Parser> provides several methods which most subclasses will probably
-want to override. These methods are as follows:
-
-=cut
-
-##---------------------------------------------------------------------------
-
-=head1 B<command()>
-
- $parser->command($cmd,$text,$line_num,$pod_para);
-
-This method should be overridden by subclasses to take the appropriate
-action when a POD command paragraph (denoted by a line beginning with
-"=") is encountered. When such a POD directive is seen in the input,
-this method is called and is passed:
-
-=over 3
-
-=item C<$cmd>
-
-the name of the command for this POD paragraph
-
-=item C<$text>
-
-the paragraph text for the given POD paragraph command.
-
-=item C<$line_num>
-
-the line-number of the beginning of the paragraph
-
-=item C<$pod_para>
-
-a reference to a C<Pod::Paragraph> object which contains further
-information about the paragraph command (see L<Pod::InputObjects>
-for details).
-
-=back
-
-B<Note> that this method I<is> called for C<=pod> paragraphs.
-
-The base class implementation of this method simply treats the raw POD
-command as normal block of paragraph text (invoking the B<textblock()>
-method with the command paragraph).
-
-=cut
-
-sub command {
- my ($self, $cmd, $text, $line_num, $pod_para) = @_;
- ## Just treat this like a textblock
- $self->textblock($pod_para->raw_text(), $line_num, $pod_para);
-}
-
-##---------------------------------------------------------------------------
-
-=head1 B<verbatim()>
-
- $parser->verbatim($text,$line_num,$pod_para);
-
-This method may be overridden by subclasses to take the appropriate
-action when a block of verbatim text is encountered. It is passed the
-following parameters:
-
-=over 3
-
-=item C<$text>
-
-the block of text for the verbatim paragraph
-
-=item C<$line_num>
-
-the line-number of the beginning of the paragraph
-
-=item C<$pod_para>
-
-a reference to a C<Pod::Paragraph> object which contains further
-information about the paragraph (see L<Pod::InputObjects>
-for details).
-
-=back
-
-The base class implementation of this method simply prints the textblock
-(unmodified) to the output filehandle.
-
-=cut
-
-sub verbatim {
- my ($self, $text, $line_num, $pod_para) = @_;
- my $out_fh = $self->{_OUTPUT};
- print $out_fh $text;
-}
-
-##---------------------------------------------------------------------------
-
-=head1 B<textblock()>
-
- $parser->textblock($text,$line_num,$pod_para);
-
-This method may be overridden by subclasses to take the appropriate
-action when a normal block of POD text is encountered (although the base
-class method will usually do what you want). It is passed the following
-parameters:
-
-=over 3
-
-=item C<$text>
-
-the block of text for the a POD paragraph
-
-=item C<$line_num>
-
-the line-number of the beginning of the paragraph
-
-=item C<$pod_para>
-
-a reference to a C<Pod::Paragraph> object which contains further
-information about the paragraph (see L<Pod::InputObjects>
-for details).
-
-=back
-
-In order to process interior sequences, subclasses implementations of
-this method will probably want to invoke either B<interpolate()> or
-B<parse_text()>, passing it the text block C<$text>, and the corresponding
-line number in C<$line_num>, and then perform any desired processing upon
-the returned result.
-
-The base class implementation of this method simply prints the text block
-as it occurred in the input stream).
-
-=cut
-
-sub textblock {
- my ($self, $text, $line_num, $pod_para) = @_;
- my $out_fh = $self->{_OUTPUT};
- print $out_fh $self->interpolate($text, $line_num);
-}
-
-##---------------------------------------------------------------------------
-
-=head1 B<interior_sequence()>
-
- $parser->interior_sequence($seq_cmd,$seq_arg,$pod_seq);
-
-This method should be overridden by subclasses to take the appropriate
-action when an interior sequence is encountered. An interior sequence is
-an embedded command within a block of text which appears as a command
-name (usually a single uppercase character) followed immediately by a
-string of text which is enclosed in angle brackets. This method is
-passed the sequence command C<$seq_cmd> and the corresponding text
-C<$seq_arg>. It is invoked by the B<interpolate()> method for each interior
-sequence that occurs in the string that it is passed. It should return
-the desired text string to be used in place of the interior sequence.
-The C<$pod_seq> argument is a reference to a C<Pod::InteriorSequence>
-object which contains further information about the interior sequence.
-Please see L<Pod::InputObjects> for details if you need to access this
-additional information.
-
-Subclass implementations of this method may wish to invoke the
-B<nested()> method of C<$pod_seq> to see if it is nested inside
-some other interior-sequence (and if so, which kind).
-
-The base class implementation of the B<interior_sequence()> method
-simply returns the raw text of the interior sequence (as it occurred
-in the input) to the caller.
-
-=cut
-
-sub interior_sequence {
- my ($self, $seq_cmd, $seq_arg, $pod_seq) = @_;
- ## Just return the raw text of the interior sequence
- return $pod_seq->raw_text();
-}
-
-#############################################################################
-
-=head1 OPTIONAL SUBROUTINE/METHOD OVERRIDES
-
-B<Pod::Parser> provides several methods which subclasses may want to override
-to perform any special pre/post-processing. These methods do I<not> have to
-be overridden, but it may be useful for subclasses to take advantage of them.
-
-=cut
-
-##---------------------------------------------------------------------------
-
-=head1 B<new()>
-
- my $parser = Pod::Parser->new();
-
-This is the constructor for B<Pod::Parser> and its subclasses. You
-I<do not> need to override this method! It is capable of constructing
-subclass objects as well as base class objects, provided you use
-any of the following constructor invocation styles:
-
- my $parser1 = MyParser->new();
- my $parser2 = new MyParser();
- my $parser3 = $parser2->new();
-
-where C<MyParser> is some subclass of B<Pod::Parser>.
-
-Using the syntax C<MyParser::new()> to invoke the constructor is I<not>
-recommended, but if you insist on being able to do this, then the
-subclass I<will> need to override the B<new()> constructor method. If
-you do override the constructor, you I<must> be sure to invoke the
-B<initialize()> method of the newly blessed object.
-
-Using any of the above invocations, the first argument to the
-constructor is always the corresponding package name (or object
-reference). No other arguments are required, but if desired, an
-associative array (or hash-table) my be passed to the B<new()>
-constructor, as in:
-
- my $parser1 = MyParser->new( MYDATA => $value1, MOREDATA => $value2 );
- my $parser2 = new MyParser( -myflag => 1 );
-
-All arguments passed to the B<new()> constructor will be treated as
-key/value pairs in a hash-table. The newly constructed object will be
-initialized by copying the contents of the given hash-table (which may
-have been empty). The B<new()> constructor for this class and all of its
-subclasses returns a blessed reference to the initialized object (hash-table).
-
-=cut
-
-sub new {
- ## Determine if we were called via an object-ref or a classname
- my ($this,%params) = @_;
- my $class = ref($this) || $this;
- ## Any remaining arguments are treated as initial values for the
- ## hash that is used to represent this object.
- my $self = { %params };
- ## Bless ourselves into the desired class and perform any initialization
- bless $self, $class;
- $self->initialize();
- return $self;
-}
-
-##---------------------------------------------------------------------------
-
-=head1 B<initialize()>
-
- $parser->initialize();
-
-This method performs any necessary object initialization. It takes no
-arguments (other than the object instance of course, which is typically
-copied to a local variable named C<$self>). If subclasses override this
-method then they I<must> be sure to invoke C<$self-E<gt>SUPER::initialize()>.
-
-=cut
-
-sub initialize {
- #my $self = shift;
- #return;
-}
-
-##---------------------------------------------------------------------------
-
-=head1 B<begin_pod()>
-
- $parser->begin_pod();
-
-This method is invoked at the beginning of processing for each POD
-document that is encountered in the input. Subclasses should override
-this method to perform any per-document initialization.
-
-=cut
-
-sub begin_pod {
- #my $self = shift;
- #return;
-}
-
-##---------------------------------------------------------------------------
-
-=head1 B<begin_input()>
-
- $parser->begin_input();
-
-This method is invoked by B<parse_from_filehandle()> immediately I<before>
-processing input from a filehandle. The base class implementation does
-nothing, however, subclasses may override it to perform any per-file
-initializations.
-
-Note that if multiple files are parsed for a single POD document
-(perhaps the result of some future C<=include> directive) this method
-is invoked for every file that is parsed. If you wish to perform certain
-initializations once per document, then you should use B<begin_pod()>.
-
-=cut
-
-sub begin_input {
- #my $self = shift;
- #return;
-}
-
-##---------------------------------------------------------------------------
-
-=head1 B<end_input()>
-
- $parser->end_input();
-
-This method is invoked by B<parse_from_filehandle()> immediately I<after>
-processing input from a filehandle. The base class implementation does
-nothing, however, subclasses may override it to perform any per-file
-cleanup actions.
-
-Please note that if multiple files are parsed for a single POD document
-(perhaps the result of some kind of C<=include> directive) this method
-is invoked for every file that is parsed. If you wish to perform certain
-cleanup actions once per document, then you should use B<end_pod()>.
-
-=cut
-
-sub end_input {
- #my $self = shift;
- #return;
-}
-
-##---------------------------------------------------------------------------
-
-=head1 B<end_pod()>
-
- $parser->end_pod();
-
-This method is invoked at the end of processing for each POD document
-that is encountered in the input. Subclasses should override this method
-to perform any per-document finalization.
-
-=cut
-
-sub end_pod {
- #my $self = shift;
- #return;
-}
-
-##---------------------------------------------------------------------------
-
-=head1 B<preprocess_line()>
-
- $textline = $parser->preprocess_line($text, $line_num);
-
-This method should be overridden by subclasses that wish to perform
-any kind of preprocessing for each I<line> of input (I<before> it has
-been determined whether or not it is part of a POD paragraph). The
-parameter C<$text> is the input line; and the parameter C<$line_num> is
-the line number of the corresponding text line.
-
-The value returned should correspond to the new text to use in its
-place. If the empty string or an undefined value is returned then no
-further processing will be performed for this line.
-
-Please note that the B<preprocess_line()> method is invoked I<before>
-the B<preprocess_paragraph()> method. After all (possibly preprocessed)
-lines in a paragraph have been assembled together and it has been
-determined that the paragraph is part of the POD documentation from one
-of the selected sections, then B<preprocess_paragraph()> is invoked.
-
-The base class implementation of this method returns the given text.
-
-=cut
-
-sub preprocess_line {
- my ($self, $text, $line_num) = @_;
- return $text;
-}
-
-##---------------------------------------------------------------------------
-
-=head1 B<preprocess_paragraph()>
-
- $textblock = $parser->preprocess_paragraph($text, $line_num);
-
-This method should be overridden by subclasses that wish to perform any
-kind of preprocessing for each block (paragraph) of POD documentation
-that appears in the input stream. The parameter C<$text> is the POD
-paragraph from the input file; and the parameter C<$line_num> is the
-line number for the beginning of the corresponding paragraph.
-
-The value returned should correspond to the new text to use in its
-place If the empty string is returned or an undefined value is
-returned, then the given C<$text> is ignored (not processed).
-
-This method is invoked after gathering up all the lines in a paragraph
-and after determining the cutting state of the paragraph,
-but before trying to further parse or interpret them. After
-B<preprocess_paragraph()> returns, the current cutting state (which
-is returned by C<$self-E<gt>cutting()>) is examined. If it evaluates
-to true then input text (including the given C<$text>) is cut (not
-processed) until the next POD directive is encountered.
-
-Please note that the B<preprocess_line()> method is invoked I<before>
-the B<preprocess_paragraph()> method. After all (possibly preprocessed)
-lines in a paragraph have been assembled together and either it has been
-determined that the paragraph is part of the POD documentation from one
-of the selected sections or the C<-want_nonPODs> option is true,
-then B<preprocess_paragraph()> is invoked.
-
-The base class implementation of this method returns the given text.
-
-=cut
-
-sub preprocess_paragraph {
- my ($self, $text, $line_num) = @_;
- return $text;
-}
-
-#############################################################################
-
-=head1 METHODS FOR PARSING AND PROCESSING
-
-B<Pod::Parser> provides several methods to process input text. These
-methods typically won't need to be overridden (and in some cases they
-can't be overridden), but subclasses may want to invoke them to exploit
-their functionality.
-
-=cut
-
-##---------------------------------------------------------------------------
-
-=head1 B<parse_text()>
-
- $ptree1 = $parser->parse_text($text, $line_num);
- $ptree2 = $parser->parse_text({%opts}, $text, $line_num);
- $ptree3 = $parser->parse_text(\%opts, $text, $line_num);
-
-This method is useful if you need to perform your own interpolation
-of interior sequences and can't rely upon B<interpolate> to expand
-them in simple bottom-up order.
-
-The parameter C<$text> is a string or block of text to be parsed
-for interior sequences; and the parameter C<$line_num> is the
-line number corresponding to the beginning of C<$text>.
-
-B<parse_text()> will parse the given text into a parse-tree of "nodes."
-and interior-sequences. Each "node" in the parse tree is either a
-text-string, or a B<Pod::InteriorSequence>. The result returned is a
-parse-tree of type B<Pod::ParseTree>. Please see L<Pod::InputObjects>
-for more information about B<Pod::InteriorSequence> and B<Pod::ParseTree>.
-
-If desired, an optional hash-ref may be specified as the first argument
-to customize certain aspects of the parse-tree that is created and
-returned. The set of recognized option keywords are:
-
-=over 3
-
-=item B<-expand_seq> =E<gt> I<code-ref>|I<method-name>
-
-Normally, the parse-tree returned by B<parse_text()> will contain an
-unexpanded C<Pod::InteriorSequence> object for each interior-sequence
-encountered. Specifying B<-expand_seq> tells B<parse_text()> to "expand"
-every interior-sequence it sees by invoking the referenced function
-(or named method of the parser object) and using the return value as the
-expanded result.
-
-If a subroutine reference was given, it is invoked as:
-
- &$code_ref( $parser, $sequence )
-
-and if a method-name was given, it is invoked as:
-
- $parser->method_name( $sequence )
-
-where C<$parser> is a reference to the parser object, and C<$sequence>
-is a reference to the interior-sequence object.
-[I<NOTE>: If the B<interior_sequence()> method is specified, then it is
-invoked according to the interface specified in L<"interior_sequence()">].
-
-=item B<-expand_text> =E<gt> I<code-ref>|I<method-name>
-
-Normally, the parse-tree returned by B<parse_text()> will contain a
-text-string for each contiguous sequence of characters outside of an
-interior-sequence. Specifying B<-expand_text> tells B<parse_text()> to
-"preprocess" every such text-string it sees by invoking the referenced
-function (or named method of the parser object) and using the return value
-as the preprocessed (or "expanded") result. [Note that if the result is
-an interior-sequence, then it will I<not> be expanded as specified by the
-B<-expand_seq> option; Any such recursive expansion needs to be handled by
-the specified callback routine.]
-
-If a subroutine reference was given, it is invoked as:
-
- &$code_ref( $parser, $text, $ptree_node )
-
-and if a method-name was given, it is invoked as:
-
- $parser->method_name( $text, $ptree_node )
-
-where C<$parser> is a reference to the parser object, C<$text> is the
-text-string encountered, and C<$ptree_node> is a reference to the current
-node in the parse-tree (usually an interior-sequence object or else the
-top-level node of the parse-tree).
-
-=item B<-expand_ptree> =E<gt> I<code-ref>|I<method-name>
-
-Rather than returning a C<Pod::ParseTree>, pass the parse-tree as an
-argument to the referenced subroutine (or named method of the parser
-object) and return the result instead of the parse-tree object.
-
-If a subroutine reference was given, it is invoked as:
-
- &$code_ref( $parser, $ptree )
-
-and if a method-name was given, it is invoked as:
-
- $parser->method_name( $ptree )
-
-where C<$parser> is a reference to the parser object, and C<$ptree>
-is a reference to the parse-tree object.
-
-=back
-
-=cut
-
-sub parse_text {
- my $self = shift;
- local $_ = '';
-
- ## Get options and set any defaults
- my %opts = (ref $_[0]) ? %{ shift() } : ();
- my $expand_seq = $opts{'-expand_seq'} || undef;
- my $expand_text = $opts{'-expand_text'} || undef;
- my $expand_ptree = $opts{'-expand_ptree'} || undef;
-
- my $text = shift;
- my $line = shift;
- my $file = $self->input_file();
- my $cmd = "";
-
- ## Convert method calls into closures, for our convenience
- my $xseq_sub = $expand_seq;
- my $xtext_sub = $expand_text;
- my $xptree_sub = $expand_ptree;
- if (defined $expand_seq and $expand_seq eq 'interior_sequence') {
- ## If 'interior_sequence' is the method to use, we have to pass
- ## more than just the sequence object, we also need to pass the
- ## sequence name and text.
- $xseq_sub = sub {
- my ($sself, $iseq) = @_;
- my $args = join('', $iseq->parse_tree->children);
- return $sself->interior_sequence($iseq->name, $args, $iseq);
- };
- }
- ref $xseq_sub or $xseq_sub = sub { shift()->$expand_seq(@_) };
- ref $xtext_sub or $xtext_sub = sub { shift()->$expand_text(@_) };
- ref $xptree_sub or $xptree_sub = sub { shift()->$expand_ptree(@_) };
-
- ## Keep track of the "current" interior sequence, and maintain a stack
- ## of "in progress" sequences.
- ##
- ## NOTE that we push our own "accumulator" at the very beginning of the
- ## stack. It's really a parse-tree, not a sequence; but it implements
- ## the methods we need so we can use it to gather-up all the sequences
- ## and strings we parse. Thus, by the end of our parsing, it should be
- ## the only thing left on our stack and all we have to do is return it!
- ##
- my $seq = Pod::ParseTree->new();
- my @seq_stack = ($seq);
- my ($ldelim, $rdelim) = ('', '');
-
- ## Iterate over all sequence starts text (NOTE: split with
- ## capturing parens keeps the delimiters)
- $_ = $text;
- my @tokens = split /([A-Z]<(?:<+(?:\r?\n|[ \t]))?)/;
- while ( @tokens ) {
- $_ = shift @tokens;
- ## Look for the beginning of a sequence
- if ( /^([A-Z])(<(?:<+(?:\r?\n|[ \t]))?)$/ ) {
- ## Push a new sequence onto the stack of those "in-progress"
- my $ldelim_orig;
- ($cmd, $ldelim_orig) = ($1, $2);
- ($ldelim = $ldelim_orig) =~ s/\s+$//;
- ($rdelim = $ldelim) =~ tr/</>/;
- $seq = Pod::InteriorSequence->new(
- -name => $cmd,
- -ldelim => $ldelim_orig, -rdelim => $rdelim,
- -file => $file, -line => $line
- );
- (@seq_stack > 1) and $seq->nested($seq_stack[-1]);
- push @seq_stack, $seq;
- }
- ## Look for sequence ending
- elsif ( @seq_stack > 1 ) {
- ## Make sure we match the right kind of closing delimiter
- my ($seq_end, $post_seq) = ('', '');
- if ( ($ldelim eq '<' and /\A(.*?)(>)/s)
- or /\A(.*?)(\s+$rdelim)/s )
- {
- ## Found end-of-sequence, capture the interior and the
- ## closing the delimiter, and put the rest back on the
- ## token-list
- $post_seq = substr($_, length($1) + length($2));
- ($_, $seq_end) = ($1, $2);
- (length $post_seq) and unshift @tokens, $post_seq;
- }
- if (length) {
- ## In the middle of a sequence, append this text to it, and
- ## don't forget to "expand" it if that's what the caller wanted
- $seq->append($expand_text ? &$xtext_sub($self,$_,$seq) : $_);
- $_ .= $seq_end;
- }
- if (length $seq_end) {
- ## End of current sequence, record terminating delimiter
- $seq->rdelim($seq_end);
- ## Pop it off the stack of "in progress" sequences
- pop @seq_stack;
- ## Append result to its parent in current parse tree
- $seq_stack[-1]->append($expand_seq ? &$xseq_sub($self,$seq)
- : $seq);
- ## Remember the current cmd-name and left-delimiter
- if(@seq_stack > 1) {
- $cmd = $seq_stack[-1]->name;
- $ldelim = $seq_stack[-1]->ldelim;
- $rdelim = $seq_stack[-1]->rdelim;
- } else {
- $cmd = $ldelim = $rdelim = '';
- }
- }
- }
- elsif (length) {
- ## In the middle of a sequence, append this text to it, and
- ## don't forget to "expand" it if that's what the caller wanted
- $seq->append($expand_text ? &$xtext_sub($self,$_,$seq) : $_);
- }
- ## Keep track of line count
- $line += /\n/;
- ## Remember the "current" sequence
- $seq = $seq_stack[-1];
- }
-
- ## Handle unterminated sequences
- my $errorsub = (@seq_stack > 1) ? $self->errorsub() : undef;
- while (@seq_stack > 1) {
- ($cmd, $file, $line) = ($seq->name, $seq->file_line);
- $ldelim = $seq->ldelim;
- ($rdelim = $ldelim) =~ tr/</>/;
- $rdelim =~ s/^(\S+)(\s*)$/$2$1/;
- pop @seq_stack;
- my $errmsg = "*** ERROR: unterminated ${cmd}${ldelim}...${rdelim}".
- " at line $line in file $file\n";
- (ref $errorsub) and &{$errorsub}($errmsg)
- or (defined $errorsub) and $self->$errorsub($errmsg)
- or carp($errmsg);
- $seq_stack[-1]->append($expand_seq ? &$xseq_sub($self,$seq) : $seq);
- $seq = $seq_stack[-1];
- }
-
- ## Return the resulting parse-tree
- my $ptree = (pop @seq_stack)->parse_tree;
- return $expand_ptree ? &$xptree_sub($self, $ptree) : $ptree;
-}
-
-##---------------------------------------------------------------------------
-
-=head1 B<interpolate()>
-
- $textblock = $parser->interpolate($text, $line_num);
-
-This method translates all text (including any embedded interior sequences)
-in the given text string C<$text> and returns the interpolated result. The
-parameter C<$line_num> is the line number corresponding to the beginning
-of C<$text>.
-
-B<interpolate()> merely invokes a private method to recursively expand
-nested interior sequences in bottom-up order (innermost sequences are
-expanded first). If there is a need to expand nested sequences in
-some alternate order, use B<parse_text> instead.
-
-=cut
-
-sub interpolate {
- my($self, $text, $line_num) = @_;
- my %parse_opts = ( -expand_seq => 'interior_sequence' );
- my $ptree = $self->parse_text( \%parse_opts, $text, $line_num );
- return join '', $ptree->children();
-}
-
-##---------------------------------------------------------------------------
-
-=begin __PRIVATE__
-
-=head1 B<parse_paragraph()>
-
- $parser->parse_paragraph($text, $line_num);
-
-This method takes the text of a POD paragraph to be processed, along
-with its corresponding line number, and invokes the appropriate method
-(one of B<command()>, B<verbatim()>, or B<textblock()>).
-
-For performance reasons, this method is invoked directly without any
-dynamic lookup; Hence subclasses may I<not> override it!
-
-=end __PRIVATE__
-
-=cut
-
-sub parse_paragraph {
- my ($self, $text, $line_num) = @_;
- local *myData = $self; ## alias to avoid deref-ing overhead
- local *myOpts = ($myData{_PARSEOPTS} ||= {}); ## get parse-options
- local $_;
-
- ## See if we want to preprocess nonPOD paragraphs as well as POD ones.
- my $wantNonPods = $myOpts{'-want_nonPODs'};
-
- ## Update cutting status
- $myData{_CUTTING} = 0 if $text =~ /^={1,2}\S/;
-
- ## Perform any desired preprocessing if we wanted it this early
- $wantNonPods and $text = $self->preprocess_paragraph($text, $line_num);
-
- ## Ignore up until next POD directive if we are cutting
- return if $myData{_CUTTING};
-
- ## Now we know this is block of text in a POD section!
-
- ##-----------------------------------------------------------------
- ## This is a hook (hack ;-) for Pod::Select to do its thing without
- ## having to override methods, but also without Pod::Parser assuming
- ## $self is an instance of Pod::Select (if the _SELECTED_SECTIONS
- ## field exists then we assume there is an is_selected() method for
- ## us to invoke (calling $self->can('is_selected') could verify this
- ## but that is more overhead than I want to incur)
- ##-----------------------------------------------------------------
-
- ## Ignore this block if it isn't in one of the selected sections
- if (exists $myData{_SELECTED_SECTIONS}) {
- $self->is_selected($text) or return ($myData{_CUTTING} = 1);
- }
-
- ## If we haven't already, perform any desired preprocessing and
- ## then re-check the "cutting" state
- unless ($wantNonPods) {
- $text = $self->preprocess_paragraph($text, $line_num);
- return 1 unless ((defined $text) and (length $text));
- return 1 if ($myData{_CUTTING});
- }
-
- ## Look for one of the three types of paragraphs
- my ($pfx, $cmd, $arg, $sep) = ('', '', '', '');
- my $pod_para = undef;
- if ($text =~ /^(={1,2})(?=\S)/) {
- ## Looks like a command paragraph. Capture the command prefix used
- ## ("=" or "=="), as well as the command-name, its paragraph text,
- ## and whatever sequence of characters was used to separate them
- $pfx = $1;
- $_ = substr($text, length $pfx);
- ($cmd, $sep, $text) = split /(\s+)/, $_, 2;
- $sep = '' unless defined $sep;
- $text = '' unless defined $text;
- ## If this is a "cut" directive then we don't need to do anything
- ## except return to "cutting" mode.
- if ($cmd eq 'cut') {
- $myData{_CUTTING} = 1;
- return unless $myOpts{'-process_cut_cmd'};
- }
- }
- ## Save the attributes indicating how the command was specified.
- $pod_para = new Pod::Paragraph(
- -name => $cmd,
- -text => $text,
- -prefix => $pfx,
- -separator => $sep,
- -file => $myData{_INFILE},
- -line => $line_num
- );
- # ## Invoke appropriate callbacks
- # if (exists $myData{_CALLBACKS}) {
- # ## Look through the callback list, invoke callbacks,
- # ## then see if we need to do the default actions
- # ## (invoke_callbacks will return true if we do).
- # return 1 unless $self->invoke_callbacks($cmd, $text, $line_num, $pod_para);
- # }
-
- # If the last paragraph ended in whitespace, and we're not between verbatim blocks, carp
- if ($myData{_WHITESPACE} and $myOpts{'-warnings'}
- and not ($text =~ /^\s+/ and ($myData{_PREVIOUS}||"") eq "verbatim")) {
- my $errorsub = $self->errorsub();
- my $line = $line_num - 1;
- my $errmsg = "*** WARNING: line containing nothing but whitespace".
- " in paragraph at line $line in file $myData{_INFILE}\n";
- (ref $errorsub) and &{$errorsub}($errmsg)
- or (defined $errorsub) and $self->$errorsub($errmsg)
- or carp($errmsg);
- }
-
- if (length $cmd) {
- ## A command paragraph
- $self->command($cmd, $text, $line_num, $pod_para);
- $myData{_PREVIOUS} = $cmd;
- }
- elsif ($text =~ /^\s+/) {
- ## Indented text - must be a verbatim paragraph
- $self->verbatim($text, $line_num, $pod_para);
- $myData{_PREVIOUS} = "verbatim";
- }
- else {
- ## Looks like an ordinary block of text
- $self->textblock($text, $line_num, $pod_para);
- $myData{_PREVIOUS} = "textblock";
- }
-
- # Update the whitespace for the next time around
- #$myData{_WHITESPACE} = $text =~ /^[^\S\r\n]+\Z/m ? 1 : 0;
- $myData{_WHITESPACE} = $text =~ /^[^\S\r\n]+\r*\Z/m ? 1 : 0;
-
- return 1;
-}
-
-##---------------------------------------------------------------------------
-
-=head1 B<parse_from_filehandle()>
-
- $parser->parse_from_filehandle($in_fh,$out_fh);
-
-This method takes an input filehandle (which is assumed to already be
-opened for reading) and reads the entire input stream looking for blocks
-(paragraphs) of POD documentation to be processed. If no first argument
-is given the default input filehandle C<STDIN> is used.
-
-The C<$in_fh> parameter may be any object that provides a B<getline()>
-method to retrieve a single line of input text (hence, an appropriate
-wrapper object could be used to parse PODs from a single string or an
-array of strings).
-
-Using C<$in_fh-E<gt>getline()>, input is read line-by-line and assembled
-into paragraphs or "blocks" (which are separated by lines containing
-nothing but whitespace). For each block of POD documentation
-encountered it will invoke a method to parse the given paragraph.
-
-If a second argument is given then it should correspond to a filehandle where
-output should be sent (otherwise the default output filehandle is
-C<STDOUT> if no output filehandle is currently in use).
-
-B<NOTE:> For performance reasons, this method caches the input stream at
-the top of the stack in a local variable. Any attempts by clients to
-change the stack contents during processing when in the midst executing
-of this method I<will not affect> the input stream used by the current
-invocation of this method.
-
-This method does I<not> usually need to be overridden by subclasses.
-
-=cut
-
-sub parse_from_filehandle {
- my $self = shift;
- my %opts = (ref $_[0] eq 'HASH') ? %{ shift() } : ();
- my ($in_fh, $out_fh) = @_;
- $in_fh = \*STDIN unless ($in_fh);
- local *myData = $self; ## alias to avoid deref-ing overhead
- local *myOpts = ($myData{_PARSEOPTS} ||= {}); ## get parse-options
- local $_;
-
- ## Put this stream at the top of the stack and do beginning-of-input
- ## processing. NOTE that $in_fh might be reset during this process.
- my $topstream = $self->_push_input_stream($in_fh, $out_fh);
- (exists $opts{-cutting}) and $self->cutting( $opts{-cutting} );
-
- ## Initialize line/paragraph
- my ($textline, $paragraph) = ('', '');
- my ($nlines, $plines) = (0, 0);
-
- ## Use <$fh> instead of $fh->getline where possible (for speed)
- $_ = ref $in_fh;
- my $tied_fh = (/^(?:GLOB|FileHandle|IO::\w+)$/ or tied $in_fh);
-
- ## Read paragraphs line-by-line
- while (defined ($textline = $tied_fh ? <$in_fh> : $in_fh->getline)) {
- $textline = $self->preprocess_line($textline, ++$nlines);
- next unless ((defined $textline) && (length $textline));
-
- if ((! length $paragraph) && ($textline =~ /^==/)) {
- ## '==' denotes a one-line command paragraph
- $paragraph = $textline;
- $plines = 1;
- $textline = '';
- } else {
- ## Append this line to the current paragraph
- $paragraph .= $textline;
- ++$plines;
- }
-
- ## See if this line is blank and ends the current paragraph.
- ## If it isn't, then keep iterating until it is.
- next unless (($textline =~ /^[^\S\r\n]*[\r\n]*$/)
- && (length $paragraph));
-
- ## Now process the paragraph
- parse_paragraph($self, $paragraph, ($nlines - $plines) + 1);
- $paragraph = '';
- $plines = 0;
- }
- ## Don't forget about the last paragraph in the file
- if (length $paragraph) {
- parse_paragraph($self, $paragraph, ($nlines - $plines) + 1)
- }
-
- ## Now pop the input stream off the top of the input stack.
- $self->_pop_input_stream();
-}
-
-##---------------------------------------------------------------------------
-
-=head1 B<parse_from_file()>
-
- $parser->parse_from_file($filename,$outfile);
-
-This method takes a filename and does the following:
-
-=over 2
-
-=item *
-
-opens the input and output files for reading
-(creating the appropriate filehandles)
-
-=item *
-
-invokes the B<parse_from_filehandle()> method passing it the
-corresponding input and output filehandles.
-
-=item *
-
-closes the input and output files.
-
-=back
-
-If the special input filename "", "-" or "<&STDIN" is given then the STDIN
-filehandle is used for input (and no open or close is performed). If no
-input filename is specified then "-" is implied. Filehandle references,
-or objects that support the regular IO operations (like C<E<lt>$fhE<gt>>
-or C<$fh-<Egt>getline>) are also accepted; the handles must already be
-opened.
-
-If a second argument is given then it should be the name of the desired
-output file. If the special output filename "-" or ">&STDOUT" is given
-then the STDOUT filehandle is used for output (and no open or close is
-performed). If the special output filename ">&STDERR" is given then the
-STDERR filehandle is used for output (and no open or close is
-performed). If no output filehandle is currently in use and no output
-filename is specified, then "-" is implied.
-Alternatively, filehandle references or objects that support the regular
-IO operations (like C<print>, e.g. L<IO::String>) are also accepted;
-the object must already be opened.
-
-This method does I<not> usually need to be overridden by subclasses.
-
-=cut
-
-sub parse_from_file {
- my $self = shift;
- my %opts = (ref $_[0] eq 'HASH') ? %{ shift() } : ();
- my ($infile, $outfile) = @_;
- my ($in_fh, $out_fh);
- if ($] < 5.006) {
- ($in_fh, $out_fh) = (gensym(), gensym());
- }
- my ($close_input, $close_output) = (0, 0);
- local *myData = $self;
- local *_;
-
- ## Is $infile a filename or a (possibly implied) filehandle
- if (defined $infile && ref $infile) {
- if (ref($infile) =~ /^(SCALAR|ARRAY|HASH|CODE|REF)$/) {
- croak "Input from $1 reference not supported!\n";
- }
- ## Must be a filehandle-ref (or else assume its a ref to an object
- ## that supports the common IO read operations).
- $myData{_INFILE} = ${$infile};
- $in_fh = $infile;
- }
- elsif (!defined($infile) || !length($infile) || ($infile eq '-')
- || ($infile =~ /^<&(?:STDIN|0)$/i))
- {
- ## Not a filename, just a string implying STDIN
- $infile ||= '-';
- $myData{_INFILE} = '<standard input>';
- $in_fh = \*STDIN;
- }
- else {
- ## We have a filename, open it for reading
- $myData{_INFILE} = $infile;
- open($in_fh, "< $infile") or
- croak "Can't open $infile for reading: $!\n";
- $close_input = 1;
- }
-
- ## NOTE: we need to be *very* careful when "defaulting" the output
- ## file. We only want to use a default if this is the beginning of
- ## the entire document (but *not* if this is an included file). We
- ## determine this by seeing if the input stream stack has been set-up
- ## already
-
- ## Is $outfile a filename, a (possibly implied) filehandle, maybe a ref?
- if (ref $outfile) {
- ## we need to check for ref() first, as other checks involve reading
- if (ref($outfile) =~ /^(ARRAY|HASH|CODE)$/) {
- croak "Output to $1 reference not supported!\n";
- }
- elsif (ref($outfile) eq 'SCALAR') {
-# # NOTE: IO::String isn't a part of the perl distribution,
-# # so probably we shouldn't support this case...
-# require IO::String;
-# $myData{_OUTFILE} = "$outfile";
-# $out_fh = IO::String->new($outfile);
- croak "Output to SCALAR reference not supported!\n";
- }
- else {
- ## Must be a filehandle-ref (or else assume its a ref to an
- ## object that supports the common IO write operations).
- $myData{_OUTFILE} = ${$outfile};
- $out_fh = $outfile;
- }
- }
- elsif (!defined($outfile) || !length($outfile) || ($outfile eq '-')
- || ($outfile =~ /^>&?(?:STDOUT|1)$/i))
- {
- if (defined $myData{_TOP_STREAM}) {
- $out_fh = $myData{_OUTPUT};
- }
- else {
- ## Not a filename, just a string implying STDOUT
- $outfile ||= '-';
- $myData{_OUTFILE} = '<standard output>';
- $out_fh = \*STDOUT;
- }
- }
- elsif ($outfile =~ /^>&(STDERR|2)$/i) {
- ## Not a filename, just a string implying STDERR
- $myData{_OUTFILE} = '<standard error>';
- $out_fh = \*STDERR;
- }
- else {
- ## We have a filename, open it for writing
- $myData{_OUTFILE} = $outfile;
- (-d $outfile) and croak "$outfile is a directory, not POD input!\n";
- open($out_fh, "> $outfile") or
- croak "Can't open $outfile for writing: $!\n";
- $close_output = 1;
- }
-
- ## Whew! That was a lot of work to set up reasonably/robust behavior
- ## in the case of a non-filename for reading and writing. Now we just
- ## have to parse the input and close the handles when we're finished.
- $self->parse_from_filehandle(\%opts, $in_fh, $out_fh);
-
- $close_input and
- close($in_fh) || croak "Can't close $infile after reading: $!\n";
- $close_output and
- close($out_fh) || croak "Can't close $outfile after writing: $!\n";
-}
-
-#############################################################################
-
-=head1 ACCESSOR METHODS
-
-Clients of B<Pod::Parser> should use the following methods to access
-instance data fields:
-
-=cut
-
-##---------------------------------------------------------------------------
-
-=head1 B<errorsub()>
-
- $parser->errorsub("method_name");
- $parser->errorsub(\&warn_user);
- $parser->errorsub(sub { print STDERR, @_ });
-
-Specifies the method or subroutine to use when printing error messages
-about POD syntax. The supplied method/subroutine I<must> return TRUE upon
-successful printing of the message. If C<undef> is given, then the B<carp>
-builtin is used to issue error messages (this is the default behavior).
-
- my $errorsub = $parser->errorsub()
- my $errmsg = "This is an error message!\n"
- (ref $errorsub) and &{$errorsub}($errmsg)
- or (defined $errorsub) and $parser->$errorsub($errmsg)
- or carp($errmsg);
-
-Returns a method name, or else a reference to the user-supplied subroutine
-used to print error messages. Returns C<undef> if the B<carp> builtin
-is used to issue error messages (this is the default behavior).
-
-=cut
-
-sub errorsub {
- return (@_ > 1) ? ($_[0]->{_ERRORSUB} = $_[1]) : $_[0]->{_ERRORSUB};
-}
-
-##---------------------------------------------------------------------------
-
-=head1 B<cutting()>
-
- $boolean = $parser->cutting();
-
-Returns the current C<cutting> state: a boolean-valued scalar which
-evaluates to true if text from the input file is currently being "cut"
-(meaning it is I<not> considered part of the POD document).
-
- $parser->cutting($boolean);
-
-Sets the current C<cutting> state to the given value and returns the
-result.
-
-=cut
-
-sub cutting {
- return (@_ > 1) ? ($_[0]->{_CUTTING} = $_[1]) : $_[0]->{_CUTTING};
-}
-
-##---------------------------------------------------------------------------
-
-##---------------------------------------------------------------------------
-
-=head1 B<parseopts()>
-
-When invoked with no additional arguments, B<parseopts> returns a hashtable
-of all the current parsing options.
-
- ## See if we are parsing non-POD sections as well as POD ones
- my %opts = $parser->parseopts();
- $opts{'-want_nonPODs}' and print "-want_nonPODs\n";
-
-When invoked using a single string, B<parseopts> treats the string as the
-name of a parse-option and returns its corresponding value if it exists
-(returns C<undef> if it doesn't).
-
- ## Did we ask to see '=cut' paragraphs?
- my $want_cut = $parser->parseopts('-process_cut_cmd');
- $want_cut and print "-process_cut_cmd\n";
-
-When invoked with multiple arguments, B<parseopts> treats them as
-key/value pairs and the specified parse-option names are set to the
-given values. Any unspecified parse-options are unaffected.
-
- ## Set them back to the default
- $parser->parseopts(-warnings => 0);
-
-When passed a single hash-ref, B<parseopts> uses that hash to completely
-reset the existing parse-options, all previous parse-option values
-are lost.
-
- ## Reset all options to default
- $parser->parseopts( { } );
-
-See L<"PARSING OPTIONS"> for more information on the name and meaning of each
-parse-option currently recognized.
-
-=cut
-
-sub parseopts {
- local *myData = shift;
- local *myOpts = ($myData{_PARSEOPTS} ||= {});
- return %myOpts if (@_ == 0);
- if (@_ == 1) {
- local $_ = shift;
- return ref($_) ? $myData{_PARSEOPTS} = $_ : $myOpts{$_};
- }
- my @newOpts = (%myOpts, @_);
- $myData{_PARSEOPTS} = { @newOpts };
-}
-
-##---------------------------------------------------------------------------
-
-=head1 B<output_file()>
-
- $fname = $parser->output_file();
-
-Returns the name of the output file being written.
-
-=cut
-
-sub output_file {
- return $_[0]->{_OUTFILE};
-}
-
-##---------------------------------------------------------------------------
-
-=head1 B<output_handle()>
-
- $fhandle = $parser->output_handle();
-
-Returns the output filehandle object.
-
-=cut
-
-sub output_handle {
- return $_[0]->{_OUTPUT};
-}
-
-##---------------------------------------------------------------------------
-
-=head1 B<input_file()>
-
- $fname = $parser->input_file();
-
-Returns the name of the input file being read.
-
-=cut
-
-sub input_file {
- return $_[0]->{_INFILE};
-}
-
-##---------------------------------------------------------------------------
-
-=head1 B<input_handle()>
-
- $fhandle = $parser->input_handle();
-
-Returns the current input filehandle object.
-
-=cut
-
-sub input_handle {
- return $_[0]->{_INPUT};
-}
-
-##---------------------------------------------------------------------------
-
-=begin __PRIVATE__
-
-=head1 B<input_streams()>
-
- $listref = $parser->input_streams();
-
-Returns a reference to an array which corresponds to the stack of all
-the input streams that are currently in the middle of being parsed.
-
-While parsing an input stream, it is possible to invoke
-B<parse_from_file()> or B<parse_from_filehandle()> to parse a new input
-stream and then return to parsing the previous input stream. Each input
-stream to be parsed is pushed onto the end of this input stack
-before any of its input is read. The input stream that is currently
-being parsed is always at the end (or top) of the input stack. When an
-input stream has been exhausted, it is popped off the end of the
-input stack.
-
-Each element on this input stack is a reference to C<Pod::InputSource>
-object. Please see L<Pod::InputObjects> for more details.
-
-This method might be invoked when printing diagnostic messages, for example,
-to obtain the name and line number of the all input files that are currently
-being processed.
-
-=end __PRIVATE__
-
-=cut
-
-sub input_streams {
- return $_[0]->{_INPUT_STREAMS};
-}
-
-##---------------------------------------------------------------------------
-
-=begin __PRIVATE__
-
-=head1 B<top_stream()>
-
- $hashref = $parser->top_stream();
-
-Returns a reference to the hash-table that represents the element
-that is currently at the top (end) of the input stream stack
-(see L<"input_streams()">). The return value will be the C<undef>
-if the input stack is empty.
-
-This method might be used when printing diagnostic messages, for example,
-to obtain the name and line number of the current input file.
-
-=end __PRIVATE__
-
-=cut
-
-sub top_stream {
- return $_[0]->{_TOP_STREAM} || undef;
-}
-
-#############################################################################
-
-=head1 PRIVATE METHODS AND DATA
-
-B<Pod::Parser> makes use of several internal methods and data fields
-which clients should not need to see or use. For the sake of avoiding
-name collisions for client data and methods, these methods and fields
-are briefly discussed here. Determined hackers may obtain further
-information about them by reading the B<Pod::Parser> source code.
-
-Private data fields are stored in the hash-object whose reference is
-returned by the B<new()> constructor for this class. The names of all
-private methods and data-fields used by B<Pod::Parser> begin with a
-prefix of "_" and match the regular expression C</^_\w+$/>.
-
-=cut
-
-##---------------------------------------------------------------------------
-
-=begin _PRIVATE_
-
-=head1 B<_push_input_stream()>
-
- $hashref = $parser->_push_input_stream($in_fh,$out_fh);
-
-This method will push the given input stream on the input stack and
-perform any necessary beginning-of-document or beginning-of-file
-processing. The argument C<$in_fh> is the input stream filehandle to
-push, and C<$out_fh> is the corresponding output filehandle to use (if
-it is not given or is undefined, then the current output stream is used,
-which defaults to standard output if it doesnt exist yet).
-
-The value returned will be reference to the hash-table that represents
-the new top of the input stream stack. I<Please Note> that it is
-possible for this method to use default values for the input and output
-file handles. If this happens, you will need to look at the C<INPUT>
-and C<OUTPUT> instance data members to determine their new values.
-
-=end _PRIVATE_
-
-=cut
-
-sub _push_input_stream {
- my ($self, $in_fh, $out_fh) = @_;
- local *myData = $self;
-
- ## Initialize stuff for the entire document if this is *not*
- ## an included file.
- ##
- ## NOTE: we need to be *very* careful when "defaulting" the output
- ## filehandle. We only want to use a default value if this is the
- ## beginning of the entire document (but *not* if this is an included
- ## file).
- unless (defined $myData{_TOP_STREAM}) {
- $out_fh = \*STDOUT unless (defined $out_fh);
- $myData{_CUTTING} = 1; ## current "cutting" state
- $myData{_INPUT_STREAMS} = []; ## stack of all input streams
- }
-
- ## Initialize input indicators
- $myData{_OUTFILE} = '(unknown)' unless (defined $myData{_OUTFILE});
- $myData{_OUTPUT} = $out_fh if (defined $out_fh);
- $in_fh = \*STDIN unless (defined $in_fh);
- $myData{_INFILE} = '(unknown)' unless (defined $myData{_INFILE});
- $myData{_INPUT} = $in_fh;
- my $input_top = $myData{_TOP_STREAM}
- = new Pod::InputSource(
- -name => $myData{_INFILE},
- -handle => $in_fh,
- -was_cutting => $myData{_CUTTING}
- );
- local *input_stack = $myData{_INPUT_STREAMS};
- push(@input_stack, $input_top);
-
- ## Perform beginning-of-document and/or beginning-of-input processing
- $self->begin_pod() if (@input_stack == 1);
- $self->begin_input();
-
- return $input_top;
-}
-
-##---------------------------------------------------------------------------
-
-=begin _PRIVATE_
-
-=head1 B<_pop_input_stream()>
-
- $hashref = $parser->_pop_input_stream();
-
-This takes no arguments. It will perform any necessary end-of-file or
-end-of-document processing and then pop the current input stream from
-the top of the input stack.
-
-The value returned will be reference to the hash-table that represents
-the new top of the input stream stack.
-
-=end _PRIVATE_
-
-=cut
-
-sub _pop_input_stream {
- my ($self) = @_;
- local *myData = $self;
- local *input_stack = $myData{_INPUT_STREAMS};
-
- ## Perform end-of-input and/or end-of-document processing
- $self->end_input() if (@input_stack > 0);
- $self->end_pod() if (@input_stack == 1);
-
- ## Restore cutting state to whatever it was before we started
- ## parsing this file.
- my $old_top = pop(@input_stack);
- $myData{_CUTTING} = $old_top->was_cutting();
-
- ## Don't forget to reset the input indicators
- my $input_top = undef;
- if (@input_stack > 0) {
- $input_top = $myData{_TOP_STREAM} = $input_stack[-1];
- $myData{_INFILE} = $input_top->name();
- $myData{_INPUT} = $input_top->handle();
- } else {
- delete $myData{_TOP_STREAM};
- delete $myData{_INPUT_STREAMS};
- }
-
- return $input_top;
-}
-
-#############################################################################
-
-=head1 TREE-BASED PARSING
-
-If straightforward stream-based parsing wont meet your needs (as is
-likely the case for tasks such as translating PODs into structured
-markup languages like HTML and XML) then you may need to take the
-tree-based approach. Rather than doing everything in one pass and
-calling the B<interpolate()> method to expand sequences into text, it
-may be desirable to instead create a parse-tree using the B<parse_text()>
-method to return a tree-like structure which may contain an ordered
-list of children (each of which may be a text-string, or a similar
-tree-like structure).
-
-Pay special attention to L<"METHODS FOR PARSING AND PROCESSING"> and
-to the objects described in L<Pod::InputObjects>. The former describes
-the gory details and parameters for how to customize and extend the
-parsing behavior of B<Pod::Parser>. B<Pod::InputObjects> provides
-several objects that may all be used interchangeably as parse-trees. The
-most obvious one is the B<Pod::ParseTree> object. It defines the basic
-interface and functionality that all things trying to be a POD parse-tree
-should do. A B<Pod::ParseTree> is defined such that each "node" may be a
-text-string, or a reference to another parse-tree. Each B<Pod::Paragraph>
-object and each B<Pod::InteriorSequence> object also supports the basic
-parse-tree interface.
-
-The B<parse_text()> method takes a given paragraph of text, and
-returns a parse-tree that contains one or more children, each of which
-may be a text-string, or an InteriorSequence object. There are also
-callback-options that may be passed to B<parse_text()> to customize
-the way it expands or transforms interior-sequences, as well as the
-returned result. These callbacks can be used to create a parse-tree
-with custom-made objects (which may or may not support the parse-tree
-interface, depending on how you choose to do it).
-
-If you wish to turn an entire POD document into a parse-tree, that process
-is fairly straightforward. The B<parse_text()> method is the key to doing
-this successfully. Every paragraph-callback (i.e. the polymorphic methods
-for B<command()>, B<verbatim()>, and B<textblock()> paragraphs) takes
-a B<Pod::Paragraph> object as an argument. Each paragraph object has a
-B<parse_tree()> method that can be used to get or set a corresponding
-parse-tree. So for each of those paragraph-callback methods, simply call
-B<parse_text()> with the options you desire, and then use the returned
-parse-tree to assign to the given paragraph object.
-
-That gives you a parse-tree for each paragraph - so now all you need is
-an ordered list of paragraphs. You can maintain that yourself as a data
-element in the object/hash. The most straightforward way would be simply
-to use an array-ref, with the desired set of custom "options" for each
-invocation of B<parse_text>. Let's assume the desired option-set is
-given by the hash C<%options>. Then we might do something like the
-following:
-
- package MyPodParserTree;
-
- @ISA = qw( Pod::Parser );
-
- ...
-
- sub begin_pod {
- my $self = shift;
- $self->{'-paragraphs'} = []; ## initialize paragraph list
- }
-
- sub command {
- my ($parser, $command, $paragraph, $line_num, $pod_para) = @_;
- my $ptree = $parser->parse_text({%options}, $paragraph, ...);
- $pod_para->parse_tree( $ptree );
- push @{ $self->{'-paragraphs'} }, $pod_para;
- }
-
- sub verbatim {
- my ($parser, $paragraph, $line_num, $pod_para) = @_;
- push @{ $self->{'-paragraphs'} }, $pod_para;
- }
-
- sub textblock {
- my ($parser, $paragraph, $line_num, $pod_para) = @_;
- my $ptree = $parser->parse_text({%options}, $paragraph, ...);
- $pod_para->parse_tree( $ptree );
- push @{ $self->{'-paragraphs'} }, $pod_para;
- }
-
- ...
-
- package main;
- ...
- my $parser = new MyPodParserTree(...);
- $parser->parse_from_file(...);
- my $paragraphs_ref = $parser->{'-paragraphs'};
-
-Of course, in this module-author's humble opinion, I'd be more inclined to
-use the existing B<Pod::ParseTree> object than a simple array. That way
-everything in it, paragraphs and sequences, all respond to the same core
-interface for all parse-tree nodes. The result would look something like:
-
- package MyPodParserTree2;
-
- ...
-
- sub begin_pod {
- my $self = shift;
- $self->{'-ptree'} = new Pod::ParseTree; ## initialize parse-tree
- }
-
- sub parse_tree {
- ## convenience method to get/set the parse-tree for the entire POD
- (@_ > 1) and $_[0]->{'-ptree'} = $_[1];
- return $_[0]->{'-ptree'};
- }
-
- sub command {
- my ($parser, $command, $paragraph, $line_num, $pod_para) = @_;
- my $ptree = $parser->parse_text({<<options>>}, $paragraph, ...);
- $pod_para->parse_tree( $ptree );
- $parser->parse_tree()->append( $pod_para );
- }
-
- sub verbatim {
- my ($parser, $paragraph, $line_num, $pod_para) = @_;
- $parser->parse_tree()->append( $pod_para );
- }
-
- sub textblock {
- my ($parser, $paragraph, $line_num, $pod_para) = @_;
- my $ptree = $parser->parse_text({<<options>>}, $paragraph, ...);
- $pod_para->parse_tree( $ptree );
- $parser->parse_tree()->append( $pod_para );
- }
-
- ...
-
- package main;
- ...
- my $parser = new MyPodParserTree2(...);
- $parser->parse_from_file(...);
- my $ptree = $parser->parse_tree;
- ...
-
-Now you have the entire POD document as one great big parse-tree. You
-can even use the B<-expand_seq> option to B<parse_text> to insert
-whole different kinds of objects. Just don't expect B<Pod::Parser>
-to know what to do with them after that. That will need to be in your
-code. Or, alternatively, you can insert any object you like so long as
-it conforms to the B<Pod::ParseTree> interface.
-
-One could use this to create subclasses of B<Pod::Paragraphs> and
-B<Pod::InteriorSequences> for specific commands (or to create your own
-custom node-types in the parse-tree) and add some kind of B<emit()>
-method to each custom node/subclass object in the tree. Then all you'd
-need to do is recursively walk the tree in the desired order, processing
-the children (most likely from left to right) by formatting them if
-they are text-strings, or by calling their B<emit()> method if they
-are objects/references.
-
-=head1 CAVEATS
-
-Please note that POD has the notion of "paragraphs": this is something
-starting I<after> a blank (read: empty) line, with the single exception
-of the file start, which is also starting a paragraph. That means that
-especially a command (e.g. C<=head1>) I<must> be preceded with a blank
-line; C<__END__> is I<not> a blank line.
-
-=head1 SEE ALSO
-
-L<Pod::InputObjects>, L<Pod::Select>
-
-B<Pod::InputObjects> defines POD input objects corresponding to
-command paragraphs, parse-trees, and interior-sequences.
-
-B<Pod::Select> is a subclass of B<Pod::Parser> which provides the ability
-to selectively include and/or exclude sections of a POD document from being
-translated based upon the current heading, subheading, subsubheading, etc.
-
-=for __PRIVATE__
-B<Pod::Callbacks> is a subclass of B<Pod::Parser> which gives its users
-the ability the employ I<callback functions> instead of, or in addition
-to, overriding methods of the base class.
-
-=for __PRIVATE__
-B<Pod::Select> and B<Pod::Callbacks> do not override any
-methods nor do they define any new methods with the same name. Because
-of this, they may I<both> be used (in combination) as a base class of
-the same subclass in order to combine their functionality without
-causing any namespace clashes due to multiple inheritance.
-
-=head1 AUTHOR
-
-Please report bugs using L<http://rt.cpan.org>.
-
-Brad Appleton E<lt>bradapp@enteract.comE<gt>
-
-Based on code for B<Pod::Text> written by
-Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>
-
-=head1 LICENSE
-
-Pod-Parser is free software; you can redistribute it and/or modify it
-under the terms of the Artistic License distributed with Perl version
-5.000 or (at your option) any later version. Please refer to the
-Artistic License that came with your Perl distribution for more
-details. If your version of Perl was not distributed under the
-terms of the Artistic License, than you may distribute PodParser
-under the same terms as Perl itself.
-
-=cut
-
-1;
-# vim: ts=4 sw=4 et
diff --git a/Master/tlpkg/tlperl/lib/Pod/PlainText.pm b/Master/tlpkg/tlperl/lib/Pod/PlainText.pm
deleted file mode 100644
index 3db4d903cd6..00000000000
--- a/Master/tlpkg/tlperl/lib/Pod/PlainText.pm
+++ /dev/null
@@ -1,748 +0,0 @@
-# Pod::PlainText -- Convert POD data to formatted ASCII text.
-# $Id: Text.pm,v 2.1 1999/09/20 11:53:33 eagle Exp $
-#
-# Copyright 1999-2000 by Russ Allbery <rra@stanford.edu>
-#
-# This program is free software; you can redistribute it and/or modify it
-# under the same terms as Perl itself.
-#
-# This module is intended to be a replacement for Pod::Text, and attempts to
-# match its output except for some specific circumstances where other
-# decisions seemed to produce better output. It uses Pod::Parser and is
-# designed to be very easy to subclass.
-
-############################################################################
-# Modules and declarations
-############################################################################
-
-package Pod::PlainText;
-use strict;
-
-require 5.005;
-
-use Carp qw(carp croak);
-use Pod::Select ();
-
-use vars qw(@ISA %ESCAPES $VERSION);
-
-# We inherit from Pod::Select instead of Pod::Parser so that we can be used
-# by Pod::Usage.
-@ISA = qw(Pod::Select);
-
-$VERSION = '2.07';
-
-BEGIN {
- if ($] < 5.006) {
- require Symbol;
- import Symbol;
- }
-}
-
-############################################################################
-# Table of supported E<> escapes
-############################################################################
-
-# This table is taken near verbatim from Pod::PlainText in Pod::Parser,
-# which got it near verbatim from the original Pod::Text. It is therefore
-# credited to Tom Christiansen, and I'm glad I didn't have to write it. :)
-%ESCAPES = (
- 'amp' => '&', # ampersand
- 'lt' => '<', # left chevron, less-than
- 'gt' => '>', # right chevron, greater-than
- 'quot' => '"', # double quote
-
- "Aacute" => "\xC1", # capital A, acute accent
- "aacute" => "\xE1", # small a, acute accent
- "Acirc" => "\xC2", # capital A, circumflex accent
- "acirc" => "\xE2", # small a, circumflex accent
- "AElig" => "\xC6", # capital AE diphthong (ligature)
- "aelig" => "\xE6", # small ae diphthong (ligature)
- "Agrave" => "\xC0", # capital A, grave accent
- "agrave" => "\xE0", # small a, grave accent
- "Aring" => "\xC5", # capital A, ring
- "aring" => "\xE5", # small a, ring
- "Atilde" => "\xC3", # capital A, tilde
- "atilde" => "\xE3", # small a, tilde
- "Auml" => "\xC4", # capital A, dieresis or umlaut mark
- "auml" => "\xE4", # small a, dieresis or umlaut mark
- "Ccedil" => "\xC7", # capital C, cedilla
- "ccedil" => "\xE7", # small c, cedilla
- "Eacute" => "\xC9", # capital E, acute accent
- "eacute" => "\xE9", # small e, acute accent
- "Ecirc" => "\xCA", # capital E, circumflex accent
- "ecirc" => "\xEA", # small e, circumflex accent
- "Egrave" => "\xC8", # capital E, grave accent
- "egrave" => "\xE8", # small e, grave accent
- "ETH" => "\xD0", # capital Eth, Icelandic
- "eth" => "\xF0", # small eth, Icelandic
- "Euml" => "\xCB", # capital E, dieresis or umlaut mark
- "euml" => "\xEB", # small e, dieresis or umlaut mark
- "Iacute" => "\xCD", # capital I, acute accent
- "iacute" => "\xED", # small i, acute accent
- "Icirc" => "\xCE", # capital I, circumflex accent
- "icirc" => "\xEE", # small i, circumflex accent
- "Igrave" => "\xCD", # capital I, grave accent
- "igrave" => "\xED", # small i, grave accent
- "Iuml" => "\xCF", # capital I, dieresis or umlaut mark
- "iuml" => "\xEF", # small i, dieresis or umlaut mark
- "Ntilde" => "\xD1", # capital N, tilde
- "ntilde" => "\xF1", # small n, tilde
- "Oacute" => "\xD3", # capital O, acute accent
- "oacute" => "\xF3", # small o, acute accent
- "Ocirc" => "\xD4", # capital O, circumflex accent
- "ocirc" => "\xF4", # small o, circumflex accent
- "Ograve" => "\xD2", # capital O, grave accent
- "ograve" => "\xF2", # small o, grave accent
- "Oslash" => "\xD8", # capital O, slash
- "oslash" => "\xF8", # small o, slash
- "Otilde" => "\xD5", # capital O, tilde
- "otilde" => "\xF5", # small o, tilde
- "Ouml" => "\xD6", # capital O, dieresis or umlaut mark
- "ouml" => "\xF6", # small o, dieresis or umlaut mark
- "szlig" => "\xDF", # small sharp s, German (sz ligature)
- "THORN" => "\xDE", # capital THORN, Icelandic
- "thorn" => "\xFE", # small thorn, Icelandic
- "Uacute" => "\xDA", # capital U, acute accent
- "uacute" => "\xFA", # small u, acute accent
- "Ucirc" => "\xDB", # capital U, circumflex accent
- "ucirc" => "\xFB", # small u, circumflex accent
- "Ugrave" => "\xD9", # capital U, grave accent
- "ugrave" => "\xF9", # small u, grave accent
- "Uuml" => "\xDC", # capital U, dieresis or umlaut mark
- "uuml" => "\xFC", # small u, dieresis or umlaut mark
- "Yacute" => "\xDD", # capital Y, acute accent
- "yacute" => "\xFD", # small y, acute accent
- "yuml" => "\xFF", # small y, dieresis or umlaut mark
-
- "lchevron" => "\xAB", # left chevron (double less than)
- "rchevron" => "\xBB", # right chevron (double greater than)
-);
-
-
-############################################################################
-# Initialization
-############################################################################
-
-# Initialize the object. Must be sure to call our parent initializer.
-sub initialize {
- my $self = shift;
-
- $$self{alt} = 0 unless defined $$self{alt};
- $$self{indent} = 4 unless defined $$self{indent};
- $$self{loose} = 0 unless defined $$self{loose};
- $$self{sentence} = 0 unless defined $$self{sentence};
- $$self{width} = 76 unless defined $$self{width};
-
- $$self{INDENTS} = []; # Stack of indentations.
- $$self{MARGIN} = $$self{indent}; # Current left margin in spaces.
-
- return $self->SUPER::initialize;
-}
-
-
-############################################################################
-# Core overrides
-############################################################################
-
-# Called for each command paragraph. Gets the command, the associated
-# paragraph, the line number, and a Pod::Paragraph object. Just dispatches
-# the command to a method named the same as the command. =cut is handled
-# internally by Pod::Parser.
-sub command {
- my $self = shift;
- my $command = shift;
- return if $command eq 'pod';
- return if ($$self{EXCLUDE} && $command ne 'end');
- if (defined $$self{ITEM}) {
- $self->item ("\n");
- local $_ = "\n";
- $self->output($_) if($command eq 'back');
- }
- $command = 'cmd_' . $command;
- return $self->$command (@_);
-}
-
-# Called for a verbatim paragraph. Gets the paragraph, the line number, and
-# a Pod::Paragraph object. Just output it verbatim, but with tabs converted
-# to spaces.
-sub verbatim {
- my $self = shift;
- return if $$self{EXCLUDE};
- $self->item if defined $$self{ITEM};
- local $_ = shift;
- return if /^\s*$/;
- s/^(\s*\S+)/(' ' x $$self{MARGIN}) . $1/gme;
- return $self->output($_);
-}
-
-# Called for a regular text block. Gets the paragraph, the line number, and
-# a Pod::Paragraph object. Perform interpolation and output the results.
-sub textblock {
- my $self = shift;
- return if $$self{EXCLUDE};
- if($$self{VERBATIM}) {
- $self->output($_[0]);
- return;
- }
- local $_ = shift;
- my $line = shift;
-
- # Perform a little magic to collapse multiple L<> references. This is
- # here mostly for backwards-compatibility. We'll just rewrite the whole
- # thing into actual text at this part, bypassing the whole internal
- # sequence parsing thing.
- s{
- (
- L< # A link of the form L</something>.
- /
- (
- [:\w]+ # The item has to be a simple word...
- (\(\))? # ...or simple function.
- )
- >
- (
- ,?\s+(and\s+)? # Allow lots of them, conjuncted.
- L<
- /
- (
- [:\w]+
- (\(\))?
- )
- >
- )+
- )
- } {
- local $_ = $1;
- s%L</([^>]+)>%$1%g;
- my @items = split /(?:,?\s+(?:and\s+)?)/;
- my $string = "the ";
- my $i;
- for ($i = 0; $i < @items; $i++) {
- $string .= $items[$i];
- $string .= ", " if @items > 2 && $i != $#items;
- $string .= " and " if ($i == $#items - 1);
- }
- $string .= " entries elsewhere in this document";
- $string;
- }gex;
-
- # Now actually interpolate and output the paragraph.
- $_ = $self->interpolate ($_, $line);
- s/\s*$/\n/s;
- if (defined $$self{ITEM}) {
- $self->item ($_ . "\n");
- } else {
- $self->output ($self->reformat ($_ . "\n"));
- }
-}
-
-# Called for an interior sequence. Gets the command, argument, and a
-# Pod::InteriorSequence object and is expected to return the resulting text.
-# Calls code, bold, italic, file, and link to handle those types of
-# sequences, and handles S<>, E<>, X<>, and Z<> directly.
-sub interior_sequence {
- my $self = shift;
- my $command = shift;
- local $_ = shift;
- return '' if ($command eq 'X' || $command eq 'Z');
-
- # Expand escapes into the actual character now, carping if invalid.
- if ($command eq 'E') {
- return $ESCAPES{$_} if defined $ESCAPES{$_};
- carp "Unknown escape: E<$_>";
- return "E<$_>";
- }
-
- # For all the other sequences, empty content produces no output.
- return if $_ eq '';
-
- # For S<>, compress all internal whitespace and then map spaces to \01.
- # When we output the text, we'll map this back.
- if ($command eq 'S') {
- s/\s{2,}/ /g;
- tr/ /\01/;
- return $_;
- }
-
- # Anything else needs to get dispatched to another method.
- if ($command eq 'B') { return $self->seq_b ($_) }
- elsif ($command eq 'C') { return $self->seq_c ($_) }
- elsif ($command eq 'F') { return $self->seq_f ($_) }
- elsif ($command eq 'I') { return $self->seq_i ($_) }
- elsif ($command eq 'L') { return $self->seq_l ($_) }
- else { carp "Unknown sequence $command<$_>" }
-}
-
-# Called for each paragraph that's actually part of the POD. We take
-# advantage of this opportunity to untabify the input.
-sub preprocess_paragraph {
- my $self = shift;
- local $_ = shift;
- 1 while s/^(.*?)(\t+)/$1 . ' ' x (length ($2) * 8 - length ($1) % 8)/me;
- return $_;
-}
-
-
-############################################################################
-# Command paragraphs
-############################################################################
-
-# All command paragraphs take the paragraph and the line number.
-
-# First level heading.
-sub cmd_head1 {
- my $self = shift;
- local $_ = shift;
- s/\s+$//s;
- $_ = $self->interpolate ($_, shift);
- if ($$self{alt}) {
- $self->output ("\n==== $_ ====\n\n");
- } else {
- $_ .= "\n" if $$self{loose};
- $self->output ($_ . "\n");
- }
-}
-
-# Second level heading.
-sub cmd_head2 {
- my $self = shift;
- local $_ = shift;
- s/\s+$//s;
- $_ = $self->interpolate ($_, shift);
- if ($$self{alt}) {
- $self->output ("\n== $_ ==\n\n");
- } else {
- $_ .= "\n" if $$self{loose};
- $self->output (' ' x ($$self{indent} / 2) . $_ . "\n");
- }
-}
-
-# third level heading - not strictly perlpodspec compliant
-sub cmd_head3 {
- my $self = shift;
- local $_ = shift;
- s/\s+$//s;
- $_ = $self->interpolate ($_, shift);
- if ($$self{alt}) {
- $self->output ("\n= $_ =\n");
- } else {
- $_ .= "\n" if $$self{loose};
- $self->output (' ' x ($$self{indent}) . $_ . "\n");
- }
-}
-
-# fourth level heading - not strictly perlpodspec compliant
-# just like head3
-*cmd_head4 = \&cmd_head3;
-
-# Start a list.
-sub cmd_over {
- my $self = shift;
- local $_ = shift;
- unless (/^[-+]?\d+\s+$/) { $_ = $$self{indent} }
- push (@{ $$self{INDENTS} }, $$self{MARGIN});
- $$self{MARGIN} += ($_ + 0);
-}
-
-# End a list.
-sub cmd_back {
- my $self = shift;
- $$self{MARGIN} = pop @{ $$self{INDENTS} };
- unless (defined $$self{MARGIN}) {
- carp 'Unmatched =back';
- $$self{MARGIN} = $$self{indent};
- }
-}
-
-# An individual list item.
-sub cmd_item {
- my $self = shift;
- if (defined $$self{ITEM}) { $self->item }
- local $_ = shift;
- s/\s+$//s;
- $$self{ITEM} = $self->interpolate ($_);
-}
-
-# Begin a block for a particular translator. Setting VERBATIM triggers
-# special handling in textblock().
-sub cmd_begin {
- my $self = shift;
- local $_ = shift;
- my ($kind) = /^(\S+)/ or return;
- if ($kind eq 'text') {
- $$self{VERBATIM} = 1;
- } else {
- $$self{EXCLUDE} = 1;
- }
-}
-
-# End a block for a particular translator. We assume that all =begin/=end
-# pairs are properly closed.
-sub cmd_end {
- my $self = shift;
- $$self{EXCLUDE} = 0;
- $$self{VERBATIM} = 0;
-}
-
-# One paragraph for a particular translator. Ignore it unless it's intended
-# for text, in which case we treat it as a verbatim text block.
-sub cmd_for {
- my $self = shift;
- local $_ = shift;
- my $line = shift;
- return unless s/^text\b[ \t]*\r?\n?//;
- $self->verbatim ($_, $line);
-}
-
-# just a dummy method for the time being
-sub cmd_encoding {
- return;
-}
-
-############################################################################
-# Interior sequences
-############################################################################
-
-# The simple formatting ones. These are here mostly so that subclasses can
-# override them and do more complicated things.
-sub seq_b { return $_[0]{alt} ? "``$_[1]''" : $_[1] }
-sub seq_c { return $_[0]{alt} ? "``$_[1]''" : "`$_[1]'" }
-sub seq_f { return $_[0]{alt} ? "\"$_[1]\"" : $_[1] }
-sub seq_i { return '*' . $_[1] . '*' }
-
-# The complicated one. Handle links. Since this is plain text, we can't
-# actually make any real links, so this is all to figure out what text we
-# print out.
-sub seq_l {
- my $self = shift;
- local $_ = shift;
-
- # Smash whitespace in case we were split across multiple lines.
- s/\s+/ /g;
-
- # If we were given any explicit text, just output it.
- if (/^([^|]+)\|/) { return $1 }
-
- # Okay, leading and trailing whitespace isn't important; get rid of it.
- s/^\s+//;
- s/\s+$//;
-
- # Default to using the whole content of the link entry as a section
- # name. Note that L<manpage/> forces a manpage interpretation, as does
- # something looking like L<manpage(section)>. The latter is an
- # enhancement over the original Pod::Text.
- my ($manpage, $section) = ('', $_);
- if (/^(?:https?|ftp|news):/) {
- # a URL
- return $_;
- } elsif (/^"\s*(.*?)\s*"$/) {
- $section = '"' . $1 . '"';
- } elsif (m/^[-:.\w]+(?:\(\S+\))?$/) {
- ($manpage, $section) = ($_, '');
- } elsif (m{/}) {
- ($manpage, $section) = split (/\s*\/\s*/, $_, 2);
- }
-
- my $text = '';
- # Now build the actual output text.
- if (!length $section) {
- $text = "the $manpage manpage" if length $manpage;
- } elsif ($section =~ /^[:\w]+(?:\(\))?/) {
- $text .= 'the ' . $section . ' entry';
- $text .= (length $manpage) ? " in the $manpage manpage"
- : ' elsewhere in this document';
- } else {
- $section =~ s/^\"\s*//;
- $section =~ s/\s*\"$//;
- $text .= 'the section on "' . $section . '"';
- $text .= " in the $manpage manpage" if length $manpage;
- }
- return $text;
-}
-
-
-############################################################################
-# List handling
-############################################################################
-
-# This method is called whenever an =item command is complete (in other
-# words, we've seen its associated paragraph or know for certain that it
-# doesn't have one). It gets the paragraph associated with the item as an
-# argument. If that argument is empty, just output the item tag; if it
-# contains a newline, output the item tag followed by the newline.
-# Otherwise, see if there's enough room for us to output the item tag in the
-# margin of the text or if we have to put it on a separate line.
-sub item {
- my $self = shift;
- local $_ = shift;
- my $tag = $$self{ITEM};
- unless (defined $tag) {
- carp 'item called without tag';
- return;
- }
- undef $$self{ITEM};
- my $indent = $$self{INDENTS}[-1];
- unless (defined $indent) { $indent = $$self{indent} }
- my $space = ' ' x $indent;
- $space =~ s/^ /:/ if $$self{alt};
- if (!$_ || /^\s+$/ || ($$self{MARGIN} - $indent < length ($tag) + 1)) {
- my $margin = $$self{MARGIN};
- $$self{MARGIN} = $indent;
- my $output = $self->reformat ($tag);
- $output =~ s/[\r\n]*$/\n/;
- $self->output ($output);
- $$self{MARGIN} = $margin;
- $self->output ($self->reformat ($_)) if /\S/;
- } else {
- $_ = $self->reformat ($_);
- s/^ /:/ if ($$self{alt} && $indent > 0);
- my $tagspace = ' ' x length $tag;
- s/^($space)$tagspace/$1$tag/ or carp 'Bizarre space in item';
- $self->output ($_);
- }
-}
-
-
-############################################################################
-# Output formatting
-############################################################################
-
-# Wrap a line, indenting by the current left margin. We can't use
-# Text::Wrap because it plays games with tabs. We can't use formline, even
-# though we'd really like to, because it screws up non-printing characters.
-# So we have to do the wrapping ourselves.
-sub wrap {
- my $self = shift;
- local $_ = shift;
- my $output = '';
- my $spaces = ' ' x $$self{MARGIN};
- my $width = $$self{width} - $$self{MARGIN};
- while (length > $width) {
- if (s/^([^\r\n]{0,$width})\s+// || s/^([^\r\n]{$width})//) {
- $output .= $spaces . $1 . "\n";
- } else {
- last;
- }
- }
- $output .= $spaces . $_;
- $output =~ s/\s+$/\n\n/;
- return $output;
-}
-
-# Reformat a paragraph of text for the current margin. Takes the text to
-# reformat and returns the formatted text.
-sub reformat {
- my $self = shift;
- local $_ = shift;
-
- # If we're trying to preserve two spaces after sentences, do some
- # munging to support that. Otherwise, smash all repeated whitespace.
- if ($$self{sentence}) {
- s/ +$//mg;
- s/\.\r?\n/. \n/g;
- s/[\r\n]+/ /g;
- s/ +/ /g;
- } else {
- s/\s+/ /g;
- }
- return $self->wrap($_);
-}
-
-# Output text to the output device.
-sub output { $_[1] =~ tr/\01/ /; print { $_[0]->output_handle } $_[1] }
-
-
-############################################################################
-# Backwards compatibility
-############################################################################
-
-# The old Pod::Text module did everything in a pod2text() function. This
-# tries to provide the same interface for legacy applications.
-sub pod2text {
- my @args;
-
- # This is really ugly; I hate doing option parsing in the middle of a
- # module. But the old Pod::Text module supported passing flags to its
- # entry function, so handle -a and -<number>.
- while ($_[0] =~ /^-/) {
- my $flag = shift;
- if ($flag eq '-a') { push (@args, alt => 1) }
- elsif ($flag =~ /^-(\d+)$/) { push (@args, width => $1) }
- else {
- unshift (@_, $flag);
- last;
- }
- }
-
- # Now that we know what arguments we're using, create the parser.
- my $parser = Pod::PlainText->new (@args);
-
- # If two arguments were given, the second argument is going to be a file
- # handle. That means we want to call parse_from_filehandle(), which
- # means we need to turn the first argument into a file handle. Magic
- # open will handle the <&STDIN case automagically.
- if (defined $_[1]) {
- my $infh;
- if ($] < 5.006) {
- $infh = gensym();
- }
- unless (open ($infh, $_[0])) {
- croak ("Can't open $_[0] for reading: $!\n");
- }
- $_[0] = $infh;
- return $parser->parse_from_filehandle (@_);
- } else {
- return $parser->parse_from_file (@_);
- }
-}
-
-
-############################################################################
-# Module return value and documentation
-############################################################################
-
-1;
-__END__
-
-=head1 NAME
-
-Pod::PlainText - Convert POD data to formatted ASCII text
-
-=head1 SYNOPSIS
-
- use Pod::PlainText;
- my $parser = Pod::PlainText->new (sentence => 0, width => 78);
-
- # Read POD from STDIN and write to STDOUT.
- $parser->parse_from_filehandle;
-
- # Read POD from file.pod and write to file.txt.
- $parser->parse_from_file ('file.pod', 'file.txt');
-
-=head1 DESCRIPTION
-
-B<NOTE: This module is considered legacy; modern Perl releases (5.18 and
-higher) are going to remove Pod-Parser from core and use L<Pod-Simple>
-for all things POD.>
-
-Pod::PlainText is a module that can convert documentation in the POD format (the
-preferred language for documenting Perl) into formatted ASCII. It uses no
-special formatting controls or codes whatsoever, and its output is therefore
-suitable for nearly any device.
-
-As a derived class from Pod::Parser, Pod::PlainText supports the same methods and
-interfaces. See L<Pod::Parser> for all the details; briefly, one creates a
-new parser with C<Pod::PlainText-E<gt>new()> and then calls either
-parse_from_filehandle() or parse_from_file().
-
-new() can take options, in the form of key/value pairs, that control the
-behavior of the parser. The currently recognized options are:
-
-=over 4
-
-=item alt
-
-If set to a true value, selects an alternate output format that, among other
-things, uses a different heading style and marks C<=item> entries with a
-colon in the left margin. Defaults to false.
-
-=item indent
-
-The number of spaces to indent regular text, and the default indentation for
-C<=over> blocks. Defaults to 4.
-
-=item loose
-
-If set to a true value, a blank line is printed after a C<=headN> headings.
-If set to false (the default), no blank line is printed after C<=headN>.
-This is the default because it's the expected formatting for manual pages;
-if you're formatting arbitrary text documents, setting this to true may
-result in more pleasing output.
-
-=item sentence
-
-If set to a true value, Pod::PlainText will assume that each sentence ends in two
-spaces, and will try to preserve that spacing. If set to false, all
-consecutive whitespace in non-verbatim paragraphs is compressed into a
-single space. Defaults to true.
-
-=item width
-
-The column at which to wrap text on the right-hand side. Defaults to 76.
-
-=back
-
-The standard Pod::Parser method parse_from_filehandle() takes up to two
-arguments, the first being the file handle to read POD from and the second
-being the file handle to write the formatted output to. The first defaults
-to STDIN if not given, and the second defaults to STDOUT. The method
-parse_from_file() is almost identical, except that its two arguments are the
-input and output disk files instead. See L<Pod::Parser> for the specific
-details.
-
-=head1 DIAGNOSTICS
-
-=over 4
-
-=item Bizarre space in item
-
-(W) Something has gone wrong in internal C<=item> processing. This message
-indicates a bug in Pod::PlainText; you should never see it.
-
-=item Can't open %s for reading: %s
-
-(F) Pod::PlainText was invoked via the compatibility mode pod2text() interface
-and the input file it was given could not be opened.
-
-=item Unknown escape: %s
-
-(W) The POD source contained an C<EE<lt>E<gt>> escape that Pod::PlainText didn't
-know about.
-
-=item Unknown sequence: %s
-
-(W) The POD source contained a non-standard internal sequence (something of
-the form C<XE<lt>E<gt>>) that Pod::PlainText didn't know about.
-
-=item Unmatched =back
-
-(W) Pod::PlainText encountered a C<=back> command that didn't correspond to an
-C<=over> command.
-
-=back
-
-=head1 RESTRICTIONS
-
-Embedded Ctrl-As (octal 001) in the input will be mapped to spaces on
-output, due to an internal implementation detail.
-
-=head1 NOTES
-
-This is a replacement for an earlier Pod::Text module written by Tom
-Christiansen. It has a revamped interface, since it now uses Pod::Parser,
-but an interface roughly compatible with the old Pod::Text::pod2text()
-function is still available. Please change to the new calling convention,
-though.
-
-The original Pod::Text contained code to do formatting via termcap
-sequences, although it wasn't turned on by default and it was problematic to
-get it to work at all. This rewrite doesn't even try to do that, but a
-subclass of it does. Look for L<Pod::Text::Termcap|Pod::Text::Termcap>.
-
-=head1 SEE ALSO
-
-B<Pod::PlainText> is part of the L<Pod::Parser> distribution.
-
-L<Pod::Parser|Pod::Parser>, L<Pod::Text::Termcap|Pod::Text::Termcap>,
-pod2text(1)
-
-=head1 AUTHOR
-
-Please report bugs using L<http://rt.cpan.org>.
-
-Russ Allbery E<lt>rra@stanford.eduE<gt>, based I<very> heavily on the
-original Pod::Text by Tom Christiansen E<lt>tchrist@mox.perl.comE<gt> and
-its conversion to Pod::Parser by Brad Appleton
-E<lt>bradapp@enteract.comE<gt>.
-
-=cut
diff --git a/Master/tlpkg/tlperl/lib/Pod/Select.pm b/Master/tlpkg/tlperl/lib/Pod/Select.pm
deleted file mode 100644
index 70267e94ec0..00000000000
--- a/Master/tlpkg/tlperl/lib/Pod/Select.pm
+++ /dev/null
@@ -1,756 +0,0 @@
-#############################################################################
-# Pod/Select.pm -- function to select portions of POD docs
-#
-# Copyright (C) 1996-2000 by Bradford Appleton. All rights reserved.
-# This file is part of "PodParser". PodParser is free software;
-# you can redistribute it and/or modify it under the same terms
-# as Perl itself.
-#############################################################################
-
-package Pod::Select;
-use strict;
-
-use vars qw($VERSION @ISA @EXPORT $MAX_HEADING_LEVEL %myData @section_headings @selected_sections);
-$VERSION = '1.63'; ## Current version of this package
-require 5.005; ## requires this Perl version or later
-
-#############################################################################
-
-=head1 NAME
-
-Pod::Select, podselect() - extract selected sections of POD from input
-
-=head1 SYNOPSIS
-
- use Pod::Select;
-
- ## Select all the POD sections for each file in @filelist
- ## and print the result on standard output.
- podselect(@filelist);
-
- ## Same as above, but write to tmp.out
- podselect({-output => "tmp.out"}, @filelist):
-
- ## Select from the given filelist, only those POD sections that are
- ## within a 1st level section named any of: NAME, SYNOPSIS, OPTIONS.
- podselect({-sections => ["NAME|SYNOPSIS", "OPTIONS"]}, @filelist):
-
- ## Select the "DESCRIPTION" section of the PODs from STDIN and write
- ## the result to STDERR.
- podselect({-output => ">&STDERR", -sections => ["DESCRIPTION"]}, \*STDIN);
-
-or
-
- use Pod::Select;
-
- ## Create a parser object for selecting POD sections from the input
- $parser = new Pod::Select();
-
- ## Select all the POD sections for each file in @filelist
- ## and print the result to tmp.out.
- $parser->parse_from_file("<&STDIN", "tmp.out");
-
- ## Select from the given filelist, only those POD sections that are
- ## within a 1st level section named any of: NAME, SYNOPSIS, OPTIONS.
- $parser->select("NAME|SYNOPSIS", "OPTIONS");
- for (@filelist) { $parser->parse_from_file($_); }
-
- ## Select the "DESCRIPTION" and "SEE ALSO" sections of the PODs from
- ## STDIN and write the result to STDERR.
- $parser->select("DESCRIPTION");
- $parser->add_selection("SEE ALSO");
- $parser->parse_from_filehandle(\*STDIN, \*STDERR);
-
-=head1 REQUIRES
-
-perl5.005, Pod::Parser, Exporter, Carp
-
-=head1 EXPORTS
-
-podselect()
-
-=head1 DESCRIPTION
-
-B<NOTE: This module is considered legacy; modern Perl releases (5.18 and
-higher) are going to remove Pod-Parser from core and use L<Pod-Simple>
-for all things POD.>
-
-B<podselect()> is a function which will extract specified sections of
-pod documentation from an input stream. This ability is provided by the
-B<Pod::Select> module which is a subclass of B<Pod::Parser>.
-B<Pod::Select> provides a method named B<select()> to specify the set of
-POD sections to select for processing/printing. B<podselect()> merely
-creates a B<Pod::Select> object and then invokes the B<podselect()>
-followed by B<parse_from_file()>.
-
-=head1 SECTION SPECIFICATIONS
-
-B<podselect()> and B<Pod::Select::select()> may be given one or more
-"section specifications" to restrict the text processed to only the
-desired set of sections and their corresponding subsections. A section
-specification is a string containing one or more Perl-style regular
-expressions separated by forward slashes ("/"). If you need to use a
-forward slash literally within a section title you can escape it with a
-backslash ("\/").
-
-The formal syntax of a section specification is:
-
-=over 4
-
-=item *
-
-I<head1-title-regex>/I<head2-title-regex>/...
-
-=back
-
-Any omitted or empty regular expressions will default to ".*".
-Please note that each regular expression given is implicitly
-anchored by adding "^" and "$" to the beginning and end. Also, if a
-given regular expression starts with a "!" character, then the
-expression is I<negated> (so C<!foo> would match anything I<except>
-C<foo>).
-
-Some example section specifications follow.
-
-=over 4
-
-=item *
-
-Match the C<NAME> and C<SYNOPSIS> sections and all of their subsections:
-
-C<NAME|SYNOPSIS>
-
-=item *
-
-Match only the C<Question> and C<Answer> subsections of the C<DESCRIPTION>
-section:
-
-C<DESCRIPTION/Question|Answer>
-
-=item *
-
-Match the C<Comments> subsection of I<all> sections:
-
-C</Comments>
-
-=item *
-
-Match all subsections of C<DESCRIPTION> I<except> for C<Comments>:
-
-C<DESCRIPTION/!Comments>
-
-=item *
-
-Match the C<DESCRIPTION> section but do I<not> match any of its subsections:
-
-C<DESCRIPTION/!.+>
-
-=item *
-
-Match all top level sections but none of their subsections:
-
-C</!.+>
-
-=back
-
-=begin _NOT_IMPLEMENTED_
-
-=head1 RANGE SPECIFICATIONS
-
-B<podselect()> and B<Pod::Select::select()> may be given one or more
-"range specifications" to restrict the text processed to only the
-desired ranges of paragraphs in the desired set of sections. A range
-specification is a string containing a single Perl-style regular
-expression (a regex), or else two Perl-style regular expressions
-(regexs) separated by a ".." (Perl's "range" operator is "..").
-The regexs in a range specification are delimited by forward slashes
-("/"). If you need to use a forward slash literally within a regex you
-can escape it with a backslash ("\/").
-
-The formal syntax of a range specification is:
-
-=over 4
-
-=item *
-
-/I<start-range-regex>/[../I<end-range-regex>/]
-
-=back
-
-Where each the item inside square brackets (the ".." followed by the
-end-range-regex) is optional. Each "range-regex" is of the form:
-
- =cmd-expr text-expr
-
-Where I<cmd-expr> is intended to match the name of one or more POD
-commands, and I<text-expr> is intended to match the paragraph text for
-the command. If a range-regex is supposed to match a POD command, then
-the first character of the regex (the one after the initial '/')
-absolutely I<must> be a single '=' character; it may not be anything
-else (not even a regex meta-character) if it is supposed to match
-against the name of a POD command.
-
-If no I<=cmd-expr> is given then the text-expr will be matched against
-plain textblocks unless it is preceded by a space, in which case it is
-matched against verbatim text-blocks. If no I<text-expr> is given then
-only the command-portion of the paragraph is matched against.
-
-Note that these two expressions are each implicitly anchored. This
-means that when matching against the command-name, there will be an
-implicit '^' and '$' around the given I<=cmd-expr>; and when matching
-against the paragraph text there will be an implicit '\A' and '\Z'
-around the given I<text-expr>.
-
-Unlike with section-specs, the '!' character does I<not> have any special
-meaning (negation or otherwise) at the beginning of a range-spec!
-
-Some example range specifications follow.
-
-=over 4
-
-=item
-Match all C<=for html> paragraphs:
-
-C</=for html/>
-
-=item
-Match all paragraphs between C<=begin html> and C<=end html>
-(note that this will I<not> work correctly if such sections
-are nested):
-
-C</=begin html/../=end html/>
-
-=item
-Match all paragraphs between the given C<=item> name until the end of the
-current section:
-
-C</=item mine/../=head\d/>
-
-=item
-Match all paragraphs between the given C<=item> until the next item, or
-until the end of the itemized list (note that this will I<not> work as
-desired if the item contains an itemized list nested within it):
-
-C</=item mine/../=(item|back)/>
-
-=back
-
-=end _NOT_IMPLEMENTED_
-
-=cut
-
-#############################################################################
-
-#use diagnostics;
-use Carp;
-use Pod::Parser 1.04;
-
-@ISA = qw(Pod::Parser);
-@EXPORT = qw(&podselect);
-
-## Maximum number of heading levels supported for '=headN' directives
-*MAX_HEADING_LEVEL = \3;
-
-#############################################################################
-
-=head1 OBJECT METHODS
-
-The following methods are provided in this module. Each one takes a
-reference to the object itself as an implicit first parameter.
-
-=cut
-
-##---------------------------------------------------------------------------
-
-## =begin _PRIVATE_
-##
-## =head1 B<_init_headings()>
-##
-## Initialize the current set of active section headings.
-##
-## =cut
-##
-## =end _PRIVATE_
-
-sub _init_headings {
- my $self = shift;
- local *myData = $self;
-
- ## Initialize current section heading titles if necessary
- unless (defined $myData{_SECTION_HEADINGS}) {
- local *section_headings = $myData{_SECTION_HEADINGS} = [];
- for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) {
- $section_headings[$i] = '';
- }
- }
-}
-
-##---------------------------------------------------------------------------
-
-=head1 B<curr_headings()>
-
- ($head1, $head2, $head3, ...) = $parser->curr_headings();
- $head1 = $parser->curr_headings(1);
-
-This method returns a list of the currently active section headings and
-subheadings in the document being parsed. The list of headings returned
-corresponds to the most recently parsed paragraph of the input.
-
-If an argument is given, it must correspond to the desired section
-heading number, in which case only the specified section heading is
-returned. If there is no current section heading at the specified
-level, then C<undef> is returned.
-
-=cut
-
-sub curr_headings {
- my $self = shift;
- $self->_init_headings() unless (defined $self->{_SECTION_HEADINGS});
- my @headings = @{ $self->{_SECTION_HEADINGS} };
- return (@_ > 0 and $_[0] =~ /^\d+$/) ? $headings[$_[0] - 1] : @headings;
-}
-
-##---------------------------------------------------------------------------
-
-=head1 B<select()>
-
- $parser->select($section_spec1,$section_spec2,...);
-
-This method is used to select the particular sections and subsections of
-POD documentation that are to be printed and/or processed. The existing
-set of selected sections is I<replaced> with the given set of sections.
-See B<add_selection()> for adding to the current set of selected
-sections.
-
-Each of the C<$section_spec> arguments should be a section specification
-as described in L<"SECTION SPECIFICATIONS">. The section specifications
-are parsed by this method and the resulting regular expressions are
-stored in the invoking object.
-
-If no C<$section_spec> arguments are given, then the existing set of
-selected sections is cleared out (which means C<all> sections will be
-processed).
-
-This method should I<not> normally be overridden by subclasses.
-
-=cut
-
-sub select {
- my ($self, @sections) = @_;
- local *myData = $self;
- local $_;
-
-### NEED TO DISCERN A SECTION-SPEC FROM A RANGE-SPEC (look for m{^/.+/$}?)
-
- ##---------------------------------------------------------------------
- ## The following is a blatant hack for backward compatibility, and for
- ## implementing add_selection(). If the *first* *argument* is the
- ## string "+", then the remaining section specifications are *added*
- ## to the current set of selections; otherwise the given section
- ## specifications will *replace* the current set of selections.
- ##
- ## This should probably be fixed someday, but for the present time,
- ## it seems incredibly unlikely that "+" would ever correspond to
- ## a legitimate section heading
- ##---------------------------------------------------------------------
- my $add = ($sections[0] eq '+') ? shift(@sections) : '';
-
- ## Reset the set of sections to use
- unless (@sections) {
- delete $myData{_SELECTED_SECTIONS} unless ($add);
- return;
- }
- $myData{_SELECTED_SECTIONS} = []
- unless ($add && exists $myData{_SELECTED_SECTIONS});
- local *selected_sections = $myData{_SELECTED_SECTIONS};
-
- ## Compile each spec
- for my $spec (@sections) {
- if ( defined($_ = _compile_section_spec($spec)) ) {
- ## Store them in our sections array
- push(@selected_sections, $_);
- }
- else {
- carp qq{Ignoring section spec "$spec"!\n};
- }
- }
-}
-
-##---------------------------------------------------------------------------
-
-=head1 B<add_selection()>
-
- $parser->add_selection($section_spec1,$section_spec2,...);
-
-This method is used to add to the currently selected sections and
-subsections of POD documentation that are to be printed and/or
-processed. See <select()> for replacing the currently selected sections.
-
-Each of the C<$section_spec> arguments should be a section specification
-as described in L<"SECTION SPECIFICATIONS">. The section specifications
-are parsed by this method and the resulting regular expressions are
-stored in the invoking object.
-
-This method should I<not> normally be overridden by subclasses.
-
-=cut
-
-sub add_selection {
- my $self = shift;
- return $self->select('+', @_);
-}
-
-##---------------------------------------------------------------------------
-
-=head1 B<clear_selections()>
-
- $parser->clear_selections();
-
-This method takes no arguments, it has the exact same effect as invoking
-<select()> with no arguments.
-
-=cut
-
-sub clear_selections {
- my $self = shift;
- return $self->select();
-}
-
-##---------------------------------------------------------------------------
-
-=head1 B<match_section()>
-
- $boolean = $parser->match_section($heading1,$heading2,...);
-
-Returns a value of true if the given section and subsection heading
-titles match any of the currently selected section specifications in
-effect from prior calls to B<select()> and B<add_selection()> (or if
-there are no explicitly selected/deselected sections).
-
-The arguments C<$heading1>, C<$heading2>, etc. are the heading titles of
-the corresponding sections, subsections, etc. to try and match. If
-C<$headingN> is omitted then it defaults to the current corresponding
-section heading title in the input.
-
-This method should I<not> normally be overridden by subclasses.
-
-=cut
-
-sub match_section {
- my $self = shift;
- my (@headings) = @_;
- local *myData = $self;
-
- ## Return true if no restrictions were explicitly specified
- my $selections = (exists $myData{_SELECTED_SECTIONS})
- ? $myData{_SELECTED_SECTIONS} : undef;
- return 1 unless ((defined $selections) && @{$selections});
-
- ## Default any unspecified sections to the current one
- my @current_headings = $self->curr_headings();
- for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) {
- (defined $headings[$i]) or $headings[$i] = $current_headings[$i];
- }
-
- ## Look for a match against the specified section expressions
- for my $section_spec ( @{$selections} ) {
- ##------------------------------------------------------
- ## Each portion of this spec must match in order for
- ## the spec to be matched. So we will start with a
- ## match-value of 'true' and logically 'and' it with
- ## the results of matching a given element of the spec.
- ##------------------------------------------------------
- my $match = 1;
- for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) {
- my $regex = $section_spec->[$i];
- my $negated = ($regex =~ s/^\!//);
- $match &= ($negated ? ($headings[$i] !~ /${regex}/)
- : ($headings[$i] =~ /${regex}/));
- last unless ($match);
- }
- return 1 if ($match);
- }
- return 0; ## no match
-}
-
-##---------------------------------------------------------------------------
-
-=head1 B<is_selected()>
-
- $boolean = $parser->is_selected($paragraph);
-
-This method is used to determine if the block of text given in
-C<$paragraph> falls within the currently selected set of POD sections
-and subsections to be printed or processed. This method is also
-responsible for keeping track of the current input section and
-subsections. It is assumed that C<$paragraph> is the most recently read
-(but not yet processed) input paragraph.
-
-The value returned will be true if the C<$paragraph> and the rest of the
-text in the same section as C<$paragraph> should be selected (included)
-for processing; otherwise a false value is returned.
-
-=cut
-
-sub is_selected {
- my ($self, $paragraph) = @_;
- local $_;
- local *myData = $self;
-
- $self->_init_headings() unless (defined $myData{_SECTION_HEADINGS});
-
- ## Keep track of current sections levels and headings
- $_ = $paragraph;
- if (/^=((?:sub)*)(?:head(?:ing)?|sec(?:tion)?)(\d*)\s+(.*?)\s*$/)
- {
- ## This is a section heading command
- my ($level, $heading) = ($2, $3);
- $level = 1 + (length($1) / 3) if ((! length $level) || (length $1));
- ## Reset the current section heading at this level
- $myData{_SECTION_HEADINGS}->[$level - 1] = $heading;
- ## Reset subsection headings of this one to empty
- for (my $i = $level; $i < $MAX_HEADING_LEVEL; ++$i) {
- $myData{_SECTION_HEADINGS}->[$i] = '';
- }
- }
-
- return $self->match_section();
-}
-
-#############################################################################
-
-=head1 EXPORTED FUNCTIONS
-
-The following functions are exported by this module. Please note that
-these are functions (not methods) and therefore C<do not> take an
-implicit first argument.
-
-=cut
-
-##---------------------------------------------------------------------------
-
-=head1 B<podselect()>
-
- podselect(\%options,@filelist);
-
-B<podselect> will print the raw (untranslated) POD paragraphs of all
-POD sections in the given input files specified by C<@filelist>
-according to the options given in C<\%options>.
-
-If any argument to B<podselect> is a reference to a hash
-(associative array) then the values with the following keys are
-processed as follows:
-
-=over 4
-
-=item B<-output>
-
-A string corresponding to the desired output file (or ">&STDOUT"
-or ">&STDERR"), or a filehandle to write on. The default is to use
-standard output.
-
-=item B<-sections>
-
-A reference to an array of sections specifications (as described in
-L<"SECTION SPECIFICATIONS">) which indicate the desired set of POD
-sections and subsections to be selected from input. If no section
-specifications are given, then all sections of the PODs are used.
-
-=begin _NOT_IMPLEMENTED_
-
-=item B<-ranges>
-
-A reference to an array of range specifications (as described in
-L<"RANGE SPECIFICATIONS">) which indicate the desired range of POD
-paragraphs to be selected from the desired input sections. If no range
-specifications are given, then all paragraphs of the desired sections
-are used.
-
-=end _NOT_IMPLEMENTED_
-
-=back
-
-All other arguments are optional and should correspond to filehandles to
-read from or the names of input files containing POD sections. A file name
-of "", "-" or "<&STDIN" will be interpreted to mean standard input (which
-is the default if no arguments are given).
-
-=cut
-
-sub podselect {
- my(@argv) = @_;
- my %defaults = ();
- my $pod_parser = new Pod::Select(%defaults);
- my $num_inputs = 0;
- my $output = '>&STDOUT';
- my %opts;
- local $_;
- for (@argv) {
- my $ref = ref($_);
- if ($ref && $ref eq 'HASH') {
- %opts = (%defaults, %{$_});
-
- ##-------------------------------------------------------------
- ## Need this for backward compatibility since we formerly used
- ## options that were all uppercase words rather than ones that
- ## looked like Unix command-line options.
- ## to be uppercase keywords)
- ##-------------------------------------------------------------
- %opts = map {
- my ($key, $val) = (lc $_, $opts{$_});
- $key =~ s/^(?=\w)/-/;
- $key =~ /^-se[cl]/ and $key = '-sections';
- #! $key eq '-range' and $key .= 's';
- ($key => $val);
- } (keys %opts);
-
- ## Process the options
- (exists $opts{'-output'}) and $output = $opts{'-output'};
-
- ## Select the desired sections
- $pod_parser->select(@{ $opts{'-sections'} })
- if ( (defined $opts{'-sections'})
- && ((ref $opts{'-sections'}) eq 'ARRAY') );
-
- #! ## Select the desired paragraph ranges
- #! $pod_parser->select(@{ $opts{'-ranges'} })
- #! if ( (defined $opts{'-ranges'})
- #! && ((ref $opts{'-ranges'}) eq 'ARRAY') );
- }
- elsif(!$ref || $ref eq 'GLOB') {
- $pod_parser->parse_from_file($_, $output);
- ++$num_inputs;
- }
- else {
- croak "Input from $ref reference not supported!\n";
- }
- }
- $pod_parser->parse_from_file('-') unless ($num_inputs > 0);
-}
-
-#############################################################################
-
-=head1 PRIVATE METHODS AND DATA
-
-B<Pod::Select> makes uses a number of internal methods and data fields
-which clients should not need to see or use. For the sake of avoiding
-name collisions with client data and methods, these methods and fields
-are briefly discussed here. Determined hackers may obtain further
-information about them by reading the B<Pod::Select> source code.
-
-Private data fields are stored in the hash-object whose reference is
-returned by the B<new()> constructor for this class. The names of all
-private methods and data-fields used by B<Pod::Select> begin with a
-prefix of "_" and match the regular expression C</^_\w+$/>.
-
-=cut
-
-##---------------------------------------------------------------------------
-
-=begin _PRIVATE_
-
-=head1 B<_compile_section_spec()>
-
- $listref = $parser->_compile_section_spec($section_spec);
-
-This function (note it is a function and I<not> a method) takes a
-section specification (as described in L<"SECTION SPECIFICATIONS">)
-given in C<$section_sepc>, and compiles it into a list of regular
-expressions. If C<$section_spec> has no syntax errors, then a reference
-to the list (array) of corresponding regular expressions is returned;
-otherwise C<undef> is returned and an error message is printed (using
-B<carp>) for each invalid regex.
-
-=end _PRIVATE_
-
-=cut
-
-sub _compile_section_spec {
- my ($section_spec) = @_;
- my (@regexs, $negated);
-
- ## Compile the spec into a list of regexs
- local $_ = $section_spec;
- s{\\\\}{\001}g; ## handle escaped backward slashes
- s{\\/}{\002}g; ## handle escaped forward slashes
-
- ## Parse the regexs for the heading titles
- @regexs = split(/\//, $_, $MAX_HEADING_LEVEL);
-
- ## Set default regex for omitted levels
- for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) {
- $regexs[$i] = '.*' unless ((defined $regexs[$i])
- && (length $regexs[$i]));
- }
- ## Modify the regexs as needed and validate their syntax
- my $bad_regexs = 0;
- for (@regexs) {
- $_ .= '.+' if ($_ eq '!');
- s{\001}{\\\\}g; ## restore escaped backward slashes
- s{\002}{\\/}g; ## restore escaped forward slashes
- $negated = s/^\!//; ## check for negation
- eval "m{$_}"; ## check regex syntax
- if ($@) {
- ++$bad_regexs;
- carp qq{Bad regular expression /$_/ in "$section_spec": $@\n};
- }
- else {
- ## Add the forward and rear anchors (and put the negator back)
- $_ = '^' . $_ unless (/^\^/);
- $_ = $_ . '$' unless (/\$$/);
- $_ = '!' . $_ if ($negated);
- }
- }
- return (! $bad_regexs) ? [ @regexs ] : undef;
-}
-
-##---------------------------------------------------------------------------
-
-=begin _PRIVATE_
-
-=head2 $self->{_SECTION_HEADINGS}
-
-A reference to an array of the current section heading titles for each
-heading level (note that the first heading level title is at index 0).
-
-=end _PRIVATE_
-
-=cut
-
-##---------------------------------------------------------------------------
-
-=begin _PRIVATE_
-
-=head2 $self->{_SELECTED_SECTIONS}
-
-A reference to an array of references to arrays. Each subarray is a list
-of anchored regular expressions (preceded by a "!" if the expression is to
-be negated). The index of the expression in the subarray should correspond
-to the index of the heading title in C<$self-E<gt>{_SECTION_HEADINGS}>
-that it is to be matched against.
-
-=end _PRIVATE_
-
-=cut
-
-#############################################################################
-
-=head1 SEE ALSO
-
-L<Pod::Parser>
-
-=head1 AUTHOR
-
-Please report bugs using L<http://rt.cpan.org>.
-
-Brad Appleton E<lt>bradapp@enteract.comE<gt>
-
-Based on code for B<pod2text> written by
-Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>
-
-B<Pod::Select> is part of the L<Pod::Parser> distribution.
-
-=cut
-
-1;
-# vim: ts=4 sw=4 et
diff --git a/Master/tlpkg/tlperl/lib/Pod/Simple.pm b/Master/tlpkg/tlperl/lib/Pod/Simple.pm
index 20924153b65..6c91b8ac1fb 100644
--- a/Master/tlpkg/tlperl/lib/Pod/Simple.pm
+++ b/Master/tlpkg/tlperl/lib/Pod/Simple.pm
@@ -18,7 +18,7 @@ use vars qw(
);
@ISA = ('Pod::Simple::BlackBox');
-$VERSION = '3.35';
+$VERSION = '3.40';
@Known_formatting_codes = qw(I B C L E F S X Z);
%Known_formatting_codes = map(($_=>1), @Known_formatting_codes);
@@ -74,6 +74,9 @@ else { # EBCDIC on early Perl. We know what the values are for the code
#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
__PACKAGE__->_accessorize(
+ '_output_is_for_JustPod', # For use only by Pod::Simple::JustPod,
+ # If non-zero, don't expand Z<> E<> S<> L<>,
+ # and count how many brackets in format codes
'nbsp_for_S', # Whether to map S<...>'s to \xA0 characters
'source_filename', # Filename of the source, for use in warnings
'source_dead', # Whether to consider this parser's source dead
@@ -103,6 +106,8 @@ __PACKAGE__->_accessorize(
'preserve_whitespace', # whether to try to keep whitespace as-is
'strip_verbatim_indent', # What indent to strip from verbatim
+ 'expand_verbatim_tabs', # 0: preserve tabs in verbatim blocks
+ # n: expand tabs to stops every n columns
'parse_characters', # Whether parser should expect chars rather than octets
@@ -168,6 +173,7 @@ sub encoding {
BEGIN {
*pretty = \&Pod::Simple::BlackBox::pretty;
*stringify_lol = \&Pod::Simple::BlackBox::stringify_lol;
+ *my_qr = \&Pod::Simple::BlackBox::my_qr;
}
#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@@ -219,11 +225,14 @@ sub new {
my $class = ref($_[0]) || $_[0];
#Carp::croak(__PACKAGE__ . " is a virtual base class -- see perldoc "
# . __PACKAGE__ );
- return bless {
+ my $obj = bless {
'accept_codes' => { map( ($_=>$_), @Known_formatting_codes ) },
'accept_directives' => { %Known_directives },
'accept_targets' => {},
}, $class;
+
+ $obj->expand_verbatim_tabs(8);
+ return $obj;
}
@@ -339,10 +348,9 @@ sub unaccept_targets {
# XXX Probably it is an error that the digit '9' is excluded from these re's.
# Broken for early Perls on EBCDIC
-my $xml_name_re = eval "qr/[^-.0-8:A-Z_a-z[:^ascii:]]/";
-if (! defined $xml_name_re) {
- $xml_name_re = qr/[\x00-\x2C\x2F\x39\x3B-\x40\x5B-\x5E\x60\x7B-\x7F]/;
-}
+my $xml_name_re = my_qr('[^-.0-8:A-Z_a-z[:^ascii:]]', '9');
+$xml_name_re = qr/[\x00-\x2C\x2F\x39\x3B-\x40\x5B-\x5E\x60\x7B-\x7F]/
+ unless $xml_name_re;
sub accept_code { shift->accept_codes(@_) } # alias
@@ -652,12 +660,13 @@ sub _make_treelet {
$treelet = $self->_treelet_from_formatting_codes(@_);
}
- if( $self->_remap_sequences($treelet) ) {
+ if( ! $self->{'_output_is_for_JustPod'} # Retain these as-is for pod output
+ && $self->_remap_sequences($treelet) )
+ {
$self->_treat_Zs($treelet); # Might as well nix these first
$self->_treat_Ls($treelet); # L has to precede E and S
$self->_treat_Es($treelet);
$self->_treat_Ss($treelet); # S has to come after E
-
$self->_wrap_up($treelet); # Nix X's and merge texties
} else {
@@ -1080,9 +1089,14 @@ sub _treat_Ls { # Process our dear dear friends, the L<...> sequences
# By here, $treelet->[$i] is definitely an L node
my $ell = $treelet->[$i];
- DEBUG > 1 and print STDERR "Ogling L node $ell\n";
+ DEBUG > 1 and print STDERR "Ogling L node " . pretty($ell) . "\n";
- # bitch if it's empty
+ # bitch if it's empty or is just '/'
+ if (@{$ell} == 3 and $ell->[2] =~ m!\A\s*/\s*\z!) {
+ $self->whine( $start_line, "L<> contains only '/'" );
+ $treelet->[$i] = 'L</>'; # just make it a text node
+ next; # and move on
+ }
if( @{$ell} == 2
or (@{$ell} == 3 and $ell->[2] eq '')
) {
@@ -1289,6 +1303,7 @@ sub _treat_Ls { # Process our dear dear friends, the L<...> sequences
$section_name = [splice @ell_content];
$section_name->[ 0] =~ s/^\"//s;
$section_name->[-1] =~ s/\"$//s;
+ $ell->[1]{'~tolerated'} = 1;
}
# Turn L<Foo Bar> into L</Foo Bar>.
@@ -1296,8 +1311,8 @@ sub _treat_Ls { # Process our dear dear friends, the L<...> sequences
and grep !ref($_) && m/ /s, @ell_content
) {
$section_name = [splice @ell_content];
+ $ell->[1]{'~deprecated'} = 1;
# That's support for the now-deprecated syntax.
- # (Maybe generate a warning eventually?)
# Note that it deliberately won't work on L<...|Foo Bar>
}
@@ -1347,7 +1362,7 @@ sub _treat_Ls { # Process our dear dear friends, the L<...> sequences
# And update children to be the link-text:
@$ell = (@$ell[0,1], defined($link_text) ? splice(@$link_text) : '');
- DEBUG > 2 and print STDERR "End of L-parsing for this node $treelet->[$i]\n";
+ DEBUG > 2 and print STDERR "End of L-parsing for this node " . pretty($treelet->[$i]) . "\n";
unshift @stack, $treelet->[$i]; # might as well recurse
}
@@ -1507,6 +1522,7 @@ sub _accessorize { # A simple-minded method-maker
$Carp::CarpLevel = 1, Carp::croak(
"Accessor usage: \$obj->$attrname() or \$obj->$attrname(\$new_value)"
) unless (@_ == 1 or @_ == 2) and ref $_[0];
+
(@_ == 1) ? $_[0]->{$attrname}
: ($_[0]->{$attrname} = $_[1]);
};
diff --git a/Master/tlpkg/tlperl/lib/Pod/Simple.pod b/Master/tlpkg/tlperl/lib/Pod/Simple.pod
index 67a18df0d64..c569e979ae9 100644
--- a/Master/tlpkg/tlperl/lib/Pod/Simple.pod
+++ b/Master/tlpkg/tlperl/lib/Pod/Simple.pod
@@ -19,7 +19,11 @@ Be sure to read L</ENCODING> if your Pod contains non-ASCII characters.
Pod formatters can use Pod::Simple to parse Pod documents and render them into
plain text, HTML, or any number of other formats. Typically, such formatters
will be subclasses of Pod::Simple, and so they will inherit its methods, like
-C<parse_file>.
+C<parse_file>. But note that Pod::Simple doesn't understand and
+properly parse Perl itself, so if you have a file which contains a Perl
+program that has a multi-line quoted string which has lines that look
+like pod, Pod::Simple will treat them as pod. This can be avoided if
+the file makes these into indented here documents instead.
If you're reading this document just because you have a Pod-processing
subclass that you want to use, this document (plus the documentation for the
@@ -219,6 +223,21 @@ that you don't want I<any> lines indented. You can do something like this:
return undef;
});
+=item C<< $parser->expand_verbatim_tabs( I<n> ) >>
+
+Default: 8
+
+If after any stripping of indentation in verbatim blocks, there remain
+tabs, this method call indicates what to do with them. C<0>
+means leave them as tabs, any other number indicates that each tab is to
+be translated so as to have tab stops every C<n> columns.
+
+This is independent of other methods (except that it operates after any
+verbatim input stripping is done).
+
+Like the other methods, the input parameter is not checked for validity.
+C<undef> or containing non-digits has the same effect as 8.
+
=back
=head1 TERTIARY METHODS
@@ -390,8 +409,8 @@ This module is managed in an open GitHub repository,
L<https://github.com/perl-pod/pod-simple/>. Feel free to fork and contribute, or
to clone L<git://github.com/perl-pod/pod-simple.git> and send patches!
-Patches against Pod::Simple are welcome. Please send bug reports to
-<bug-pod-simple@rt.cpan.org>.
+Please use L<https://github.com/perl-pod/pod-simple/issues/new> to file a bug
+report.
=head1 COPYRIGHT AND DISCLAIMERS
@@ -419,6 +438,8 @@ Pod::Simple is maintained by:
=item * David E. Wheeler C<dwheeler@cpan.org>
+=item * Karl Williamson C<khw@cpan.org>
+
=back
Documentation has been contributed by:
diff --git a/Master/tlpkg/tlperl/lib/Pod/Simple/BlackBox.pm b/Master/tlpkg/tlperl/lib/Pod/Simple/BlackBox.pm
index 9fe3f702ef9..d115aee7e3e 100644
--- a/Master/tlpkg/tlperl/lib/Pod/Simple/BlackBox.pm
+++ b/Master/tlpkg/tlperl/lib/Pod/Simple/BlackBox.pm
@@ -22,8 +22,36 @@ use integer; # vroom!
use strict;
use Carp ();
use vars qw($VERSION );
-$VERSION = '3.35';
+$VERSION = '3.40';
#use constant DEBUG => 7;
+
+sub my_qr ($$) {
+
+ # $1 is a pattern to compile and return. Older perls compile any
+ # syntactically valid property, even if it isn't legal. To cope with
+ # this, return an empty string unless the compiled pattern also
+ # successfully matches $2, which the caller furnishes.
+
+ my ($input_re, $should_match) = @_;
+ # XXX could have a third parameter $shouldnt_match for extra safety
+
+ my $use_utf8 = ($] le 5.006002) ? 'use utf8;' : "";
+
+ my $re = eval "no warnings; $use_utf8 qr/$input_re/";
+ #print STDERR __LINE__, ": $input_re: $@\n" if $@;
+ return "" if $@;
+
+ my $matches = eval "no warnings; $use_utf8 '$should_match' =~ /$re/";
+ #print STDERR __LINE__, ": $input_re: $@\n" if $@;
+ return "" if $@;
+
+ #print STDERR __LINE__, ": SUCCESS: $re\n" if $matches;
+ return $re if $matches;
+
+ #print STDERR __LINE__, ": $re: didn't match\n";
+ return "";
+}
+
BEGIN {
require Pod::Simple;
*DEBUG = \&Pod::Simple::DEBUG unless defined &DEBUG
@@ -32,8 +60,37 @@ BEGIN {
# Matches a character iff the character will have a different meaning
# if we choose CP1252 vs UTF-8 if there is no =encoding line.
# This is broken for early Perls on non-ASCII platforms.
-my $non_ascii_re = eval "qr/[[:^ascii:]]/";
-$non_ascii_re = qr/[\x80-\xFF]/ if ! defined $non_ascii_re;
+my $non_ascii_re = my_qr('[[:^ascii:]]', "\xB6");
+$non_ascii_re = qr/[\x80-\xFF]/ unless $non_ascii_re;
+
+# Use patterns understandable by Perl 5.6, if possible
+my $cs_re = my_qr('\p{IsCs}', "\x{D800}");
+my $cn_re = my_qr('\p{IsCn}', "\x{09E4}"); # <reserved> code point unlikely
+ # to get assigned
+my $rare_blocks_re = my_qr('[\p{InIPAExtensions}\p{InSpacingModifierLetters}]',
+ "\x{250}");
+$rare_blocks_re = my_qr('[\x{0250}-\x{02FF}]', "\x{250}") unless $rare_blocks_re;
+
+my $script_run_re = eval 'no warnings "experimental::script_run";
+ qr/(*script_run: ^ .* $ )/x';
+my $latin_re = my_qr('[\p{IsLatin}\p{IsInherited}\p{IsCommon}]', "\x{100}");
+unless ($latin_re) {
+ # This was machine generated to be the ranges of the union of the above
+ # three properties, with things that were undefined by Unicode 4.1 filling
+ # gaps. That is the version in use when Perl advanced enough to
+ # successfully compile and execute the above pattern.
+ $latin_re = my_qr('[\x00-\x{02E9}\x{02EC}-\x{0374}\x{037E}\x{0385}\x{0387}\x{0485}\x{0486}\x{0589}\x{060C}\x{061B}\x{061F}\x{0640}\x{064B}-\x{0655}\x{0670}\x{06DD}\x{0951}-\x{0954}\x{0964}\x{0965}\x{0E3F}\x{10FB}\x{16EB}-\x{16ED}\x{1735}\x{1736}\x{1802}\x{1803}\x{1805}\x{1D00}-\x{1D25}\x{1D2C}-\x{1D5C}\x{1D62}-\x{1D65}\x{1D6B}-\x{1D77}\x{1D79}-\x{1DBE}\x{1DC0}-\x{1EF9}\x{2000}-\x{2125}\x{2127}-\x{27FF}\x{2900}-\x{2B13}\x{2E00}-\x{2E1D}\x{2FF0}-\x{3004}\x{3006}\x{3008}-\x{3020}\x{302A}-\x{302D}\x{3030}-\x{3037}\x{303C}-\x{303F}\x{3099}-\x{309C}\x{30A0}\x{30FB}\x{30FC}\x{3190}-\x{319F}\x{31C0}-\x{31CF}\x{3220}-\x{325F}\x{327F}-\x{32CF}\x{3358}-\x{33FF}\x{4DC0}-\x{4DFF}\x{A700}-\x{A716}\x{FB00}-\x{FB06}\x{FD3E}\x{FD3F}\x{FE00}-\x{FE6B}\x{FEFF}-\x{FF65}\x{FF70}\x{FF9E}\x{FF9F}\x{FFE0}-\x{FFFD}\x{10100}-\x{1013F}\x{1D000}-\x{1D1DD}\x{1D300}-\x{1D7FF}]', "\x{100}");
+}
+
+my $every_char_is_latin_re = my_qr("^(?:$latin_re)*\\z", "A");
+
+# Latin script code points not in the first release of Unicode
+my $later_latin_re = my_qr('[^\P{IsLatin}\p{IsAge=1.1}]', "\x{1F6}");
+
+# If this perl doesn't have the Deprecated property, there's only one code
+# point in it that we need be concerned with.
+my $deprecated_re = my_qr('\p{IsDeprecated}', "\x{149}");
+$deprecated_re = qr/\x{149}/ unless $deprecated_re;
my $utf8_bom;
if (($] ge 5.007_003)) {
@@ -43,6 +100,11 @@ if (($] ge 5.007_003)) {
$utf8_bom = "\xEF\xBB\xBF"; # No EBCDIC BOM detection for early Perls.
}
+# This is used so that the 'content_seen' method doesn't return true on a
+# file that just happens to have a line that matches /^=[a-zA-z]/. Only if
+# there is a valid =foo line will we return that content was seen.
+my $seen_legal_directive = 0;
+
#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
sub parse_line { shift->parse_lines(@_) } # alias
@@ -57,10 +119,10 @@ sub parse_lines { # Usage: $parser->parse_lines(@lines)
my $cut_handler = $self->{'cut_handler'};
my $wl_handler = $self->{'whiteline_handler'};
$self->{'line_count'} ||= 0;
-
+
my $scratch;
- DEBUG > 4 and
+ DEBUG > 4 and
print STDERR "# Parsing starting at line ", $self->{'line_count'}, ".\n";
DEBUG > 5 and
@@ -71,9 +133,17 @@ sub parse_lines { # Usage: $parser->parse_lines(@lines)
# paragraph buffer. Because we need to defer processing of =over
# directives and verbatim paragraphs. We call _ponder_paragraph_buffer
# to process this.
-
+
$self->{'pod_para_count'} ||= 0;
+ # An attempt to match the pod portions of a line. This is not fool proof,
+ # but is good enough to serve as part of the heuristic for guessing the pod
+ # encoding if not specified.
+ my $format_codes = join "", '[', grep { / ^ [A-Za-z] $/x }
+ keys %{$self->{accept_codes}};
+ $format_codes .= ']';
+ my $pod_chars_re = qr/ ^ = [A-Za-z]+ | $format_codes < /x;
+
my $line;
foreach my $source_line (@_) {
if( $self->{'source_dead'} ) {
@@ -97,7 +167,7 @@ sub parse_lines { # Usage: $parser->parse_lines(@lines)
($line = $source_line) =~ tr/\n\r//d;
# If we don't have two vars, we'll end up with that there
# tr/// modding the (potentially read-only) original source line!
-
+
} else {
DEBUG > 2 and print STDERR "First line: [$source_line]\n";
@@ -106,7 +176,7 @@ sub parse_lines { # Usage: $parser->parse_lines(@lines)
$self->_handle_encoding_line( "=encoding utf8" );
delete $self->{'_processed_encoding'};
$line =~ tr/\n\r//d;
-
+
} elsif( $line =~ s/^\xFE\xFF//s ) {
DEBUG and print STDERR "Big-endian UTF-16 BOM seen. Aborting parsing.\n";
$self->scream(
@@ -130,7 +200,7 @@ sub parse_lines { # Usage: $parser->parse_lines(@lines)
next;
# TODO: implement somehow?
-
+
} else {
DEBUG > 2 and print STDERR "First line is BOM-less.\n";
($line = $source_line) =~ tr/\n\r//d;
@@ -144,8 +214,8 @@ sub parse_lines { # Usage: $parser->parse_lines(@lines)
my $encoding;
- # No =encoding line, and we are at the first line in the input that
- # contains a non-ascii byte, that is one whose meaning varies depending
+ # No =encoding line, and we are at the first pod line in the input that
+ # contains a non-ascii byte, that is, one whose meaning varies depending
# on whether the file is encoded in UTF-8 or CP1252, which are the two
# possibilities permitted by the pod spec. (ASCII is assumed if the
# file only contains ASCII bytes.) In order to process this line, we
@@ -162,22 +232,28 @@ sub parse_lines { # Usage: $parser->parse_lines(@lines)
# without conflict. CP 1252 uses most of them for graphic characters.
#
# Note that all ASCII-range bytes represent their corresponding code
- # points in CP1252 and UTF-8. In ASCII platform UTF-8 all other code
- # points require multiple (non-ASCII) bytes to represent. (A separate
- # paragraph for EBCDIC is below.) The multi-byte representation is
- # quite structured. If we find an isolated byte that requires multiple
- # bytes to represent in UTF-8, we know that the encoding is not UTF-8.
- # If we find a sequence of bytes that violates the UTF-8 structure, we
- # also can presume the encoding isn't UTF-8, and hence must be 1252.
+ # points in both CP1252 and UTF-8. In ASCII platform UTF-8, all other
+ # code points require multiple (non-ASCII) bytes to represent. (A
+ # separate paragraph for EBCDIC is below.) The multi-byte
+ # representation is quite structured. If we find an isolated byte that
+ # would require multiple bytes to represent in UTF-8, we know that the
+ # encoding is not UTF-8. If we find a sequence of bytes that violates
+ # the UTF-8 structure, we also can presume the encoding isn't UTF-8, and
+ # hence must be 1252.
#
# But there are ambiguous cases where we could guess wrong. If so, the
# user will end up having to supply an =encoding line. We use all
# readily available information to improve our chances of guessing
# right. The odds of something not being UTF-8, but still passing a
# UTF-8 validity test go down very rapidly with increasing length of the
- # sequence. Therefore we look at all the maximal length non-ascii
- # sequences on the line. If any of the sequences can't be UTF-8, we
- # quit there and choose CP1252. If all could be UTF-8, we guess UTF-8.
+ # sequence. Therefore we look at all non-ascii sequences on the line.
+ # If any of the sequences can't be UTF-8, we quit there and choose
+ # CP1252. If all could be UTF-8, we see if any of the code points
+ # represented are unlikely to be in pod. If so, we guess CP1252. If
+ # not, we check if the line is all in the same script; if not guess
+ # CP1252; otherwise UTF-8. For perls that don't have convenient script
+ # run testing, see if there is both Latin and non-Latin. If so, CP1252,
+ # otherwise UTF-8.
#
# On EBCDIC platforms, the situation is somewhat different. In
# UTF-EBCDIC, not only do ASCII-range bytes represent their code points,
@@ -188,51 +264,188 @@ sub parse_lines { # Usage: $parser->parse_lines(@lines)
# very unlikely to be in pod text. So if we encounter one of them, it
# means that it is quite likely CP1252 and not UTF-8. The net result is
# the same code below is used for both platforms.
- while ($line =~ m/($non_ascii_re+)/g) {
- my $non_ascii_seq = $1;
-
- if (length $non_ascii_seq == 1) {
- $encoding = 'CP1252';
- goto guessed;
- } elsif ($] ge 5.007_003) {
-
- # On Perls that have this function, we can see if the sequence is
- # valid UTF-8 or not.
- my $is_utf8;
- {
- no warnings 'utf8';
- $is_utf8 = utf8::decode($non_ascii_seq);
+ #
+ # XXX probably if the line has E<foo> that evaluates to illegal CP1252,
+ # then it is UTF-8. But we haven't processed E<> yet.
+
+ goto set_1252 if $] lt 5.006_000; # No UTF-8 on very early perls
+
+ my $copy;
+
+ no warnings 'utf8';
+
+ if ($] ge 5.007_003) {
+ $copy = $line;
+
+ # On perls that have this function, we can use it to easily see if the
+ # sequence is valid UTF-8 or not; if valid it turns on the UTF-8 flag
+ # needed below for script run detection
+ goto set_1252 if ! utf8::decode($copy);
+ }
+ elsif (ord("A") != 65) { # Early EBCDIC, assume UTF-8. What's a windows
+ # code page doing here anyway?
+ goto set_utf8;
+ }
+ else { # ASCII, no decode(): do it ourselves using the fundamental
+ # characteristics of UTF-8
+ use if $] le 5.006002, 'utf8';
+
+ my $char_ord;
+ my $needed; # How many continuation bytes to gobble up
+
+ # Initialize the translated line with a dummy character that will be
+ # deleted after everything else is done. This dummy makes sure that
+ # $copy will be in UTF-8. Doing it now avoids the bugs in early perls
+ # with upgrading in the middle
+ $copy = chr(0x100);
+
+ # Parse through the line
+ for (my $i = 0; $i < length $line; $i++) {
+ my $byte = substr($line, $i, 1);
+
+ # ASCII bytes are trivially dealt with
+ if ($byte !~ $non_ascii_re) {
+ $copy .= $byte;
+ next;
+ }
+
+ my $b_ord = ord $byte;
+
+ # Now figure out what this code point would be if the input is
+ # actually in UTF-8. If, in the process, we discover that it isn't
+ # well-formed UTF-8, we guess CP1252.
+ #
+ # Start the process. If it is UTF-8, we are at the first, start
+ # byte, of a multi-byte sequence. We look at this byte to figure
+ # out how many continuation bytes are needed, and to initialize the
+ # code point accumulator with the data from this byte.
+ #
+ # Normally the minimum continuation byte is 0x80, but in certain
+ # instances the minimum is a higher number. So the code below
+ # overrides this for those instances.
+ my $min_cont = 0x80;
+
+ if ($b_ord < 0xC2) { # A start byte < C2 is malformed
+ goto set_1252;
+ }
+ elsif ($b_ord <= 0xDF) {
+ $needed = 1;
+ $char_ord = $b_ord & 0x1F;
}
- if (! $is_utf8) {
- $encoding = 'CP1252';
- goto guessed;
+ elsif ($b_ord <= 0xEF) {
+ $min_cont = 0xA0 if $b_ord == 0xE0;
+ $needed = 2;
+ $char_ord = $b_ord & (0x1F >> 1);
}
- } elsif (ord("A") == 65) { # An early Perl, ASCII platform
-
- # Without utf8::decode, it's a lot harder to do a rigorous check
- # (though some early releases had a different function that
- # accomplished the same thing). Since these are ancient Perls, not
- # likely to be in use today, we take the easy way out, and look at
- # just the first two bytes of the sequence to see if they are the
- # start of a UTF-8 character. In ASCII UTF-8, continuation bytes
- # must be between 0x80 and 0xBF. Start bytes can range from 0xC2
- # through 0xFF, but anything above 0xF4 is not Unicode, and hence
- # extremely unlikely to be in a pod.
- if ($non_ascii_seq !~ /^[\xC2-\xF4][\x80-\xBF]/) {
- $encoding = 'CP1252';
- goto guessed;
+ elsif ($b_ord <= 0xF4) {
+ $min_cont = 0x90 if $b_ord == 0xF0;
+ $needed = 3;
+ $char_ord = $b_ord & (0x1F >> 2);
+ }
+ else { # F4 is the highest start byte for legal Unicode; higher is
+ # unlikely to be in pod.
+ goto set_1252;
}
- # We don't bother doing anything special for EBCDIC on early Perls.
- # If there is a solitary variant, CP1252 will be chosen; otherwise
- # UTF-8.
- }
- } # End of loop through all variant sequences on the line
+ # ? not enough continuation bytes available
+ goto set_1252 if $i + $needed >= length $line;
+
+ # Accumulate the ordinal of the character from the remaining
+ # (continuation) bytes.
+ while ($needed-- > 0) {
+ my $cont = substr($line, ++$i, 1);
+ $b_ord = ord $cont;
+ goto set_1252 if $b_ord < $min_cont || $b_ord > 0xBF;
+
+ # In all cases, any next continuation bytes all have the same
+ # minimum legal value
+ $min_cont = 0x80;
+
+ # Accumulate this byte's contribution to the code point
+ $char_ord <<= 6;
+ $char_ord |= ($b_ord & 0x3F);
+ }
+
+ # Here, the sequence that formed this code point was valid UTF-8,
+ # so add the completed character to the output
+ $copy .= chr $char_ord;
+ } # End of loop through line
+
+ # Delete the dummy first character
+ $copy = substr($copy, 1);
+ }
+
+ # Here, $copy is legal UTF-8.
+
+ # If it can't be legal CP1252, no need to look further. (These bytes
+ # aren't valid in CP1252.) This test could have been placed higher in
+ # the code, but it seemed wrong to set the encoding to UTF-8 without
+ # making sure that the very first instance is well-formed. But what if
+ # it isn't legal CP1252 either? We have to choose one or the other, and
+ # It seems safer to favor the single-byte encoding over the multi-byte.
+ goto set_utf8 if ord("A") == 65 && $line =~ /[\x81\x8D\x8F\x90\x9D]/;
+
+ # The C1 controls are not likely to appear in pod
+ goto set_1252 if ord("A") == 65 && $copy =~ /[\x80-\x9F]/;
+
+ # Nor are surrogates nor unassigned, nor deprecated.
+ DEBUG > 8 and print STDERR __LINE__, ": $copy: surrogate\n" if $copy =~ $cs_re;
+ goto set_1252 if $cs_re && $copy =~ $cs_re;
+ DEBUG > 8 and print STDERR __LINE__, ": $copy: unassigned\n" if $cn_re && $copy =~ $cn_re;
+ goto set_1252 if $cn_re && $copy =~ $cn_re;
+ DEBUG > 8 and print STDERR __LINE__, ": $copy: deprecated\n" if $copy =~ $deprecated_re;
+ goto set_1252 if $copy =~ $deprecated_re;
+
+ # Nor are rare code points. But this is hard to determine. khw
+ # believes that IPA characters and the modifier letters are unlikely to
+ # be in pod (and certainly very unlikely to be the in the first line in
+ # the pod containing non-ASCII)
+ DEBUG > 8 and print STDERR __LINE__, ": $copy: rare\n" if $copy =~ $rare_blocks_re;
+ goto set_1252 if $rare_blocks_re && $copy =~ $rare_blocks_re;
+
+ # The first Unicode version included essentially every Latin character
+ # in modern usage. So, a Latin character not in the first release will
+ # unlikely be in pod.
+ DEBUG > 8 and print STDERR __LINE__, ": $copy: later_latin\n" if $later_latin_re && $copy =~ $later_latin_re;
+ goto set_1252 if $later_latin_re && $copy =~ $later_latin_re;
+
+ # On perls that handle script runs, if the UTF-8 interpretation yields
+ # a single script, we guess UTF-8, otherwise just having a mixture of
+ # scripts is suspicious, so guess CP1252. We first strip off, as best
+ # we can, the ASCII characters that look like they are pod directives,
+ # as these would always show as mixed with non-Latin text.
+ $copy =~ s/$pod_chars_re//g;
+
+ if ($script_run_re) {
+ goto set_utf8 if $copy =~ $script_run_re;
+ DEBUG > 8 and print STDERR __LINE__, ": not script run\n";
+ goto set_1252;
+ }
+
+ # Even without script runs, but on recent enough perls and Unicodes, we
+ # can check if there is a mixture of both Latin and non-Latin. Again,
+ # having a mixture of scripts is suspicious, so assume CP1252
+
+ # If it's all non-Latin, there is no CP1252, as that is Latin
+ # characters and punct, etc.
+ DEBUG > 8 and print STDERR __LINE__, ": $copy: not latin\n" if $copy !~ $latin_re;
+ goto set_utf8 if $copy !~ $latin_re;
+
+ DEBUG > 8 and print STDERR __LINE__, ": $copy: all latin\n" if $copy =~ $every_char_is_latin_re;
+ goto set_utf8 if $copy =~ $every_char_is_latin_re;
+
+ DEBUG > 8 and print STDERR __LINE__, ": $copy: mixed\n";
+
+ set_1252:
+ DEBUG > 9 and print STDERR __LINE__, ": $copy: is 1252\n";
+ $encoding = 'CP1252';
+ goto done_set;
- # All sequences in the line could be UTF-8. Guess that.
+ set_utf8:
+ DEBUG > 9 and print STDERR __LINE__, ": $copy: is UTF-8\n";
$encoding = 'UTF-8';
- guessed:
+ done_set:
$self->_handle_encoding_line( "=encoding $encoding" );
delete $self->{'_processed_encoding'};
$self->{'_transcoder'} && $self->{'_transcoder'}->($line);
@@ -254,13 +467,13 @@ sub parse_lines { # Usage: $parser->parse_lines(@lines)
$self->{'line_count'},
"=cut found outside a pod block. Skipping to next block."
);
-
+
## Before there were errata sections in the world, it was
## least-pessimal to abort processing the file. But now we can
## just barrel on thru (but still not start a pod block).
#splice @_;
#push @_, undef;
-
+
next;
} else {
$self->{'in_pod'} = $self->{'start_of_pod_block'}
@@ -273,7 +486,7 @@ sub parse_lines { # Usage: $parser->parse_lines(@lines)
if $code_handler;
# Note: this may cause code to be processed out of order relative
# to pods, but in order relative to cuts.
-
+
# Note also that we haven't yet applied the transcoding to $line
# by time we call $code_handler!
@@ -284,11 +497,11 @@ sub parse_lines { # Usage: $parser->parse_lines(@lines)
DEBUG > 1 and print STDERR "# Setting nextline to $1\n";
$self->{'line_count'} = $1 - 1;
}
-
+
next;
}
}
-
+
# . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
# Else we're in pod mode:
@@ -308,12 +521,13 @@ sub parse_lines { # Usage: $parser->parse_lines(@lines)
# ++$self->{'pod_para_count'};
$self->_ponder_paragraph_buffer();
# by now it's safe to consider the previous paragraph as done.
+ DEBUG > 6 and print STDERR "Processing any cut handler, line ${$self}{'line_count'}\n";
$cut_handler->(map $_, $line, $self->{'line_count'}, $self)
if $cut_handler;
# TODO: add to docs: Note: this may cause cuts to be processed out
# of order relative to pods, but in order relative to code.
-
+
} elsif($line =~ m/^(\s*)$/s) { # it's a blank line
if (defined $1 and $1 =~ /[^\S\r\n]/) { # it's a white line
$wl_handler->(map $_, $line, $self->{'line_count'}, $self)
@@ -324,29 +538,30 @@ sub parse_lines { # Usage: $parser->parse_lines(@lines)
DEBUG > 1 and print STDERR "Saving blank line at line ${$self}{'line_count'}\n";
push @{$paras->[-1]}, $line;
} # otherwise it's not interesting
-
+
if(!$self->{'start_of_pod_block'} and !$self->{'last_was_blank'}) {
DEBUG > 1 and print STDERR "Noting para ends with blank line at ${$self}{'line_count'}\n";
}
-
+
$self->{'last_was_blank'} = 1;
-
+
} elsif($self->{'last_was_blank'}) { # A non-blank line starting a new para...
-
- if($line =~ m/^(=[a-zA-Z][a-zA-Z0-9]*)(?:\s+|$)(.*)/s) {
+
+ if($line =~ m/^(=[a-zA-Z][a-zA-Z0-9]*)(\s+|$)(.*)/s) {
# THIS IS THE ONE PLACE WHERE WE CONSTRUCT NEW DIRECTIVE OBJECTS
- my $new = [$1, {'start_line' => $self->{'line_count'}}, $2];
+ my $new = [$1, {'start_line' => $self->{'line_count'}}, $3];
+ $new->[1]{'~orig_spacer'} = $2 if $2 && $2 ne " ";
# Note that in "=head1 foo", the WS is lost.
# Example: ['=head1', {'start_line' => 123}, ' foo']
-
+
++$self->{'pod_para_count'};
-
+
$self->_ponder_paragraph_buffer();
# by now it's safe to consider the previous paragraph as done.
-
+
push @$paras, $new; # the new incipient paragraph
DEBUG > 1 and print STDERR "Starting new ${$paras}[-1][0] para at line ${$self}{'line_count'}\n";
-
+
} elsif($line =~ m/^\s/s) {
if(!$self->{'start_of_pod_block'} and @$paras and $paras->[-1][0] eq '~Verbatim') {
@@ -379,7 +594,7 @@ sub parse_lines { # Usage: $parser->parse_lines(@lines)
}
$self->{'last_was_blank'} = $self->{'start_of_pod_block'} = 0;
}
-
+
} # ends the big while loop
DEBUG > 1 and print STDERR (pretty(@$paras), "\n");
@@ -390,7 +605,7 @@ sub parse_lines { # Usage: $parser->parse_lines(@lines)
sub _handle_encoding_line {
my($self, $line) = @_;
-
+
return if $self->parse_characters;
# The point of this routine is to set $self->{'_transcoder'} as indicated.
@@ -492,7 +707,7 @@ sub _handle_encoding_line {
sub _handle_encoding_second_level {
# By time this is called, the encoding (if well formed) will already
- # have been acted one.
+ # have been acted on.
my($self, $para) = @_;
my @x = @$para;
my $content = join ' ', splice @x, 2;
@@ -500,7 +715,7 @@ sub _handle_encoding_second_level {
$content =~ s/\s+$//s;
DEBUG > 2 and print STDERR "Ogling encoding directive: =encoding $content\n";
-
+
if (defined($self->{'_processed_encoding'})) {
#if($content ne $self->{'_processed_encoding'}) {
# Could it happen?
@@ -518,14 +733,14 @@ sub _handle_encoding_second_level {
} else {
DEBUG > 2 and print STDERR " (Yup, it was successfully handled already.)\n";
}
-
+
} else {
# Otherwise it's a syntax error
$self->whine( $para->[1]{'start_line'},
"Invalid =encoding syntax: $content"
);
}
-
+
return;
}
@@ -542,7 +757,7 @@ sub _gen_errata {
return() unless $self->{'errata'} and keys %{$self->{'errata'}};
my @out;
-
+
foreach my $line (sort {$a <=> $b} keys %{$self->{'errata'}}) {
push @out,
['=item', {'start_line' => $m}, "Around line $line:"],
@@ -555,7 +770,7 @@ sub _gen_errata {
)
;
}
-
+
# TODO: report of unknown entities? unrenderable characters?
unshift @out,
@@ -569,7 +784,7 @@ sub _gen_errata {
['=over', {'start_line' => $m, 'errata' => 1}, ''],
;
- push @out,
+ push @out,
['=back', {'start_line' => $m, 'errata' => 1}, ''],
;
@@ -610,7 +825,7 @@ sub _ponder_paragraph_buffer {
# Document,
# Data, Para, Verbatim
# B, C, longdirname (TODO -- wha?), etc. for all directives
- #
+ #
my $self = $_[0];
my $paras;
@@ -624,11 +839,11 @@ sub _ponder_paragraph_buffer {
# We have something in our buffer. So apparently the document has started.
unless($self->{'doc_has_started'}) {
$self->{'doc_has_started'} = 1;
-
+
my $starting_contentless;
$starting_contentless =
(
- !@$curr_open
+ !@$curr_open
and @$paras and ! grep $_->[0] ne '~end', @$paras
# i.e., if the paras is all ~ends
)
@@ -637,7 +852,7 @@ sub _ponder_paragraph_buffer {
$starting_contentless ? 'contentless' : 'contentful',
" document\n"
;
-
+
$self->_handle_element_start(
($scratch = 'Document'),
{
@@ -649,15 +864,32 @@ sub _ponder_paragraph_buffer {
my($para, $para_type);
while(@$paras) {
- last if @$paras == 1 and
- ( $paras->[0][0] eq '=over' or $paras->[0][0] eq '~Verbatim'
- or $paras->[0][0] eq '=item' )
- ;
+
+ # If a directive, assume it's legal; subtract below if found not to be
+ $seen_legal_directive++ if $paras->[0][0] =~ /^=/;
+
+ last if @$paras == 1
+ and ( $paras->[0][0] eq '=over'
+ or $paras->[0][0] eq '=item'
+ or ($paras->[0][0] eq '~Verbatim' and $self->{'in_pod'}));
# Those're the three kinds of paragraphs that require lookahead.
# Actually, an "=item Foo" inside an <over type=text> region
# and any =item inside an <over type=block> region (rare)
# don't require any lookahead, but all others (bullets
# and numbers) do.
+ # The verbatim is different from the other two, because those might be
+ # like:
+ #
+ # =item
+ # ...
+ # =cut
+ # ...
+ # =item
+ #
+ # The =cut here finishes the paragraph but doesn't terminate the =over
+ # they should be in. (khw apologizes that he didn't comment at the time
+ # why the 'in_pod' works, and no longer remembers why, and doesn't think
+ # it is currently worth the effort to re-figure it out.)
# TODO: whinge about many kinds of directives in non-resolving =for regions?
# TODO: many? like what? =head1 etc?
@@ -667,7 +899,7 @@ sub _ponder_paragraph_buffer {
DEBUG > 1 and print STDERR "Pondering a $para_type paragraph, given the stack: (",
$self->_dump_curr_open(), ")\n";
-
+
if($para_type eq '=for') {
next if $self->_ponder_for($para,$curr_open,$paras);
@@ -704,7 +936,7 @@ sub _ponder_paragraph_buffer {
} else {
# All non-magical codes!!!
-
+
# Here we start using $para_type for our own twisted purposes, to
# mean how it should get treated, not as what the element name
# should be.
@@ -744,10 +976,10 @@ sub _ponder_paragraph_buffer {
;
next;
}
-
-
+
+
my $over_type = $over->[1]{'~type'};
-
+
if(!$over_type) {
# Shouldn't happen1
die "Typeless over in stack, starting at line "
@@ -772,7 +1004,7 @@ sub _ponder_paragraph_buffer {
my $item_type = $self->_get_item_type($para);
# That kills the content of the item if it's a number or bullet.
DEBUG and print STDERR " Item is of type ", $para->[0], " under $over_type\n";
-
+
if($item_type eq 'text') {
# Nothing special needs doing for 'text'
} elsif($item_type eq 'number' or $item_type eq 'bullet') {
@@ -788,16 +1020,16 @@ sub _ponder_paragraph_buffer {
} else {
die "Unhandled item type $item_type"; # should never happen
}
-
+
# =item-text thingies don't need any assimilation, it seems.
} elsif($over_type eq 'number') {
my $item_type = $self->_get_item_type($para);
# That kills the content of the item if it's a number or bullet.
DEBUG and print STDERR " Item is of type ", $para->[0], " under $over_type\n";
-
+
my $expected_value = ++ $curr_open->[-1][1]{'~counter'};
-
+
if($item_type eq 'bullet') {
# Hm, it's not numeric. Correct for this.
$para->[1]{'number'} = $expected_value;
@@ -822,7 +1054,7 @@ sub _ponder_paragraph_buffer {
} elsif($expected_value == $para->[1]{'number'}) {
DEBUG > 1 and print STDERR " Numeric item has the expected value of $expected_value\n";
-
+
} else {
DEBUG > 1 and print STDERR " Numeric item has ", $para->[1]{'number'},
" instead of the expected value of $expected_value\n";
@@ -833,7 +1065,7 @@ sub _ponder_paragraph_buffer {
);
$para->[1]{'number'} = $expected_value; # correcting!!
}
-
+
if(@$para == 2) {
# For the cases where we /didn't/ push to @$para
if($paras->[0][0] eq '~Para') {
@@ -850,13 +1082,13 @@ sub _ponder_paragraph_buffer {
my $item_type = $self->_get_item_type($para);
# That kills the content of the item if it's a number or bullet.
DEBUG and print STDERR " Item is of type ", $para->[0], " under $over_type\n";
-
+
if($item_type eq 'bullet') {
# as expected!
if( $para->[1]{'~_freaky_para_hack'} ) {
DEBUG and print STDERR "Accomodating '=item * Foo' tolerance hack.\n";
- push @$para, delete $para->[1]{'~_freaky_para_hack'};
+ push @$para, $para->[1]{'~_freaky_para_hack'};
}
} elsif($item_type eq 'number') {
@@ -925,6 +1157,7 @@ sub _ponder_paragraph_buffer {
DEBUG > 1 and print STDERR " Pondering known directive ${$para}[0] as $para_type\n";
} else {
# An unknown directive!
+ $seen_legal_directive--;
DEBUG > 1 and printf STDERR "Unhandled directive %s (Handled: %s)\n",
$para->[0], join(' ', sort keys %{$self->{'accept_directives'}} )
;
@@ -944,15 +1177,15 @@ sub _ponder_paragraph_buffer {
my @fors = grep $_->[0] eq '=for', @$curr_open;
DEBUG > 1 and print STDERR "Containing fors: ",
join(',', map $_->[1]{'target'}, @fors), "\n";
-
+
if(! @fors) {
DEBUG and print STDERR "Treating $para_type paragraph as such because stack has no =for's\n";
-
+
#} elsif(grep $_->[1]{'~resolve'}, @fors) {
#} elsif(not grep !$_->[1]{'~resolve'}, @fors) {
} elsif( $fors[-1][1]{'~resolve'} ) {
# Look to the immediately containing for
-
+
if($para_type eq 'Data') {
DEBUG and print STDERR "Treating Data paragraph as Plain/Verbatim because the containing =for ($fors[-1][1]{'target'}) is a resolver\n";
$para->[0] = 'Para';
@@ -971,7 +1204,7 @@ sub _ponder_paragraph_buffer {
if($para_type eq 'Plain') {
$self->_ponder_Plain($para);
} elsif($para_type eq 'Verbatim') {
- $self->_ponder_Verbatim($para);
+ $self->_ponder_Verbatim($para);
} elsif($para_type eq 'Data') {
$self->_ponder_Data($para);
} else {
@@ -985,11 +1218,12 @@ sub _ponder_paragraph_buffer {
DEBUG and print STDERR "\n", pretty($para), "\n";
# traverse the treelet (which might well be just one string scalar)
- $self->{'content_seen'} ||= 1;
+ $self->{'content_seen'} ||= 1 if $seen_legal_directive
+ && ! $self->{'~tried_gen_errata'};
$self->_traverse_treelet_bit(@$para);
}
}
-
+
return;
}
@@ -1024,9 +1258,9 @@ sub _ponder_for {
}
DEBUG > 1 and
print STDERR "Faking out a =for $target as a =begin $target / =end $target\n";
-
+
$para->[0] = 'Data';
-
+
unshift @$paras,
['=begin',
{'start_line' => $para->[1]{'start_line'}, '~really' => '=for'},
@@ -1038,7 +1272,7 @@ sub _ponder_for {
$target,
],
;
-
+
return 1;
}
@@ -1055,20 +1289,20 @@ sub _ponder_begin {
DEBUG and print STDERR "Ignoring targetless =begin\n";
return 1;
}
-
+
my ($target, $title) = $content =~ m/^(\S+)\s*(.*)$/;
$para->[1]{'title'} = $title if ($title);
$para->[1]{'target'} = $target; # without any ':'
$content = $target; # strip off the title
-
+
$content =~ s/^:!/!:/s;
my $neg; # whether this is a negation-match
$neg = 1 if $content =~ s/^!//s;
my $to_resolve; # whether to process formatting codes
$to_resolve = 1 if $content =~ s/^://s;
-
+
my $dont_ignore; # whether this target matches us
-
+
foreach my $target_name (
split(',', $content, -1),
$neg ? () : '*'
@@ -1076,7 +1310,7 @@ sub _ponder_begin {
DEBUG > 2 and
print STDERR " Considering whether =begin $content matches $target_name\n";
next unless $self->{'accept_targets'}{$target_name};
-
+
DEBUG > 2 and
print STDERR " It DOES match the acceptable target $target_name!\n";
$to_resolve = 1
@@ -1113,7 +1347,7 @@ sub _ponder_begin {
if(!$dont_ignore or scalar grep $_->[1]{'~ignore'}, @$curr_open) {
DEBUG > 1 and print STDERR "Ignoring ignorable =begin\n";
} else {
- $self->{'content_seen'} ||= 1;
+ $self->{'content_seen'} ||= 1 unless $self->{'~tried_gen_errata'};
$self->_handle_element_start((my $scratch='for'), $para->[1]);
}
@@ -1139,7 +1373,7 @@ sub _ponder_end {
DEBUG and print STDERR "Ignoring targetless =end\n";
return 1;
}
-
+
unless($content =~ m/^\S+$/) { # i.e., unless it's one word
$self->whine(
$para->[1]{'start_line'},
@@ -1149,7 +1383,7 @@ sub _ponder_end {
DEBUG and print STDERR "Ignoring mistargetted =end $content\n";
return 1;
}
-
+
unless(@$curr_open and $curr_open->[-1][0] eq '=for') {
$self->whine(
$para->[1]{'start_line'},
@@ -1159,11 +1393,11 @@ sub _ponder_end {
DEBUG and print STDERR "Ignoring mistargetted =end $content\n";
return 1;
}
-
+
unless($content eq $curr_open->[-1][1]{'target'}) {
$self->whine(
$para->[1]{'start_line'},
- "=end $content doesn't match =begin "
+ "=end $content doesn't match =begin "
. $curr_open->[-1][1]{'target'}
. ". (Stack: "
. $self->_dump_curr_open() . ')'
@@ -1180,22 +1414,22 @@ sub _ponder_end {
} else {
$curr_open->[-1][1]{'start_line'} = $para->[1]{'start_line'};
# what's that for?
-
- $self->{'content_seen'} ||= 1;
+
+ $self->{'content_seen'} ||= 1 unless $self->{'~tried_gen_errata'};
$self->_handle_element_end( my $scratch = 'for', $para->[1]);
}
DEBUG > 1 and print STDERR "Popping $curr_open->[-1][0] $curr_open->[-1][1]{'target'} because of =end $content\n";
pop @$curr_open;
return 1;
-}
+}
sub _ponder_doc_end {
my ($self,$para,$curr_open,$paras) = @_;
if(@$curr_open) { # Deal with things left open
DEBUG and print STDERR "Stack is nonempty at end-document: (",
$self->_dump_curr_open(), ")\n";
-
+
DEBUG > 9 and print STDERR "Stack: ", pretty($curr_open), "\n";
unshift @$paras, $self->_closers_for_all_curr_open;
# Make sure there is exactly one ~end in the parastack, at the end:
@@ -1205,11 +1439,11 @@ sub _ponder_doc_end {
# generate errata, and then another to be at the end
# when that loop back around to process the errata.
return 1;
-
+
} else {
DEBUG and print STDERR "Okay, stack is empty now.\n";
}
-
+
# Try generating errata section, if applicable
unless($self->{'~tried_gen_errata'}) {
$self->{'~tried_gen_errata'} = 1;
@@ -1220,7 +1454,7 @@ sub _ponder_doc_end {
return 1; # I.e., loop around again to process these fake-o paragraphs
}
}
-
+
splice @$paras; # Well, that's that for this paragraph buffer.
DEBUG and print STDERR "Throwing end-document event.\n";
@@ -1245,7 +1479,7 @@ sub _ponder_pod {
# The surrounding methods set content_seen, so let us remain consistent.
# I do not know why it was not here before -- should it not be here?
- # $self->{'content_seen'} ||= 1;
+ # $self->{'content_seen'} ||= 1 unless $self->{'~tried_gen_errata'};
return;
}
@@ -1278,8 +1512,9 @@ sub _ponder_over {
$para->[1]{'~type'} = $list_type;
push @$curr_open, $para;
# yes, we reuse the paragraph as a stack item
-
+
my $content = join ' ', splice @$para, 2;
+ $para->[1]{'~orig_content'} = $content;
my $overness;
if($content =~ m/^\s*$/s) {
$para->[1]{'indent'} = 4;
@@ -1301,13 +1536,13 @@ sub _ponder_over {
$para->[1]{'indent'} = 4;
}
DEBUG > 1 and print STDERR "=over found of type $list_type\n";
-
- $self->{'content_seen'} ||= 1;
+
+ $self->{'content_seen'} ||= 1 unless $self->{'~tried_gen_errata'};
$self->_handle_element_start((my $scratch = 'over-' . $list_type), $para->[1]);
return;
}
-
+
sub _ponder_back {
my ($self,$para,$curr_open,$paras) = @_;
# TODO: fire off </item-number> or </item-bullet> or </item-text> ??
@@ -1324,7 +1559,7 @@ sub _ponder_back {
DEBUG > 1 and print STDERR "=back happily closes matching =over\n";
# Expected case: we're closing the most recently opened thing
#my $over = pop @$curr_open;
- $self->{'content_seen'} ||= 1;
+ $self->{'content_seen'} ||= 1 unless $self->{'~tried_gen_errata'};
$self->_handle_element_end( my $scratch =
'over-' . ( (pop @$curr_open)->[1]{'~type'} ), $para->[1]
);
@@ -1354,10 +1589,10 @@ sub _ponder_item {
;
return 1;
}
-
-
+
+
my $over_type = $over->[1]{'~type'};
-
+
if(!$over_type) {
# Shouldn't happen1
die "Typeless over in stack, starting at line "
@@ -1382,7 +1617,7 @@ sub _ponder_item {
my $item_type = $self->_get_item_type($para);
# That kills the content of the item if it's a number or bullet.
DEBUG and print STDERR " Item is of type ", $para->[0], " under $over_type\n";
-
+
if($item_type eq 'text') {
# Nothing special needs doing for 'text'
} elsif($item_type eq 'number' or $item_type eq 'bullet') {
@@ -1398,16 +1633,16 @@ sub _ponder_item {
} else {
die "Unhandled item type $item_type"; # should never happen
}
-
+
# =item-text thingies don't need any assimilation, it seems.
} elsif($over_type eq 'number') {
my $item_type = $self->_get_item_type($para);
# That kills the content of the item if it's a number or bullet.
DEBUG and print STDERR " Item is of type ", $para->[0], " under $over_type\n";
-
+
my $expected_value = ++ $curr_open->[-1][1]{'~counter'};
-
+
if($item_type eq 'bullet') {
# Hm, it's not numeric. Correct for this.
$para->[1]{'number'} = $expected_value;
@@ -1432,7 +1667,7 @@ sub _ponder_item {
} elsif($expected_value == $para->[1]{'number'}) {
DEBUG > 1 and print STDERR " Numeric item has the expected value of $expected_value\n";
-
+
} else {
DEBUG > 1 and print STDERR " Numeric item has ", $para->[1]{'number'},
" instead of the expected value of $expected_value\n";
@@ -1443,7 +1678,7 @@ sub _ponder_item {
);
$para->[1]{'number'} = $expected_value; # correcting!!
}
-
+
if(@$para == 2) {
# For the cases where we /didn't/ push to @$para
if($paras->[0][0] eq '~Para') {
@@ -1460,13 +1695,13 @@ sub _ponder_item {
my $item_type = $self->_get_item_type($para);
# That kills the content of the item if it's a number or bullet.
DEBUG and print STDERR " Item is of type ", $para->[0], " under $over_type\n";
-
+
if($item_type eq 'bullet') {
# as expected!
if( $para->[1]{'~_freaky_para_hack'} ) {
DEBUG and print STDERR "Accomodating '=item * Foo' tolerance hack.\n";
- push @$para, delete $para->[1]{'~_freaky_para_hack'};
+ push @$para, $para->[1]{'~_freaky_para_hack'};
}
} elsif($item_type eq 'number') {
@@ -1533,30 +1768,44 @@ sub _ponder_Verbatim {
$para->[1]{'xml:space'} = 'preserve';
- my $indent = $self->strip_verbatim_indent;
- if ($indent && ref $indent eq 'CODE') {
- my @shifted = (shift @{$para}, shift @{$para});
- $indent = $indent->($para);
- unshift @{$para}, @shifted;
- }
-
- for(my $i = 2; $i < @$para; $i++) {
- foreach my $line ($para->[$i]) { # just for aliasing
- # Strip indentation.
- $line =~ s/^\Q$indent// if $indent
- && !($self->{accept_codes} && $self->{accept_codes}{VerbatimFormatted});
- while( $line =~
- # Sort of adapted from Text::Tabs -- yes, it's hardwired in that
- # tabs are at every EIGHTH column. For portability, it has to be
- # one setting everywhere, and 8th wins.
- s/^([^\t]*)(\t+)/$1.(" " x ((length($2)<<3)-(length($1)&7)))/e
- ) {}
+ unless ($self->{'_output_is_for_JustPod'}) {
+ # Fix illegal settings for expand_verbatim_tabs()
+ # This is because this module doesn't do input error checking, but khw
+ # doesn't want to add yet another instance of that.
+ $self->expand_verbatim_tabs(8)
+ if ! defined $self->expand_verbatim_tabs()
+ || $self->expand_verbatim_tabs() =~ /\D/;
+
+ my $indent = $self->strip_verbatim_indent;
+ if ($indent && ref $indent eq 'CODE') {
+ my @shifted = (shift @{$para}, shift @{$para});
+ $indent = $indent->($para);
+ unshift @{$para}, @shifted;
+ }
- # TODO: whinge about (or otherwise treat) unindented or overlong lines
+ for(my $i = 2; $i < @$para; $i++) {
+ foreach my $line ($para->[$i]) { # just for aliasing
+ # Strip indentation.
+ $line =~ s/^\Q$indent// if $indent;
+ next unless $self->expand_verbatim_tabs;
+
+ # This is commented out because of github issue #85, and the
+ # current maintainers don't know why it was there in the first
+ # place.
+ #&& !($self->{accept_codes} && $self->{accept_codes}{VerbatimFormatted});
+ while( $line =~
+ # Sort of adapted from Text::Tabs.
+ s/^([^\t]*)(\t+)/$1.(" " x ((length($2)
+ * $self->expand_verbatim_tabs)
+ -(length($1)&7)))/e
+ ) {}
+
+ # TODO: whinge about (or otherwise treat) unindented or overlong lines
+ }
}
}
-
+
# Now the VerbatimFormatted hoodoo...
if( $self->{'accept_codes'} and
$self->{'accept_codes'}{'VerbatimFormatted'}
@@ -1596,7 +1845,7 @@ sub _traverse_treelet_bit { # for use only by the routine above
my $scratch;
$self->_handle_element_start(($scratch=$name), shift @_);
-
+
while (@_) {
my $x = shift;
if (ref($x)) {
@@ -1606,7 +1855,7 @@ sub _traverse_treelet_bit { # for use only by the routine above
$self->_handle_text($x);
}
}
-
+
$self->_handle_element_end($scratch=$name);
return;
}
@@ -1651,7 +1900,7 @@ sub _closers_for_all_curr_open {
sub _verbatim_format {
my($it, $p) = @_;
-
+
my $formatting;
for(my $i = 2; $i < @$p; $i++) { # work backwards over the lines
@@ -1659,7 +1908,7 @@ sub _verbatim_format {
$p->[$i] .= "\n";
# Unlike with simple Verbatim blocks, we don't end up just doing
# a join("\n", ...) on the contents, so we have to append a
- # newline to ever line, and then nix the last one later.
+ # newline to every line, and then nix the last one later.
}
if( DEBUG > 4 ) {
@@ -1672,7 +1921,7 @@ sub _verbatim_format {
for(my $i = $#$p; $i > 2; $i--) {
# work backwards over the lines, except the first (#2)
-
+
#next unless $p->[$i] =~ m{^#:([ \^\/\%]*)\n?$}s
# and $p->[$i-1] !~ m{^#:[ \^\/\%]*\n?$}s;
# look at a formatty line preceding a nonformatty one
@@ -1680,7 +1929,7 @@ sub _verbatim_format {
if($p->[$i] =~ m{^#:([ \^\/\%]*)\n?$}s) {
DEBUG > 5 and print STDERR " It's a formatty line. ",
"Peeking at previous line ", $i-1, ": $$p[$i-1]: \n";
-
+
if( $p->[$i-1] =~ m{^#:[ \^\/\%]*\n?$}s ) {
DEBUG > 5 and print STDERR " Previous line is formatty! Skipping this one.\n";
next;
@@ -1696,11 +1945,11 @@ sub _verbatim_format {
# "^" to mean bold, "/" to mean underline, and "%" to mean bold italic.
# Example:
# What do you want? i like pie. [or whatever]
- # #:^^^^^^^^^^^^^^^^^ /////////////
-
+ # #:^^^^^^^^^^^^^^^^^ /////////////
+
DEBUG > 4 and print STDERR "_verbatim_format considers:\n<$p->[$i-1]>\n<$p->[$i]>\n";
-
+
$formatting = ' ' . $1;
$formatting =~ s/\s+$//s; # nix trailing whitespace
unless(length $formatting and $p->[$i-1] =~ m/\S/) { # no-op
@@ -1716,7 +1965,7 @@ sub _verbatim_format {
}
# Make $formatting and the previous line be exactly the same length,
# with $formatting having a " " as the last character.
-
+
DEBUG > 4 and print STDERR "Formatting <$formatting> on <", $p->[$i-1], ">\n";
@@ -1741,10 +1990,10 @@ sub _verbatim_format {
#print STDERR "Formatting <$new_line[-1][-1]> as $new_line[-1][0]\n";
}
}
- my @nixed =
+ my @nixed =
splice @$p, $i-1, 2, @new_line; # replace myself and the next line
DEBUG > 10 and print STDERR "Nixed count: ", scalar(@nixed), "\n";
-
+
DEBUG > 6 and print STDERR "New version of the above line is these tokens (",
scalar(@new_line), "):",
map( ref($_)?"<@$_> ":"<$_>", @new_line ), "\n";
@@ -1791,29 +2040,46 @@ sub _treelet_from_formatting_codes {
# [ 'B', {}, "pie" ],
# "!"
# ]
-
+ # This illustrates the general format of a treelet. It is an array:
+ # [0] is a scalar indicating its type. In the example above, the
+ # types are '~Top' and 'B'
+ # [1] is a hash of various flags about it, possibly empty
+ # [2] - [N] are an ordered list of the subcomponents of the treelet.
+ # Scalars are literal text, refs are sub-treelets, to
+ # arbitrary levels. Stringifying a treelet will recursively
+ # stringify the sub-treelets, concatentating everything
+ # together to form the exact text of the treelet.
+
my($self, $para, $start_line, $preserve_space) = @_;
-
+
my $treelet = ['~Top', {'start_line' => $start_line},];
-
+
unless ($preserve_space || $self->{'preserve_whitespace'}) {
$para =~ s/\s+/ /g; # collapse and trim all whitespace first.
$para =~ s/ $//;
$para =~ s/^ //;
}
-
+
# Only apparent problem the above code is that N<< >> turns into
# N<< >>. But then, word wrapping does that too! So don't do that!
-
+
+
+ # As a Start-code is encountered, the number of opening bracket '<'
+ # characters minus 1 is pushed onto @stack (so 0 means a single bracket,
+ # etc). When closing brackets are found in the text, at least this number
+ # (plus the 1) will be required to mean the Start-code is terminated. When
+ # those are found, @stack is popped.
my @stack;
+
my @lineage = ($treelet);
my $raw = ''; # raw content of L<> fcode before splitting/processing
# XXX 'raw' is not 100% accurate: all surrounding whitespace is condensed
- # into just 1 ' '. Is this the regex's doing or 'raw's?
+ # into just 1 ' '. Is this the regex's doing or 'raw's? Answer is it's
+ # the 'collapse and trim all whitespace first' lines just above.
my $inL = 0;
DEBUG > 4 and print STDERR "Paragraph:\n$para\n\n";
-
+
# Here begins our frightening tokenizer RE. The following regex matches
# text in four main parts:
#
@@ -1846,7 +2112,11 @@ sub _treelet_from_formatting_codes {
|
# Match multiple-bracket end codes. $3 gets the whitespace that
# should be discarded before an end bracket but kept in other cases
- # and $4 gets the end brackets themselves.
+ # and $4 gets the end brackets themselves. ($3 can be empty if the
+ # construct is empty, like C<< >>, and all the white-space has been
+ # gobbled up already, considered to be space after the opening
+ # bracket. In this case we use look-behind to verify that there are
+ # at least 2 spaces in a row before the ">".)
(\s+|(?<=\s\s))(>{2,})
|
(\s?>) # $5: simple end-codes
@@ -1872,23 +2142,48 @@ sub _treelet_from_formatting_codes {
) {
DEBUG > 4 and print STDERR "\nParagraphic tokenstack = (@stack)\n";
if(defined $1) {
+ my $bracket_count; # How many '<<<' in a row this has. Needed for
+ # Pod::Simple::JustPod
if(defined $2) {
DEBUG > 3 and print STDERR "Found complex start-text code \"$1\"\n";
- push @stack, length($2) + 1;
- # length of the necessary complex end-code string
+ $bracket_count = length($2) + 1;
+ push @stack, $bracket_count; # length of the necessary complex
+ # end-code string
} else {
DEBUG > 3 and print STDERR "Found simple start-text code \"$1\"\n";
push @stack, 0; # signal that we're looking for simple
+ $bracket_count = 1;
}
- push @lineage, [ substr($1,0,1), {}, ]; # new node object
- push @{ $lineage[-2] }, $lineage[-1];
- if ('L' eq substr($1,0,1)) {
- $raw = $inL ? $raw.$1 : ''; # reset raw content accumulator
- $inL = 1;
+ my $code = substr($1,0,1);
+ if ('L' eq $code) {
+ if ($inL) {
+ $raw .= $1;
+ $self->scream( $start_line,
+ 'Nested L<> are illegal. Pretending inner one is '
+ . 'X<...> so can continue looking for other errors.');
+ $code = "X";
+ }
+ else {
+ $raw = ""; # reset raw content accumulator
+ $inL = @stack;
+ }
} else {
$raw .= $1 if $inL;
}
-
+ push @lineage, [ $code, {}, ]; # new node object
+
+ # Tell Pod::Simple::JustPod how many brackets there were, but to save
+ # space, not in the most usual case of there was just 1. It can be
+ # inferred by the absence of this element. Similarly, if there is more
+ # than one bracket, extract the white space between the final bracket
+ # and the real beginning of the interior. Save that if it isn't just a
+ # single space
+ if ($self->{'_output_is_for_JustPod'} && $bracket_count > 1) {
+ $lineage[-1][1]{'~bracket_count'} = $bracket_count;
+ my $lspacer = substr($1, 1 + $bracket_count);
+ $lineage[-1][1]{'~lspacer'} = $lspacer if $lspacer ne " ";
+ }
+ push @{ $lineage[-2] }, $lineage[-1];
} elsif(defined $4) {
DEBUG > 3 and print STDERR "Found apparent complex end-text code \"$3$4\"\n";
# This is where it gets messy...
@@ -1917,20 +2212,35 @@ sub _treelet_from_formatting_codes {
}
#print STDERR "\nHOOBOY ", scalar(@{$lineage[-1]}), "!!!\n";
+ if ($3 ne " " && $self->{'_output_is_for_JustPod'}) {
+ if ($3 ne "") {
+ $lineage[-1][1]{'~rspacer'} = $3;
+ }
+ elsif ($lineage[-1][1]{'~lspacer'} eq " ") {
+
+ # Here we had something like C<< >> which was a false positive
+ delete $lineage[-1][1]{'~lspacer'};
+ }
+ else {
+ $lineage[-1][1]{'~rspacer'}
+ = substr($lineage[-1][1]{'~lspacer'}, -1, 1);
+ chop $lineage[-1][1]{'~lspacer'};
+ }
+ }
+
push @{ $lineage[-1] }, '' if 2 == @{ $lineage[-1] };
# Keep the element from being childless
-
- pop @stack;
- pop @lineage;
- unless (@stack) { # not in an L if there are no open fcodes
+ if ($inL == @stack) {
+ $lineage[-1][1]{'raw'} = $raw;
$inL = 0;
- if (ref $lineage[-1][-1] && $lineage[-1][-1][0] eq 'L') {
- $lineage[-1][-1][1]{'raw'} = $raw
- }
}
+
+ pop @stack;
+ pop @lineage;
+
$raw .= $3.$4 if $inL;
-
+
} elsif(defined $5) {
DEBUG > 3 and print STDERR "Found apparent simple end-text code \"$5\"\n";
@@ -1944,6 +2254,11 @@ sub _treelet_from_formatting_codes {
push @{ $lineage[-1] }, ''; # keep it from being really childless
}
+ if ($inL == @stack) {
+ $lineage[-1][1]{'raw'} = $raw;
+ $inL = 0;
+ }
+
pop @stack;
pop @lineage;
} else {
@@ -1951,12 +2266,6 @@ sub _treelet_from_formatting_codes {
push @{ $lineage[-1] }, $5;
}
- unless (@stack) { # not in an L if there are no open fcodes
- $inL = 0;
- if (ref $lineage[-1][-1] && $lineage[-1][-1][0] eq 'L') {
- $lineage[-1][-1][1]{'raw'} = $raw
- }
- }
$raw .= $5 if $inL;
} elsif(defined $6) {
@@ -1965,6 +2274,7 @@ sub _treelet_from_formatting_codes {
$raw .= $6 if $inL;
# XXX does not capture multiplace whitespaces -- 'raw' ends up with
# at most 1 leading/trailing whitespace, why not all of it?
+ # Answer, because we deliberately trimmed it above
} else {
# should never ever ever ever happen
@@ -2095,7 +2405,7 @@ sub pretty { # adopted from Class::Classless
# letters, but I don't know if it has always worked without bugs. It
# seemed safest just to list the characters.
# s<([^\x20\x21\x23\x27-\x3F\x41-\x5B\x5D-\x7E])>
- s<([^ !#'()*+,\-./0123456789:;\<=\>?ABCDEFGHIJKLMNOPQRSTUVWXYZ\[\]^_`abcdefghijklmnopqrstuvwxyz{|}~])>
+ s<([^ !"#'()*+,\-./0123456789:;\<=\>?ABCDEFGHIJKLMNOPQRSTUVWXYZ\[\]^_`abcdefghijklmnopqrstuvwxyz{|}~])>
<$pretty_form{$1} || '\\x{'.sprintf("%x", ord($1)).'}'>eg;
#<$pretty_form{$1} || '\\x'.(unpack("H2",$1))>eg;
qq{"$_"};
diff --git a/Master/tlpkg/tlperl/lib/Pod/Simple/Checker.pm b/Master/tlpkg/tlperl/lib/Pod/Simple/Checker.pm
index 83415f8e25e..2fef0305a5c 100644
--- a/Master/tlpkg/tlperl/lib/Pod/Simple/Checker.pm
+++ b/Master/tlpkg/tlperl/lib/Pod/Simple/Checker.pm
@@ -9,7 +9,7 @@ use Carp ();
use Pod::Simple::Methody ();
use Pod::Simple ();
use vars qw( @ISA $VERSION );
-$VERSION = '3.35';
+$VERSION = '3.40';
@ISA = ('Pod::Simple::Methody');
BEGIN { *DEBUG = defined(&Pod::Simple::DEBUG)
? \&Pod::Simple::DEBUG
@@ -88,8 +88,10 @@ sub end_item_text { $_[0]->emit_par(-2) }
sub emit_par {
return unless $_[0]{'Errata_seen'};
my($self, $tweak_indent) = splice(@_,0,2);
- my $indent = ' ' x ( 2 * $self->{'Indent'} + ($tweak_indent||0) );
+ my $length = 2 * $self->{'Indent'} + ($tweak_indent||0);
+ my $indent = ' ' x ($length > 0 ? $length : 0);
# Yes, 'STRING' x NEGATIVE gives '', same as 'STRING' x 0
+ # 'Negative repeat count does nothing' since 5.22
$self->{'Thispara'} =~ s/$Pod::Simple::shy//g;
my $out = Text::Wrap::wrap($indent, $indent, $self->{'Thispara'} .= "\n");
diff --git a/Master/tlpkg/tlperl/lib/Pod/Simple/Debug.pm b/Master/tlpkg/tlperl/lib/Pod/Simple/Debug.pm
index 428cc723594..aaa5a887e6b 100644
--- a/Master/tlpkg/tlperl/lib/Pod/Simple/Debug.pm
+++ b/Master/tlpkg/tlperl/lib/Pod/Simple/Debug.pm
@@ -2,7 +2,7 @@ require 5;
package Pod::Simple::Debug;
use strict;
use vars qw($VERSION );
-$VERSION = '3.35';
+$VERSION = '3.40';
sub import {
my($value,$variable);
diff --git a/Master/tlpkg/tlperl/lib/Pod/Simple/DumpAsText.pm b/Master/tlpkg/tlperl/lib/Pod/Simple/DumpAsText.pm
index 71bef5070be..bade6fcc472 100644
--- a/Master/tlpkg/tlperl/lib/Pod/Simple/DumpAsText.pm
+++ b/Master/tlpkg/tlperl/lib/Pod/Simple/DumpAsText.pm
@@ -1,7 +1,7 @@
require 5;
package Pod::Simple::DumpAsText;
-$VERSION = '3.35';
+$VERSION = '3.40';
use Pod::Simple ();
BEGIN {@ISA = ('Pod::Simple')}
diff --git a/Master/tlpkg/tlperl/lib/Pod/Simple/DumpAsXML.pm b/Master/tlpkg/tlperl/lib/Pod/Simple/DumpAsXML.pm
index 9d84878cb78..6f0b7b18621 100644
--- a/Master/tlpkg/tlperl/lib/Pod/Simple/DumpAsXML.pm
+++ b/Master/tlpkg/tlperl/lib/Pod/Simple/DumpAsXML.pm
@@ -1,7 +1,7 @@
require 5;
package Pod::Simple::DumpAsXML;
-$VERSION = '3.35';
+$VERSION = '3.40';
use Pod::Simple ();
BEGIN {@ISA = ('Pod::Simple')}
diff --git a/Master/tlpkg/tlperl/lib/Pod/Simple/HTML.pm b/Master/tlpkg/tlperl/lib/Pod/Simple/HTML.pm
index 9cdbed217e5..0219b979100 100644
--- a/Master/tlpkg/tlperl/lib/Pod/Simple/HTML.pm
+++ b/Master/tlpkg/tlperl/lib/Pod/Simple/HTML.pm
@@ -9,7 +9,7 @@ use vars qw(
$Doctype_decl $Content_decl
);
@ISA = ('Pod::Simple::PullParser');
-$VERSION = '3.35';
+$VERSION = '3.40';
BEGIN {
if(defined &DEBUG) { } # no-op
elsif( defined &Pod::Simple::DEBUG ) { *DEBUG = \&Pod::Simple::DEBUG }
@@ -29,7 +29,7 @@ $LamePad = '' unless defined $LamePad;
$Linearization_Limit = 120 unless defined $Linearization_Limit;
# headings/items longer than that won't get an <a name="...">
-$Perldoc_URL_Prefix = 'http://search.cpan.org/perldoc?'
+$Perldoc_URL_Prefix = 'https://metacpan.org/pod/'
unless defined $Perldoc_URL_Prefix;
$Perldoc_URL_Postfix = ''
unless defined $Perldoc_URL_Postfix;
diff --git a/Master/tlpkg/tlperl/lib/Pod/Simple/HTMLBatch.pm b/Master/tlpkg/tlperl/lib/Pod/Simple/HTMLBatch.pm
index 661266d0de4..227d6d3af0d 100644
--- a/Master/tlpkg/tlperl/lib/Pod/Simple/HTMLBatch.pm
+++ b/Master/tlpkg/tlperl/lib/Pod/Simple/HTMLBatch.pm
@@ -5,7 +5,7 @@ use strict;
use vars qw( $VERSION $HTML_RENDER_CLASS $HTML_EXTENSION
$CSS $JAVASCRIPT $SLEEPY $SEARCH_CLASS @ISA
);
-$VERSION = '3.35';
+$VERSION = '3.40';
@ISA = (); # Yup, we're NOT a subclass of Pod::Simple::HTML!
# TODO: nocontents stylesheets. Strike some of the color variations?
@@ -720,22 +720,21 @@ sub _gen_css_wad {
}
# Now a few indexless variations:
- foreach my $variation (
- 'blkbluw', # black_with_blue_on_white
- 'whtpurk', # white_with_purple_on_black
- 'whtgrng', # white_with_green_on_grey
- 'grygrnw', # grey_with_green_on_white
- ) {
- my $outname = $variation;
+ for (my ($outfile, $variation) = each %{{
+ blkbluw => 'black_with_blue_on_white',
+ whtpurk => 'white_with_purple_on_black',
+ whtgrng => 'white_with_green_on_grey',
+ grygrnw => 'grey_with_green_on_white',
+ }}) {
my $this_css = join "\n",
- "/* This file is autogenerated. Do not edit. $outname */\n",
+ "/* This file is autogenerated. Do not edit. $outfile */\n",
"\@import url(\"./_$variation.css\");",
".indexgroup { display: none; }",
"\n",
;
- my $name = $outname;
+ my $name = $outfile;
$name =~ tr/-_/ /;
- $self->add_css( "_$outname.css", 0, $name, 0, 0, \$this_css);
+ $self->add_css( "_$outfile.css", 0, $name, 0, 0, \$this_css);
}
return;
@@ -1110,12 +1109,15 @@ Example:
=item $batchconv = Pod::Simple::HTMLBatch->new;
-This TODO
-
+This creates a new batch converter. The method doesn't take parameters.
+To change the converter's attributes, use the L<"/ACCESSOR METHODS">
+below.
=item $batchconv->batch_convert( I<indirs>, I<outdir> );
-this TODO
+This searches the directories given in I<indirs> and writes
+HTML files for each of these to a corresponding directory
+in I<outdir>. The directory I<outdir> must exist.
=item $batchconv->batch_convert( undef , ...);
diff --git a/Master/tlpkg/tlperl/lib/Pod/Simple/JustPod.pm b/Master/tlpkg/tlperl/lib/Pod/Simple/JustPod.pm
new file mode 100644
index 00000000000..c7ad3d69770
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Pod/Simple/JustPod.pm
@@ -0,0 +1,362 @@
+use 5;
+package Pod::Simple::JustPod;
+# ABSTRACT: Pod::Simple formatter that extracts POD from a file containing
+# other things as well
+use strict;
+use warnings;
+
+use Pod::Simple::Methody ();
+our @ISA = ('Pod::Simple::Methody');
+
+sub new {
+ my $self = shift;
+ my $new = $self->SUPER::new(@_);
+
+ $new->accept_targets('*');
+ $new->keep_encoding_directive(1);
+ $new->preserve_whitespace(1);
+ $new->complain_stderr(1);
+ $new->_output_is_for_JustPod(1);
+
+ return $new;
+}
+
+#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+sub check_that_all_is_closed {
+
+ # Actually checks that the things we depend on being balanced in fact are,
+ # so that we can continue in spit of pod errors
+
+ my $self = shift;
+ while ($self->{inL}) {
+ $self->end_L(@_);
+ }
+ while ($self->{fcode_end} && @{$self->{fcode_end}}) {
+ $self->_end_fcode(@_);
+ }
+}
+
+sub handle_text {
+
+ # Add text to the output buffer. This is skipped if within a L<>, as we use
+ # the 'raw' attribute of that tag instead.
+
+ $_[0]{buffer} .= $_[1] unless $_[0]{inL} ;
+}
+
+sub spacer {
+
+ # Prints the white space following things like =head1. This is normally a
+ # blank, unless BlackBox has told us otherwise.
+
+ my ($self, $arg) = @_;
+ return unless $arg;
+
+ my $spacer = ($arg->{'~orig_spacer'})
+ ? $arg->{'~orig_spacer'}
+ : " ";
+ $self->handle_text($spacer);
+}
+
+sub _generic_start {
+
+ # Called from tags like =head1, etc.
+
+ my ($self, $text, $arg) = @_;
+ $self->check_that_all_is_closed();
+ $self->handle_text($text);
+ $self->spacer($arg);
+}
+
+sub start_Document { shift->_generic_start("=pod\n\n"); }
+sub start_head1 { shift->_generic_start('=head1', @_); }
+sub start_head2 { shift->_generic_start('=head2', @_); }
+sub start_head3 { shift->_generic_start('=head3', @_); }
+sub start_head4 { shift->_generic_start('=head4', @_); }
+sub start_encoding { shift->_generic_start('=encoding', @_); }
+# sub start_Para
+# sub start_Verbatim
+
+sub start_item_bullet { # Handle =item *
+ my ($self, $arg) = @_;
+ $self->check_that_all_is_closed();
+ $self->handle_text('=item');
+
+ # It can be that they said simply '=item', and it is inferred that it is to
+ # be a bullet.
+ if (! $arg->{'~orig_content'}) {
+ $self->handle_text("\n\n");
+ }
+ else {
+ $self->spacer($arg);
+ if ($arg->{'~_freaky_para_hack'}) {
+
+ # See Message Id <87y3gtcwa2.fsf@hope.eyrie.org>
+ my $item_text = $arg->{'~orig_content'};
+ my $trailing = quotemeta $arg->{'~_freaky_para_hack'};
+ $item_text =~ s/$trailing$//;
+ $self->handle_text($item_text);
+ }
+ else {
+ $self->handle_text("*\n\n");
+ }
+ }
+}
+
+sub start_item_number { # Handle '=item 2'
+ my ($self, $arg) = @_;
+ $self->check_that_all_is_closed();
+ $self->handle_text("=item");
+ $self->spacer($arg);
+ $self->handle_text("$arg->{'~orig_content'}\n\n");
+}
+
+sub start_item_text { # Handle '=item foo bar baz'
+ my ($self, $arg) = @_;
+ $self->check_that_all_is_closed();
+ $self->handle_text('=item');
+ $self->spacer($arg);
+}
+
+sub _end_item {
+ my $self = shift;
+ $self->check_that_all_is_closed();
+ $self->emit;
+}
+
+*end_item_bullet = *_end_item;
+*end_item_number = *_end_item;
+*end_item_text = *_end_item;
+
+sub _start_over { # Handle =over
+ my ($self, $arg) = @_;
+ $self->check_that_all_is_closed();
+ $self->handle_text("=over");
+
+ # The =over amount is optional
+ if ($arg->{'~orig_content'}) {
+ $self->spacer($arg);
+ $self->handle_text("$arg->{'~orig_content'}");
+ }
+ $self->handle_text("\n\n");
+}
+
+*start_over_bullet = *_start_over;
+*start_over_number = *_start_over;
+*start_over_text = *_start_over;
+*start_over_block = *_start_over;
+
+sub _end_over {
+ my $self = shift;
+ $self->check_that_all_is_closed();
+ $self->handle_text('=back');
+ $self->emit;
+}
+
+*end_over_bullet = *_end_over;
+*end_over_number = *_end_over;
+*end_over_text = *_end_over;
+*end_over_block = *_end_over;
+
+sub end_Document {
+ my $self = shift;
+ $self->emit; # Make sure buffer gets flushed
+ print {$self->{'output_fh'} } "=cut\n"
+}
+
+sub _end_generic {
+ my $self = shift;
+ $self->check_that_all_is_closed();
+ $self->emit;
+}
+
+*end_head1 = *_end_generic;
+*end_head2 = *_end_generic;
+*end_head3 = *_end_generic;
+*end_head4 = *_end_generic;
+*end_encoding = *_end_generic;
+*end_Para = *_end_generic;
+*end_Verbatim = *_end_generic;
+
+sub _start_fcode {
+ my ($type, $self, $flags) = @_;
+
+ # How many brackets is set by BlackBox unless the count is 1
+ my $bracket_count = (exists $flags->{'~bracket_count'})
+ ? $flags->{'~bracket_count'}
+ : 1;
+ $self->handle_text($type . ( "<" x $bracket_count));
+
+ my $rspacer = "";
+ if ($bracket_count > 1) {
+ my $lspacer = (exists $flags->{'~lspacer'})
+ ? $flags->{'~lspacer'}
+ : " ";
+ $self->handle_text($lspacer);
+
+ $rspacer = (exists $flags->{'~rspacer'})
+ ? $flags->{'~rspacer'}
+ : " ";
+ }
+
+ # BlackBox doesn't output things for for the ending code callbacks, so save
+ # what we need.
+ push @{$self->{'fcode_end'}}, [ $bracket_count, $rspacer ];
+}
+
+sub start_B { _start_fcode('B', @_); }
+sub start_C { _start_fcode('C', @_); }
+sub start_E { _start_fcode('E', @_); }
+sub start_F { _start_fcode('F', @_); }
+sub start_I { _start_fcode('I', @_); }
+sub start_S { _start_fcode('S', @_); }
+sub start_X { _start_fcode('X', @_); }
+sub start_Z { _start_fcode('Z', @_); }
+
+sub _end_fcode {
+ my $self = shift;
+ my $fcode_end = pop @{$self->{'fcode_end'}};
+ my $bracket_count = 1;
+ my $rspacer = "";
+
+ if (! defined $fcode_end) { # If BlackBox is working, this shouldn't
+ # happen, but verify
+ $self->whine($self->{line_count}, "Extra '>'");
+ }
+ else {
+ $bracket_count = $fcode_end->[0];
+ $rspacer = $fcode_end->[1];
+ }
+
+ $self->handle_text($rspacer) if $bracket_count > 1;
+ $self->handle_text(">" x $bracket_count);
+}
+
+*end_B = *_end_fcode;
+*end_C = *_end_fcode;
+*end_E = *_end_fcode;
+*end_F = *_end_fcode;
+*end_I = *_end_fcode;
+*end_S = *_end_fcode;
+*end_X = *_end_fcode;
+*end_Z = *_end_fcode;
+
+sub start_L {
+ _start_fcode('L', @_);
+ $_[0]->handle_text($_[1]->{raw});
+ $_[0]->{inL}++
+}
+
+sub end_L {
+ my $self = shift;
+ $self->{inL}--;
+ if ($self->{inL} < 0) { # If BlackBox is working, this shouldn't
+ # happen, but verify
+ $self->whine($self->{line_count}, "Extra '>' ending L<>");
+ $self->{inL} = 0;
+ }
+
+ $self->_end_fcode(@_);
+}
+
+sub emit {
+ my $self = shift;
+
+ if ($self->{buffer} ne "") {
+ print { $self->{'output_fh'} } "",$self->{buffer} ,"\n\n";
+
+ $self->{buffer} = "";
+ }
+
+ return;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Pod::Simple::JustPod -- just the Pod, the whole Pod, and nothing but the Pod
+
+=head1 SYNOPSIS
+
+ my $infile = "mixed_code_and_pod.pm";
+ my $outfile = "just_the_pod.pod";
+ open my $fh, ">$outfile" or die "Can't write to $outfile: $!";
+
+ my $parser = Pod::Simple::JustPod->new();
+ $parser->output_fh($fh);
+ $parser->parse_file($infile);
+ close $fh or die "Can't close $outfile: $!";
+
+=head1 DESCRIPTION
+
+This class returns a copy of its input, translated into Perl's internal
+encoding (UTF-8), and with all the non-Pod lines removed.
+
+This is a subclass of L<Pod::Simple::Methody> and inherits all its methods.
+And since, that in turn is a subclass of L<Pod::Simple>, you can use any of
+its methods. This means you can output to a string instead of a file, or
+you can parse from an array.
+
+This class strives to return the Pod lines of the input completely unchanged,
+except for any necessary translation into Perl's internal encoding, and it makes
+no effort to return trailing spaces on lines; these likely will be stripped.
+If the input pod is well-formed with no warnings nor errors generated, the
+extracted pod should generate the same documentation when formatted by a Pod
+formatter as the original file does.
+
+By default, warnings are output to STDERR
+
+=head1 SEE ALSO
+
+L<Pod::Simple>, L<Pod::Simple::Methody>
+
+=head1 SUPPORT
+
+Questions or discussion about POD and Pod::Simple should be sent to the
+L<mailto:pod-people@perl.org> mail list. Send an empty email to
+L<mailto:pod-people-subscribe@perl.org> to subscribe.
+
+This module is managed in an open GitHub repository,
+L<https://github.com/theory/pod-simple/>. Feel free to fork and contribute, or
+to clone L<git://github.com/theory/pod-simple.git> and send patches!
+
+Patches against Pod::Simple are welcome. Please send bug reports to
+L<mailto:<bug-pod-simple@rt.cpan.org>.
+
+=head1 COPYRIGHT AND DISCLAIMERS
+
+Copyright (c) 2002 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
+
+Pod::Simple was created by Sean M. Burke <sburke@cpan.org>.
+But don't bother him, he's retired.
+
+Pod::Simple is maintained by:
+
+=over
+
+=item * Allison Randal C<allison@perl.org>
+
+=item * Hans Dieter Pearcey C<hdp@cpan.org>
+
+=item * David E. Wheeler C<dwheeler@cpan.org>
+
+=back
+
+Pod::Simple::JustPod was developed by John SJ Anderson
+C<genehack@genehack.org>, with contributions from Karl Williamson
+C<khw@cpan.org>.
+
+=cut
diff --git a/Master/tlpkg/tlperl/lib/Pod/Simple/LinkSection.pm b/Master/tlpkg/tlperl/lib/Pod/Simple/LinkSection.pm
index 04612f202e9..b9ca19cdf93 100644
--- a/Master/tlpkg/tlperl/lib/Pod/Simple/LinkSection.pm
+++ b/Master/tlpkg/tlperl/lib/Pod/Simple/LinkSection.pm
@@ -2,13 +2,11 @@
require 5;
package Pod::Simple::LinkSection;
# Based somewhat dimly on Array::Autojoin
-use vars qw($VERSION );
-$VERSION = '3.35';
use strict;
use Pod::Simple::BlackBox;
use vars qw($VERSION );
-$VERSION = '3.35';
+$VERSION = '3.40';
use overload( # So it'll stringify nice
'""' => \&Pod::Simple::BlackBox::stringify_lol,
diff --git a/Master/tlpkg/tlperl/lib/Pod/Simple/Methody.pm b/Master/tlpkg/tlperl/lib/Pod/Simple/Methody.pm
index 67b87067416..5bcee54d4f7 100644
--- a/Master/tlpkg/tlperl/lib/Pod/Simple/Methody.pm
+++ b/Master/tlpkg/tlperl/lib/Pod/Simple/Methody.pm
@@ -4,7 +4,7 @@ package Pod::Simple::Methody;
use strict;
use Pod::Simple ();
use vars qw(@ISA $VERSION);
-$VERSION = '3.35';
+$VERSION = '3.40';
@ISA = ('Pod::Simple');
# Yes, we could use named variables, but I want this to be impose
diff --git a/Master/tlpkg/tlperl/lib/Pod/Simple/Progress.pm b/Master/tlpkg/tlperl/lib/Pod/Simple/Progress.pm
index 0c18a5b37d6..3d6f4031125 100644
--- a/Master/tlpkg/tlperl/lib/Pod/Simple/Progress.pm
+++ b/Master/tlpkg/tlperl/lib/Pod/Simple/Progress.pm
@@ -1,7 +1,7 @@
require 5;
package Pod::Simple::Progress;
-$VERSION = '3.35';
+$VERSION = '3.40';
use strict;
# Objects of this class are used for noting progress of an
diff --git a/Master/tlpkg/tlperl/lib/Pod/Simple/PullParser.pm b/Master/tlpkg/tlperl/lib/Pod/Simple/PullParser.pm
index 7c326ec6aee..ceeb3f92504 100644
--- a/Master/tlpkg/tlperl/lib/Pod/Simple/PullParser.pm
+++ b/Master/tlpkg/tlperl/lib/Pod/Simple/PullParser.pm
@@ -1,6 +1,6 @@
require 5;
package Pod::Simple::PullParser;
-$VERSION = '3.35';
+$VERSION = '3.40';
use Pod::Simple ();
BEGIN {@ISA = ('Pod::Simple')}
diff --git a/Master/tlpkg/tlperl/lib/Pod/Simple/PullParserEndToken.pm b/Master/tlpkg/tlperl/lib/Pod/Simple/PullParserEndToken.pm
index d3066a8e87c..d9ebdcbcf0e 100644
--- a/Master/tlpkg/tlperl/lib/Pod/Simple/PullParserEndToken.pm
+++ b/Master/tlpkg/tlperl/lib/Pod/Simple/PullParserEndToken.pm
@@ -5,7 +5,7 @@ use Pod::Simple::PullParserToken ();
use strict;
use vars qw(@ISA $VERSION);
@ISA = ('Pod::Simple::PullParserToken');
-$VERSION = '3.35';
+$VERSION = '3.40';
sub new { # Class->new(tagname);
my $class = shift;
diff --git a/Master/tlpkg/tlperl/lib/Pod/Simple/PullParserStartToken.pm b/Master/tlpkg/tlperl/lib/Pod/Simple/PullParserStartToken.pm
index d938e0adb21..61608fb466c 100644
--- a/Master/tlpkg/tlperl/lib/Pod/Simple/PullParserStartToken.pm
+++ b/Master/tlpkg/tlperl/lib/Pod/Simple/PullParserStartToken.pm
@@ -5,7 +5,7 @@ use Pod::Simple::PullParserToken ();
use strict;
use vars qw(@ISA $VERSION);
@ISA = ('Pod::Simple::PullParserToken');
-$VERSION = '3.35';
+$VERSION = '3.40';
sub new { # Class->new(tagname, optional_attrhash);
my $class = shift;
diff --git a/Master/tlpkg/tlperl/lib/Pod/Simple/PullParserTextToken.pm b/Master/tlpkg/tlperl/lib/Pod/Simple/PullParserTextToken.pm
index a11ce0fd92d..c8247a081e7 100644
--- a/Master/tlpkg/tlperl/lib/Pod/Simple/PullParserTextToken.pm
+++ b/Master/tlpkg/tlperl/lib/Pod/Simple/PullParserTextToken.pm
@@ -5,7 +5,7 @@ use Pod::Simple::PullParserToken ();
use strict;
use vars qw(@ISA $VERSION);
@ISA = ('Pod::Simple::PullParserToken');
-$VERSION = '3.35';
+$VERSION = '3.40';
sub new { # Class->new(text);
my $class = shift;
diff --git a/Master/tlpkg/tlperl/lib/Pod/Simple/PullParserToken.pm b/Master/tlpkg/tlperl/lib/Pod/Simple/PullParserToken.pm
index c6618168e6b..f14b5637cd4 100644
--- a/Master/tlpkg/tlperl/lib/Pod/Simple/PullParserToken.pm
+++ b/Master/tlpkg/tlperl/lib/Pod/Simple/PullParserToken.pm
@@ -3,7 +3,7 @@ require 5;
package Pod::Simple::PullParserToken;
# Base class for tokens gotten from Pod::Simple::PullParser's $parser->get_token
@ISA = ();
-$VERSION = '3.35';
+$VERSION = '3.40';
use strict;
sub new { # Class->new('type', stuff...); ## Overridden in derived classes anyway
diff --git a/Master/tlpkg/tlperl/lib/Pod/Simple/RTF.pm b/Master/tlpkg/tlperl/lib/Pod/Simple/RTF.pm
index 153c3d3e287..ed0de149ae0 100644
--- a/Master/tlpkg/tlperl/lib/Pod/Simple/RTF.pm
+++ b/Master/tlpkg/tlperl/lib/Pod/Simple/RTF.pm
@@ -8,24 +8,67 @@ package Pod::Simple::RTF;
use strict;
use vars qw($VERSION @ISA %Escape $WRAP %Tagmap);
-$VERSION = '3.35';
+$VERSION = '3.40';
use Pod::Simple::PullParser ();
BEGIN {@ISA = ('Pod::Simple::PullParser')}
use Carp ();
BEGIN { *DEBUG = \&Pod::Simple::DEBUG unless defined &DEBUG }
+sub to_uni ($) { # Convert native code point to Unicode
+ my $x = shift;
+
+ # Broken for early EBCDICs
+ $x = chr utf8::native_to_unicode(ord $x) if $] ge 5.007_003
+ && ord("A") != 65;
+ return $x;
+}
+
+# We escape out 'F' so that we can send RTF files thru the mail without the
+# slightest worry that paragraphs beginning with "From" will get munged.
+# We also escape '\', '{', '}', and '_'
+my $map_to_self = ' !"#$%&\'()*+,-./0123456789:;<=>?@ABCDEGHIJKLMNOPQRSTUVWXYZ[]^`abcdefghijklmnopqrstuvwxyz|~';
+
$WRAP = 1 unless defined $WRAP;
+%Escape = (
+
+ # Start with every character mapping to its hex equivalent
+ map( (chr($_) => sprintf("\\'%02x", $_)), 0 .. 0xFF),
+
+ # Override most ASCII printables with themselves (or on non-ASCII platforms,
+ # their ASCII values. This is because the output is UTF-16, which is always
+ # based on Unicode code points)
+ map( ( substr($map_to_self, $_, 1)
+ => to_uni(substr($map_to_self, $_, 1))), 0 .. length($map_to_self) - 1),
+
+ # And some refinements:
+ "\r" => "\n",
+ "\cj" => "\n",
+ "\n" => "\n\\line ",
+
+ "\t" => "\\tab ", # Tabs (altho theoretically raw \t's are okay)
+ "\f" => "\n\\page\n", # Formfeed
+ "-" => "\\_", # Turn plaintext '-' into a non-breaking hyphen
+ $Pod::Simple::nbsp => "\\~", # Latin-1 non-breaking space
+ $Pod::Simple::shy => "\\-", # Latin-1 soft (optional) hyphen
-# These are broken for early Perls on EBCDIC; they could be fixed to work
-# better there, but not worth it. These are part of a larger [...] class, so
-# are just the strings to substitute into it, as opposed to compiled patterns.
-my $cntrl = '[:cntrl:]';
-$cntrl = '\x00-\x1F\x7F' unless eval "qr/[$cntrl]/";
+ # CRAZY HACKS:
+ "\n" => "\\line\n",
+ "\r" => "\n",
+ "\cb" => "{\n\\cs21\\lang1024\\noproof ", # \\cf1
+ "\cc" => "}",
+);
-my $not_ascii = '[:^ascii:]';
-$not_ascii = '\x80-\xFF' unless eval "qr/[$not_ascii]/";
+# Generate a string of all the characters in %Escape that don't map to
+# themselves. First, one without the hyphen, then one with.
+my $escaped_sans_hyphen = "";
+$escaped_sans_hyphen .= $_ for grep { $_ ne $Escape{$_} && $_ ne '-' }
+ sort keys %Escape;
+my $escaped = "-$escaped_sans_hyphen";
+# Then convert to patterns
+$escaped_sans_hyphen = qr/[\Q$escaped_sans_hyphen \E]/;
+$escaped= qr/[\Q$escaped\E]/;
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -158,6 +201,13 @@ sub run {
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+# Match something like an identifier. Prefer XID if available, then plain ID,
+# then just ASCII
+my $id_re = Pod::Simple::BlackBox::my_qr('[\'_\p{XIDS}][\'\p{XIDC}]+', "ab");
+$id_re = Pod::Simple::BlackBox::my_qr('[\'_\p{IDS}][\'\p{IDC}]+', "ab")
+ unless $id_re;
+$id_re = qr/['_a-zA-Z]['a-zA-Z0-9_]+/ unless $id_re;
+
sub do_middle { # the main work
my $self = $_[0];
my $fh = $self->{'output_fh'};
@@ -172,7 +222,7 @@ sub do_middle { # the main work
if( ($type = $token->type) eq 'text' ) {
if( $self->{'rtfverbatim'} ) {
DEBUG > 1 and print STDERR " $type " , $token->text, " in verbatim!\n";
- rtf_esc_codely($scratch = $token->text);
+ rtf_esc(0, $scratch = $token->text); # 0 => Don't escape hyphen
print $fh $scratch;
next;
}
@@ -195,13 +245,13 @@ sub do_middle { # the main work
|
# or starting alpha, but containing anything strange:
(?:
- [a-zA-Z'${not_ascii}]+[\$\@\:_<>\(\\\*]\S+
+ ${id_re}[\$\@\:_<>\(\\\*]\S+
)
)
/\cb$1\cc/xsg
;
- rtf_esc($scratch);
+ rtf_esc(1, $scratch); # 1 => escape hyphen
$scratch =~
s/(
[^\r\n]{65} # Snare 65 characters from a line
@@ -311,7 +361,7 @@ sub do_middle { # the main work
print $fh $token->attr('number'), ". \n";
} elsif ($tagname eq 'item-bullet') {
print $fh "\\'", ord("_"), "\n";
- #for funky testing: print $fh '', rtf_esc("\x{4E4B}\x{9053}");
+ #for funky testing: print $fh '', rtf_esc(1, "\x{4E4B}\x{9053}");
}
} elsif( $type eq 'end' ) {
@@ -465,7 +515,7 @@ sub doc_start {
# catches the most common case, at least
DEBUG and print STDERR "Title0: <$title>\n";
- $title = rtf_esc($title);
+ $title = rtf_esc(1, $title); # 1 => escape hyphen
DEBUG and print STDERR "Title1: <$title>\n";
$title = '\lang1024\noproof ' . $title
if $is_obviously_module_name;
@@ -489,90 +539,69 @@ END
#-------------------------------------------------------------------------
use integer;
-sub rtf_esc {
- my $x; # scratch
- if(!defined wantarray) { # void context: alter in-place!
- for(@_) {
- s/([F${cntrl}\-\\\{\}${not_ascii}])/$Escape{$1}/g; # ESCAPER
- s/([^\x00-\xFF])/'\\uc1\\u'.((ord($1)<32768)?ord($1):(ord($1)-65536)).'?'/eg;
- }
- return;
- } elsif(wantarray) { # return an array
- return map {; ($x = $_) =~
- s/([F${cntrl}\-\\\{\}${not_ascii}])/$Escape{$1}/g; # ESCAPER
- $x =~ s/([^\x00-\xFF])/'\\uc1\\u'.((ord($1)<32768)?ord($1):(ord($1)-65536)).'?'/eg;
- $x;
- } @_;
- } else { # return a single scalar
- ($x = ((@_ == 1) ? $_[0] : join '', @_)
- ) =~ s/([F${cntrl}\-\\\{\}${not_ascii}])/$Escape{$1}/g; # ESCAPER
- # Escape \, {, }, -, control chars, and 7f-ff.
- $x =~ s/([^\x00-\xFF])/'\\uc1\\u'.((ord($1)<32768)?ord($1):(ord($1)-65536)).'?'/eg;
+
+my $question_mark_code_points =
+ Pod::Simple::BlackBox::my_qr('([^\x00-\x{D7FF}\x{E000}-\x{10FFFF}])',
+ "\x{110000}");
+my $plane0 =
+ Pod::Simple::BlackBox::my_qr('([\x{100}-\x{FFFF}])', "\x{100}");
+my $other_unicode =
+ Pod::Simple::BlackBox::my_qr('([\x{10000}-\x{10FFFF}])', "\x{10000}");
+
+sub esc_uni($) {
+ use if $] le 5.006002, 'utf8';
+
+ my $x = shift;
+
+ # The output is expected to be UTF-16. Surrogates and above-Unicode get
+ # mapped to '?'
+ $x =~ s/$question_mark_code_points/?/g if $question_mark_code_points;
+
+ # Non-surrogate Plane 0 characters get mapped to their code points. But
+ # the standard calls for a 16bit SIGNED value.
+ $x =~ s/$plane0/'\\uc1\\u'.((ord($1)<32768)?ord($1):(ord($1)-65536)).'?'/eg
+ if $plane0;
+
+ # Use surrogate pairs for the rest
+ $x =~ s/$other_unicode/'\\uc1\\u' . ((ord($1) >> 10) + 0xD7C0 - 65536) . '\\u' . (((ord$1) & 0x03FF) + 0xDC00 - 65536) . '?'/eg if $other_unicode;
+
return $x;
- }
}
-sub rtf_esc_codely {
- # Doesn't change "-" to hard-hyphen, nor apply computerese style-smarts.
- # We don't want to change the "-" to hard-hyphen, because we want to
+sub rtf_esc ($$) {
+ # The parameter is true if we should escape hyphens
+ my $escape_re = ((shift) ? $escaped : $escaped_sans_hyphen);
+
+ # When false, it doesn't change "-" to hard-hyphen.
+ # We don't want to change the "-" to hard-hyphen, because we want to
# be able to paste this into a file and run it without there being
# dire screaming about the mysterious hard-hyphen character (which
# looks just like a normal dash character).
-
+ # XXX The comments used to claim that when false it didn't apply computerese
+ # style-smarts, but khw didn't see this actually
+
my $x; # scratch
if(!defined wantarray) { # void context: alter in-place!
for(@_) {
- s/([F${cntrl}\\\{\}${not_ascii}])/$Escape{$1}/g; # ESCAPER
- s/([^\x00-\xFF])/'\\uc1\\u'.((ord($1)<32768)?ord($1):(ord($1)-65536)).'?'/eg;
+ s/($escape_re)/$Escape{$1}/g; # ESCAPER
+ $_ = esc_uni($_);
}
return;
} elsif(wantarray) { # return an array
return map {; ($x = $_) =~
- s/([F${cntrl}\\\{\}${not_ascii}])/$Escape{$1}/g; # ESCAPER
- $x =~ s/([^\x00-\xFF])/'\\uc1\\u'.((ord($1)<32768)?ord($1):(ord($1)-65536)).'?'/eg;
+ s/($escape_re)/$Escape{$1}/g; # ESCAPER
+ $x = esc_uni($x);
$x;
} @_;
} else { # return a single scalar
($x = ((@_ == 1) ? $_[0] : join '', @_)
- ) =~ s/([F${cntrl}\\\{\}${not_ascii}])/$Escape{$1}/g; # ESCAPER
+ ) =~ s/($escape_re)/$Escape{$1}/g; # ESCAPER
# Escape \, {, }, -, control chars, and 7f-ff.
- $x =~ s/([^\x00-\xFF])/'\\uc1\\u'.((ord($1)<32768)?ord($1):(ord($1)-65536)).'?'/eg;
+ $x = esc_uni($x);
return $x;
}
}
-%Escape = (
- (($] lt 5.007_003) # Broken for non-ASCII on early Perls
- ? (map( (chr($_),chr($_)), # things not apparently needing escaping
- 0x20 .. 0x7E ),
- map( (chr($_),sprintf("\\'%02x", $_)), # apparently escapeworthy things
- 0x00 .. 0x1F, 0x5c, 0x7b, 0x7d, 0x7f .. 0xFF, 0x46))
- : (map( (chr(utf8::unicode_to_native($_)),chr(utf8::unicode_to_native($_))),
- 0x20 .. 0x7E ),
- map( (chr($_),sprintf("\\'%02x", utf8::unicode_to_native($_))),
- 0x00 .. 0x1F, 0x5c, 0x7b, 0x7d, 0x7f .. 0xFF, 0x46))),
-
- # We get to escape out 'F' so that we can send RTF files thru the mail
- # without the slightest worry that paragraphs beginning with "From"
- # will get munged.
-
- # And some refinements:
- "\r" => "\n",
- "\cj" => "\n",
- "\n" => "\n\\line ",
-
- "\t" => "\\tab ", # Tabs (altho theoretically raw \t's are okay)
- "\f" => "\n\\page\n", # Formfeed
- "-" => "\\_", # Turn plaintext '-' into a non-breaking hyphen
- $Pod::Simple::nbsp => "\\~", # Latin-1 non-breaking space
- $Pod::Simple::shy => "\\-", # Latin-1 soft (optional) hyphen
-
- # CRAZY HACKS:
- "\n" => "\\line\n",
- "\r" => "\n",
- "\cb" => "{\n\\cs21\\lang1024\\noproof ", # \\cf1
- "\cc" => "}",
-);
1;
__END__
diff --git a/Master/tlpkg/tlperl/lib/Pod/Simple/Search.pm b/Master/tlpkg/tlperl/lib/Pod/Simple/Search.pm
index df499cacf2d..a07d33b85ac 100644
--- a/Master/tlpkg/tlperl/lib/Pod/Simple/Search.pm
+++ b/Master/tlpkg/tlperl/lib/Pod/Simple/Search.pm
@@ -3,7 +3,7 @@ package Pod::Simple::Search;
use strict;
use vars qw($VERSION $MAX_VERSION_WITHIN $SLEEPY);
-$VERSION = '3.35'; ## Current version of this package
+$VERSION = '3.40'; ## Current version of this package
BEGIN { *DEBUG = sub () {0} unless defined &DEBUG; } # set DEBUG level
use Carp ();
@@ -12,7 +12,6 @@ $SLEEPY = 1 if !defined $SLEEPY and $^O =~ /mswin|mac/i;
# flag to occasionally sleep for $SLEEPY - 1 seconds.
$MAX_VERSION_WITHIN ||= 60;
-my $IS_CASE_INSENSITIVE = -e uc __FILE__ && -e lc __FILE__;
#############################################################################
@@ -26,7 +25,7 @@ use Cwd qw( cwd );
__PACKAGE__->_accessorize( # Make my dumb accessor methods
'callback', 'progress', 'dir_prefix', 'inc', 'laborious', 'limit_glob',
'limit_re', 'shadows', 'verbose', 'name2path', 'path2name', 'recurse',
- 'ciseen'
+ 'ciseen', 'is_case_insensitive'
);
#==========================================================================
@@ -42,6 +41,7 @@ sub init {
$self->inc(1);
$self->recurse(1);
$self->verbose(DEBUG);
+ $self->is_case_insensitive(-e uc __FILE__ && -e lc __FILE__);
return $self;
}
@@ -130,12 +130,12 @@ sub _make_search_callback {
# Put the options in variables, for easy access
my( $laborious, $verbose, $shadows, $limit_re, $callback, $progress,
- $path2name, $name2path, $recurse, $ciseen) =
+ $path2name, $name2path, $recurse, $ciseen, $is_case_insensitive) =
map scalar($self->$_()),
qw(laborious verbose shadows limit_re callback progress
- path2name name2path recurse ciseen);
+ path2name name2path recurse ciseen is_case_insensitive);
my ($seen, $remember, $files_for);
- if ($IS_CASE_INSENSITIVE) {
+ if ($is_case_insensitive) {
$seen = sub { $ciseen->{ lc $_[0] } };
$remember = sub { $name2path->{ $_[0] } = $ciseen->{ lc $_[0] } = $_[1]; };
$files_for = sub { my $n = lc $_[0]; grep { lc $path2name->{$_} eq $n } %{ $path2name } };
@@ -259,7 +259,7 @@ sub _path2modname {
while(@m
and defined($x = lc( $m[0] ))
and( $x eq 'site_perl'
- or($x eq 'pod' and @m == 1 and $shortname =~ m{^perl.*\.pod$}s )
+ or($x =~ m/^pods?$/ and @m == 1 and $shortname =~ m{^perl.*\.pod$}s )
or $x =~ m{\\d+\\.z\\d+([_.]?\\d+)?} # if looks like a vernum
or $x eq lc( $Config::Config{'archname'} )
)) { shift @m }
@@ -546,7 +546,7 @@ sub _limit_glob_to_limit_re {
sub _actual_filenames {
my $dir = shift;
my $fn = lc shift;
- opendir my $dh, $dir or return;
+ opendir my ($dh), $dir or return;
return map { File::Spec->catdir($dir, $_) }
grep { lc $_ eq $fn } readdir $dh;
}
@@ -588,7 +588,7 @@ sub find {
my $fullext = $fullname . $ext;
if ( -f $fullext and $self->contains_pod($fullext) ) {
print "FOUND: $fullext\n" if $verbose;
- if (@parts > 1 && lc $parts[0] eq 'pod' && $IS_CASE_INSENSITIVE && $ext eq '.pod') {
+ if (@parts > 1 && lc $parts[0] eq 'pod' && $self->is_case_insensitive() && $ext eq '.pod') {
# Well, this file could be for a program (perldoc) but we actually
# want a module (Pod::Perldoc). So see if there is a .pm with the
# proper casing.
@@ -611,7 +611,7 @@ sub find {
}
# Case-insensitively Look for ./pod directories and slip them in.
- for my $subdir ( _actual_filenames($dir, 'pod') ) {
+ for my $subdir ( _actual_filenames($dir, 'pods'), _actual_filenames($dir, 'pod') ) {
if (-d $subdir) {
$verbose and print "Noticing $subdir and looking there...\n";
unshift @search_dirs, $subdir;
@@ -849,6 +849,20 @@ inspected too, and are noted in the pathname2podname return hash.
This attribute's default value is false; and normally you won't
need to turn it on.
+=item $search->is_case_insensitive( I<true-or-false> );
+
+Pod::Simple::Search will by default internally make an assumption
+based on the underlying filesystem where the class file is found
+whether it is case insensitive or not.
+
+If it is determined to be case insensitive, during survey() it may
+skip pod files/modules that happen to be equal to names it's already
+seen, ignoring case.
+
+However, it's possible to have distinct files in different directories
+that intentionally has the same name, just differing in case, that should
+be reported. Hence, you may force the behavior by setting this to true
+or false.
=item $search->limit_re( I<some-regxp> );
@@ -857,7 +871,6 @@ to limit the results just to items whose podnames match the given
regexp. Normally this option is not needed, and the more efficient
C<limit_glob> attribute is used instead.
-
=item $search->dir_prefix( I<some-string-value> );
Setting this attribute to a string value means that the searches should
diff --git a/Master/tlpkg/tlperl/lib/Pod/Simple/SimpleTree.pm b/Master/tlpkg/tlperl/lib/Pod/Simple/SimpleTree.pm
index bff5af84c4b..85dbabcd70e 100644
--- a/Master/tlpkg/tlperl/lib/Pod/Simple/SimpleTree.pm
+++ b/Master/tlpkg/tlperl/lib/Pod/Simple/SimpleTree.pm
@@ -5,7 +5,7 @@ use strict;
use Carp ();
use Pod::Simple ();
use vars qw( $ATTR_PAD @ISA $VERSION $SORT_ATTRS);
-$VERSION = '3.35';
+$VERSION = '3.40';
BEGIN {
@ISA = ('Pod::Simple');
*DEBUG = \&Pod::Simple::DEBUG unless defined &DEBUG;
diff --git a/Master/tlpkg/tlperl/lib/Pod/Simple/Subclassing.pod b/Master/tlpkg/tlperl/lib/Pod/Simple/Subclassing.pod
index 88f85e86de2..f9cb09a52ef 100644
--- a/Master/tlpkg/tlperl/lib/Pod/Simple/Subclassing.pod
+++ b/Master/tlpkg/tlperl/lib/Pod/Simple/Subclassing.pod
@@ -98,9 +98,14 @@ nodes that represent preformatted text (from verbatim sections).
TODO intro... mention that events are supplied for implicits, like for
missing >'s
-
In the following section, we use XML to represent the event structure
-associated with a particular construct. That is, TODO
+associated with a particular construct. That is, an opening tag
+represents the element start, the attributes of that opening tag are
+the attributes given to the callback, and the closing tag represents
+the end element.
+
+Three callback methods must be supplied by a class extending
+L<Pod::Simple> to receive the corresponding event:
=over
@@ -112,8 +117,9 @@ associated with a particular construct. That is, TODO
=back
-TODO describe
-
+Here's the comprehensive list of values you can expect as
+I<element_name> in your implementation of C<_handle_element_start>
+and C<_handle_element_end>::
=over
diff --git a/Master/tlpkg/tlperl/lib/Pod/Simple/Text.pm b/Master/tlpkg/tlperl/lib/Pod/Simple/Text.pm
index 66e15f48cce..de50b510eae 100644
--- a/Master/tlpkg/tlperl/lib/Pod/Simple/Text.pm
+++ b/Master/tlpkg/tlperl/lib/Pod/Simple/Text.pm
@@ -6,7 +6,7 @@ use Carp ();
use Pod::Simple::Methody ();
use Pod::Simple ();
use vars qw( @ISA $VERSION $FREAKYMODE);
-$VERSION = '3.35';
+$VERSION = '3.40';
@ISA = ('Pod::Simple::Methody');
BEGIN { *DEBUG = defined(&Pod::Simple::DEBUG)
? \&Pod::Simple::DEBUG
diff --git a/Master/tlpkg/tlperl/lib/Pod/Simple/TextContent.pm b/Master/tlpkg/tlperl/lib/Pod/Simple/TextContent.pm
index 980612b3132..ad4172b7a31 100644
--- a/Master/tlpkg/tlperl/lib/Pod/Simple/TextContent.pm
+++ b/Master/tlpkg/tlperl/lib/Pod/Simple/TextContent.pm
@@ -6,7 +6,7 @@ use strict;
use Carp ();
use Pod::Simple ();
use vars qw( @ISA $VERSION );
-$VERSION = '3.35';
+$VERSION = '3.40';
@ISA = ('Pod::Simple');
sub new {
diff --git a/Master/tlpkg/tlperl/lib/Pod/Simple/TiedOutFH.pm b/Master/tlpkg/tlperl/lib/Pod/Simple/TiedOutFH.pm
index a7364dfa585..0dd12c412dd 100644
--- a/Master/tlpkg/tlperl/lib/Pod/Simple/TiedOutFH.pm
+++ b/Master/tlpkg/tlperl/lib/Pod/Simple/TiedOutFH.pm
@@ -4,7 +4,7 @@ package Pod::Simple::TiedOutFH;
use Symbol ('gensym');
use Carp ();
use vars qw($VERSION );
-$VERSION = '3.35';
+$VERSION = '3.40';
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/Master/tlpkg/tlperl/lib/Pod/Simple/Transcode.pm b/Master/tlpkg/tlperl/lib/Pod/Simple/Transcode.pm
index a4bb29ffdb6..eb127022827 100644
--- a/Master/tlpkg/tlperl/lib/Pod/Simple/Transcode.pm
+++ b/Master/tlpkg/tlperl/lib/Pod/Simple/Transcode.pm
@@ -3,7 +3,7 @@ require 5;
package Pod::Simple::Transcode;
use strict;
use vars qw($VERSION @ISA);
-$VERSION = '3.35';
+$VERSION = '3.40';
BEGIN {
if(defined &DEBUG) {;} # Okay
diff --git a/Master/tlpkg/tlperl/lib/Pod/Simple/TranscodeDumb.pm b/Master/tlpkg/tlperl/lib/Pod/Simple/TranscodeDumb.pm
index c2069056574..2b675ccb787 100644
--- a/Master/tlpkg/tlperl/lib/Pod/Simple/TranscodeDumb.pm
+++ b/Master/tlpkg/tlperl/lib/Pod/Simple/TranscodeDumb.pm
@@ -5,7 +5,7 @@ require 5;
package Pod::Simple::TranscodeDumb;
use strict;
use vars qw($VERSION %Supported);
-$VERSION = '3.35';
+$VERSION = '3.40';
# This module basically pretends it knows how to transcode, except
# only for null-transcodings! We use this when Encode isn't
# available.
diff --git a/Master/tlpkg/tlperl/lib/Pod/Simple/TranscodeSmart.pm b/Master/tlpkg/tlperl/lib/Pod/Simple/TranscodeSmart.pm
index e4d4f7eb60e..99f55683ab3 100644
--- a/Master/tlpkg/tlperl/lib/Pod/Simple/TranscodeSmart.pm
+++ b/Master/tlpkg/tlperl/lib/Pod/Simple/TranscodeSmart.pm
@@ -9,7 +9,7 @@ use strict;
use Pod::Simple;
require Encode;
use vars qw($VERSION );
-$VERSION = '3.35';
+$VERSION = '3.40';
sub is_dumb {0}
sub is_smart {1}
diff --git a/Master/tlpkg/tlperl/lib/Pod/Simple/XHTML.pm b/Master/tlpkg/tlperl/lib/Pod/Simple/XHTML.pm
index 8c2cf1a01ba..b9c6269bf98 100644
--- a/Master/tlpkg/tlperl/lib/Pod/Simple/XHTML.pm
+++ b/Master/tlpkg/tlperl/lib/Pod/Simple/XHTML.pm
@@ -45,7 +45,7 @@ declare the output character set as UTF-8 before parsing, like so:
package Pod::Simple::XHTML;
use strict;
use vars qw( $VERSION @ISA $HAS_HTML_ENTITIES );
-$VERSION = '3.35';
+$VERSION = '3.40';
use Pod::Simple::Methody ();
@ISA = ('Pod::Simple::Methody');
@@ -92,7 +92,7 @@ the call to C<parse_file>:
In turning L<Foo::Bar> into http://whatever/Foo%3a%3aBar, what
to put before the "Foo%3a%3aBar". The default value is
-"http://search.cpan.org/perldoc?".
+"https://metacpan.org/pod/".
=head2 perldoc_url_postfix
@@ -247,7 +247,7 @@ sub new {
my $self = shift;
my $new = $self->SUPER::new(@_);
$new->{'output_fh'} ||= *STDOUT{IO};
- $new->perldoc_url_prefix('http://search.cpan.org/perldoc?');
+ $new->perldoc_url_prefix('https://metacpan.org/pod/');
$new->man_url_prefix('http://man.he.net/man');
$new->html_charset('ISO-8859-1');
$new->nix_X_codes(1);
@@ -685,8 +685,8 @@ sub emit {
Resolves a POD link target (typically a module or POD file name) and section
name to a URL. The resulting link will be returned for the above examples as:
- http://search.cpan.org/perldoc?Net::Ping#INSTALL
- http://search.cpan.org/perldoc?perlpodspec
+ https://metacpan.org/pod/Net::Ping#INSTALL
+ https://metacpan.org/pod/perlpodspec
#SYNOPSIS
Note that when there is only a section argument the URL will simply be a link
diff --git a/Master/tlpkg/tlperl/lib/Pod/Simple/XMLOutStream.pm b/Master/tlpkg/tlperl/lib/Pod/Simple/XMLOutStream.pm
index 62fe39549da..cb818a17409 100644
--- a/Master/tlpkg/tlperl/lib/Pod/Simple/XMLOutStream.pm
+++ b/Master/tlpkg/tlperl/lib/Pod/Simple/XMLOutStream.pm
@@ -5,7 +5,7 @@ use strict;
use Carp ();
use Pod::Simple ();
use vars qw( $ATTR_PAD @ISA $VERSION $SORT_ATTRS);
-$VERSION = '3.35';
+$VERSION = '3.40';
BEGIN {
@ISA = ('Pod::Simple');
*DEBUG = \&Pod::Simple::DEBUG unless defined &DEBUG;
diff --git a/Master/tlpkg/tlperl/lib/Pod/Text.pm b/Master/tlpkg/tlperl/lib/Pod/Text.pm
index b05730ef476..56e6e78a86c 100644
--- a/Master/tlpkg/tlperl/lib/Pod/Text.pm
+++ b/Master/tlpkg/tlperl/lib/Pod/Text.pm
@@ -14,7 +14,7 @@
package Pod::Text;
-use 5.006;
+use 5.008;
use strict;
use warnings;
@@ -30,7 +30,7 @@ use Pod::Simple ();
# We have to export pod2text for backward compatibility.
@EXPORT = qw(pod2text);
-$VERSION = '4.11';
+$VERSION = '4.14';
# Ensure that $Pod::Simple::nbsp and $Pod::Simple::shy are available. Code
# taken from Pod::Simple 3.32, but was only added in 3.30.
@@ -39,16 +39,8 @@ if ($Pod::Simple::VERSION ge 3.30) {
$NBSP = $Pod::Simple::nbsp;
$SHY = $Pod::Simple::shy;
} else {
- if ($] ge 5.007_003) {
- $NBSP = chr utf8::unicode_to_native(0xA0);
- $SHY = chr utf8::unicode_to_native(0xAD);
- } elsif (Pod::Simple::ASCII) {
- $NBSP = "\xA0";
- $SHY = "\xAD";
- } else {
- $NBSP = "\x41";
- $SHY = "\xCA";
- }
+ $NBSP = chr utf8::unicode_to_native(0xA0);
+ $SHY = chr utf8::unicode_to_native(0xAD);
}
##############################################################################
@@ -247,7 +239,7 @@ sub wrap {
my $spaces = ' ' x $$self{MARGIN};
my $width = $$self{opt_width} - $$self{MARGIN};
while (length > $width) {
- if (s/^([^\n]{0,$width})\s+// || s/^([^\n]{$width})//) {
+ if (s/^([^\n]{0,$width})[ \t\n]+// || s/^([^\n]{$width})//) {
$output .= $spaces . $1 . "\n";
} else {
last;
@@ -265,14 +257,16 @@ sub reformat {
local $_ = shift;
# If we're trying to preserve two spaces after sentences, do some munging
- # to support that. Otherwise, smash all repeated whitespace.
+ # to support that. Otherwise, smash all repeated whitespace. Be careful
+ # not to use \s here, which in Unicode input may match non-breaking spaces
+ # that we don't want to smash.
if ($$self{opt_sentence}) {
s/ +$//mg;
s/\.\n/. \n/g;
s/\n/ /g;
s/ +/ /g;
} else {
- s/\s+/ /g;
+ s/[ \t\n]+/ /g;
}
return $self->wrap ($_);
}
@@ -333,15 +327,14 @@ sub start_document {
# When UTF-8 output is set, check whether our output file handle already
# has a PerlIO encoding layer set. If it does not, we'll need to encode
- # our output before printing it (handled in the output() sub). Wrap the
- # check in an eval to handle versions of Perl without PerlIO.
+ # our output before printing it (handled in the output() sub).
$$self{ENCODE} = 0;
if ($$self{opt_utf8}) {
$$self{ENCODE} = 1;
eval {
my @options = (output => 1, details => 1);
my $flag = (PerlIO::get_layers ($$self{output_fh}, @options))[-1];
- if ($flag & PerlIO::F_UTF8 ()) {
+ if ($flag && ($flag & PerlIO::F_UTF8 ())) {
$$self{ENCODE} = 0;
$$self{ENCODING} = 'UTF-8';
}
@@ -919,7 +912,9 @@ being the file to write the formatted output to.
You can also call parse_lines() to parse an array of lines or
parse_string_document() to parse a document already in memory. As with
parse_file(), parse_lines() and parse_string_document() default to sending
-their output to C<STDOUT> unless changed with the output_fh() method.
+their output to C<STDOUT> unless changed with the output_fh() method. Be
+aware that parse_lines() and parse_string_document() both expect raw bytes,
+not decoded characters.
To put the output from any parse method into a string instead of a file
handle, call the output_string() method instead of output_fh().
@@ -1006,7 +1001,7 @@ how to use Pod::Simple.
=head1 COPYRIGHT AND LICENSE
-Copyright 1999-2002, 2004, 2006, 2008-2009, 2012-2016, 2018 Russ Allbery
+Copyright 1999-2002, 2004, 2006, 2008-2009, 2012-2016, 2018-2019 Russ Allbery
<rra@cpan.org>
This program is free software; you may redistribute it and/or modify it
diff --git a/Master/tlpkg/tlperl/lib/Pod/Text/Color.pm b/Master/tlpkg/tlperl/lib/Pod/Text/Color.pm
index 8d956f2a5dd..5d47c5ecb3b 100644
--- a/Master/tlpkg/tlperl/lib/Pod/Text/Color.pm
+++ b/Master/tlpkg/tlperl/lib/Pod/Text/Color.pm
@@ -12,7 +12,7 @@
package Pod::Text::Color;
-use 5.006;
+use 5.008;
use strict;
use warnings;
@@ -23,7 +23,7 @@ use vars qw(@ISA $VERSION);
@ISA = qw(Pod::Text);
-$VERSION = '4.11';
+$VERSION = '4.14';
##############################################################################
# Overrides
@@ -97,9 +97,6 @@ sub wrap {
# $shortchar matches some sequence of $char ending in codes followed by
# whitespace or the end of the string. $longchar matches exactly $width
# $chars, used when we have to truncate and hard wrap.
- #
- # $shortchar and $longchar are created in a slightly odd way because the
- # construct ${char}{0,$width} didn't do the right thing until Perl 5.8.x.
my $code = '(?:\e\[[\d;]+m)';
my $char = "(?>$code*[^\\n])";
my $shortchar = '^(' . $char . "{0,$width}(?>$code*)" . ')(?:\s+|\z)';
@@ -185,7 +182,7 @@ Russ Allbery <rra@cpan.org>.
=head1 COPYRIGHT AND LICENSE
-Copyright 1999, 2001, 2004, 2006, 2008, 2009, 2018 Russ Allbery
+Copyright 1999, 2001, 2004, 2006, 2008, 2009, 2018-2019 Russ Allbery
<rra@cpan.org>
This program is free software; you may redistribute it and/or modify it
diff --git a/Master/tlpkg/tlperl/lib/Pod/Text/Overstrike.pm b/Master/tlpkg/tlperl/lib/Pod/Text/Overstrike.pm
index 92a3a9330e0..53bc6afef23 100644
--- a/Master/tlpkg/tlperl/lib/Pod/Text/Overstrike.pm
+++ b/Master/tlpkg/tlperl/lib/Pod/Text/Overstrike.pm
@@ -19,7 +19,7 @@
package Pod::Text::Overstrike;
-use 5.006;
+use 5.008;
use strict;
use warnings;
@@ -29,7 +29,7 @@ use Pod::Text ();
@ISA = qw(Pod::Text);
-$VERSION = '4.11';
+$VERSION = '4.14';
##############################################################################
# Overrides
@@ -185,7 +185,7 @@ created by Russ Allbery <rra@cpan.org>. Subsequently updated by Russ Allbery.
Copyright 2000 by Joe Smith <Joe.Smith@inwap.com>
-Copyright 2001, 2004, 2008, 2014, 2018 by Russ Allbery <rra@cpan.org>
+Copyright 2001, 2004, 2008, 2014, 2018-2019 by Russ Allbery <rra@cpan.org>
This program is free software; you may redistribute it and/or modify it
under the same terms as Perl itself.
diff --git a/Master/tlpkg/tlperl/lib/Pod/Text/Termcap.pm b/Master/tlpkg/tlperl/lib/Pod/Text/Termcap.pm
index d36ba4f518a..be218f0bf04 100644
--- a/Master/tlpkg/tlperl/lib/Pod/Text/Termcap.pm
+++ b/Master/tlpkg/tlperl/lib/Pod/Text/Termcap.pm
@@ -12,7 +12,7 @@
package Pod::Text::Termcap;
-use 5.006;
+use 5.008;
use strict;
use warnings;
@@ -24,7 +24,7 @@ use vars qw(@ISA $VERSION);
@ISA = qw(Pod::Text);
-$VERSION = '4.11';
+$VERSION = '4.14';
##############################################################################
# Overrides
@@ -36,14 +36,6 @@ sub new {
my ($self, %args) = @_;
my ($ospeed, $term, $termios);
- # $ENV{HOME} is usually not set on Windows. The default Term::Cap path
- # may not work on Solaris.
- unless (exists $ENV{TERMPATH}) {
- my $home = exists $ENV{HOME} ? "$ENV{HOME}/.termcap:" : '';
- $ENV{TERMPATH} =
- "${home}/etc/termcap:/usr/share/misc/termcap:/usr/share/lib/termcap";
- }
-
# Fall back on a hard-coded terminal speed if POSIX::Termios isn't
# available (such as on VMS).
eval { $termios = POSIX::Termios->new };
@@ -80,10 +72,12 @@ sub new {
# Initialize Pod::Text.
$self = $self->SUPER::new (%args);
- # Fall back on the ANSI escape sequences if Term::Cap doesn't work.
- $$self{BOLD} = $bold || "\e[1m";
- $$self{UNDL} = $undl || "\e[4m";
- $$self{NORM} = $norm || "\e[m";
+ # If we were unable to get any of the formatting sequences, don't attempt
+ # that type of formatting. This will do weird things if bold or underline
+ # were available but normal wasn't, but hopefully that will never happen.
+ $$self{BOLD} = $bold || q{};
+ $$self{UNDL} = $undl || q{};
+ $$self{NORM} = $norm || q{};
return $self;
}
@@ -106,11 +100,19 @@ sub cmd_head2 {
sub cmd_b { my $self = shift; return "$$self{BOLD}$_[1]$$self{NORM}" }
sub cmd_i { my $self = shift; return "$$self{UNDL}$_[1]$$self{NORM}" }
+# Return a regex that matches a formatting sequence. This will only be valid
+# if we were able to get at least some termcap information.
+sub format_regex {
+ my ($self) = @_;
+ my @codes = ($self->{BOLD}, $self->{UNDL}, $self->{NORM});
+ return join(q{|}, map { $_ eq q{} ? () : "\Q$_\E" } @codes);
+}
+
# Analyze a single line and return any formatting codes in effect at the end
# of that line.
sub end_format {
my ($self, $line) = @_;
- my $pattern = "(\Q$$self{BOLD}\E|\Q$$self{UNDL}\E|\Q$$self{NORM}\E)";
+ my $pattern = "(" . $self->format_regex() . ")";
my $current;
while ($line =~ /$pattern/g) {
my $code = $1;
@@ -147,15 +149,17 @@ sub wrap {
my $spaces = ' ' x $$self{MARGIN};
my $width = $$self{opt_width} - $$self{MARGIN};
+ # If we were unable to find any termcap sequences, use Pod::Text wrapping.
+ if ($self->{BOLD} eq q{} && $self->{UNDL} eq q{} && $self->{NORM} eq q{}) {
+ return $self->SUPER::wrap($_);
+ }
+
# $code matches a single special sequence. $char matches any number of
# special sequences preceding a single character other than a newline.
# $shortchar matches some sequence of $char ending in codes followed by
# whitespace or the end of the string. $longchar matches exactly $width
# $chars, used when we have to truncate and hard wrap.
- #
- # $shortchar and $longchar are created in a slightly odd way because the
- # construct ${char}{0,$width} didn't do the right thing until Perl 5.8.x.
- my $code = "(?:\Q$$self{BOLD}\E|\Q$$self{UNDL}\E|\Q$$self{NORM}\E)";
+ my $code = "(?:" . $self->format_regex() . ")";
my $char = "(?>$code*[^\\n])";
my $shortchar = '^(' . $char . "{0,$width}(?>$code*)" . ')(?:\s+|\z)';
my $longchar = '^(' . $char . "{$width})";
@@ -225,34 +229,20 @@ text using the correct termcap escape sequences for the current terminal.
Apart from the format codes, it in all ways functions like Pod::Text. See
L<Pod::Text> for details and available options.
-=head1 ENVIRONMENT
-
-This module sets the TERMPATH environment variable globally to:
-
- $HOME/.termcap:/etc/termcap:/usr/share/misc/termcap:/usr/share/lib/termcap
-
-if it isn't already set. (The first entry is omitted if the HOME
-environment variable isn't set.) This is a (very old) workaround for
-problems finding termcap information on older versions of Solaris, and is
-not good module behavior. Please do not rely on this behavior; it may be
-dropped in a future release.
-
-=head1 NOTES
-
-This module uses Term::Cap to retrieve the formatting escape sequences for
-the current terminal, and falls back on the ECMA-48 (the same in this
-regard as ANSI X3.64 and ISO 6429, the escape codes also used by DEC VT100
-terminals) if the bold, underline, and reset codes aren't set in the
-termcap information.
+This module uses L<Term::Cap> to find the correct terminal settings. See the
+documentation of that module for how it finds terminal database information
+and how to override that behavior if necessary. If unable to find control
+strings for bold and underscore formatting, that formatting is skipped,
+resulting in the same output as Pod::Text.
=head1 AUTHOR
-Russ Allbery <rra@cpan.org>.
+Russ Allbery <rra@cpan.org>
=head1 COPYRIGHT AND LICENSE
-Copyright 1999, 2001-2002, 2004, 2006, 2008-2009, 2014-2015, 2018 Russ Allbery
-<rra@cpan.org>
+Copyright 1999, 2001-2002, 2004, 2006, 2008-2009, 2014-2015, 2018-2019 Russ
+Allbery <rra@cpan.org>
This program is free software; you may redistribute it and/or modify it
under the same terms as Perl itself.