diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Pod')
50 files changed, 778 insertions, 916 deletions
diff --git a/Master/tlpkg/tlperl/lib/Pod/Checker.pm b/Master/tlpkg/tlperl/lib/Pod/Checker.pm index 2bff3c9c4c9..0d18aaedb10 100644 --- a/Master/tlpkg/tlperl/lib/Pod/Checker.pm +++ b/Master/tlpkg/tlperl/lib/Pod/Checker.pm @@ -2,31 +2,27 @@ # Pod/Checker.pm -- check pod documents for syntax errors # # Copyright (C) 1994-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. +# This is free software; you can redistribute it and/or modify it under the +# same terms as Perl itself. ############################################################################# package Pod::Checker; use strict; +use warnings; -use vars qw($VERSION @ISA @EXPORT %VALID_COMMANDS %VALID_SEQUENCES); -$VERSION = '1.60'; ## Current version of this package -require 5.005; ## requires this Perl version or later - -use Pod::ParseUtils; ## for hyperlinks and lists +our $VERSION = '1.73'; ## Current version of this package =head1 NAME -Pod::Checker, podchecker() - check pod documents for syntax errors +Pod::Checker - check pod documents for syntax errors =head1 SYNOPSIS use Pod::Checker; - $num_errors = podchecker($filepath, $outputpath, %options); + $syntax_okay = podchecker($filepath, $outputpath, %options); - my $checker = new Pod::Checker %options; + my $checker = Pod::Checker->new(%options); $checker->parse_from_file($filepath, \*STDERR); =head1 OPTIONS/ARGUMENTS @@ -48,6 +44,10 @@ This function can take a hash of options: Turn warnings on/off. I<val> is usually 1 for on, but higher values trigger additional warnings. See L<"Warnings">. +=item B<-quiet> =E<gt> I<val> + +If C<val> is true, do not print any errors/warnings. + =back =head1 DESCRIPTION @@ -111,42 +111,56 @@ heading! =item * =over on line I<N> without closing =back +=item * You forgot a '=back' before '=headI<N>' + +=item * =over is the last thing in the document?! + The C<=over> command does not have a corresponding C<=back> before the next heading (C<=head1> or C<=head2>) or the end of the file. -=item * =item without previous =over +=item * '=item' outside of any '=over' -=item * =back without previous =over +=item * =back without =over An C<=item> or C<=back> command has been found outside a C<=over>/C<=back> block. -=item * No argument for =begin +=item * Can't have a 0 in =over I<N> + +You need to indent a strictly positive number of spaces, not 0. + +=item * =over should be: '=over' or '=over positive_number' + +Either have an argumentless =over, or have its argument a strictly positive number. + +=item * =begin I<TARGET> without matching =end I<TARGET> + +A C<=begin> command was found that has no matching =end command. + +=item * =begin without a target? A C<=begin> command was found that is not followed by the formatter specification. -=item * =end without =begin +=item * =end I<TARGET> without matching =begin. A standalone C<=end> command was found. -=item * Nested =begin's +=item * '=end' without a target? -There were at least two consecutive C<=begin> commands without -the corresponding C<=end>. Only one C<=begin> may be active at -a time. +'=end' directives need to have a target, just like =begin directives. -=item * =for without formatter specification +=item * '=end I<TARGET>' is invalid. -There is no specification of the formatter after the C<=for> command. +I<TARGET> needs to be one word -=item * Apparent command =foo not preceded by blank line +=item * =end I<CONTENT> doesn't match =begin I<TARGET> -A command which has ended up in the middle of a paragraph or other command, -such as +I<CONTENT> needs to match =begin's I<TARGET>. - =item one - =item two <-- bad +=item * =for without a target? + +There is no specification of the formatter after the C<=for> command. =item * unresolved internal link I<NAME> @@ -154,60 +168,58 @@ The given link to I<NAME> does not have a matching node in the current POD. This also happened when a single word node name is not enclosed in C<"">. -=item * Unknown command "I<CMD>" +=item * Unknown directive: I<CMD> An invalid POD command has been found. Valid are C<=head1>, C<=head2>, C<=head3>, C<=head4>, C<=over>, C<=item>, C<=back>, C<=begin>, C<=end>, C<=for>, C<=pod>, C<=cut> -=item * Unknown interior-sequence "I<SEQ>" +=item * Deleting unknown formatting code I<SEQ> An invalid markup command has been encountered. Valid are: C<BE<lt>E<gt>>, C<CE<lt>E<gt>>, C<EE<lt>E<gt>>, C<FE<lt>E<gt>>, C<IE<lt>E<gt>>, C<LE<lt>E<gt>>, C<SE<lt>E<gt>>, C<XE<lt>E<gt>>, C<ZE<lt>E<gt>> -=item * nested commands I<CMD>E<lt>...I<CMD>E<lt>...E<gt>...E<gt> +=item * Unterminated I<SEQ>E<lt>E<gt> sequence -Two nested identical markup commands have been found. Generally this -does not make sense. +An unclosed formatting code -=item * garbled entity I<STRING> +=item * An EE<lt>...E<gt> surrounding strange content The I<STRING> found cannot be interpreted as a character entity. -=item * Entity number out of range +=item * An empty EE<lt>E<gt> -An entity specified by number (dec, hex, oct) is out of range (1-255). +=item * An empty C<< LE<lt>E<gt> >> -=item * malformed link LE<lt>E<gt> +=item * An empty XE<lt>E<gt> -The link found cannot be parsed because it does not conform to the -syntax described in L<perlpod>. +There needs to be content inside E, L, and X formatting codes. -=item * nonempty ZE<lt>E<gt> +=item * A non-empty ZE<lt>E<gt> The C<ZE<lt>E<gt>> sequence is supposed to be empty. -=item * empty XE<lt>E<gt> - -The index entry specified contains nothing but whitespace. - =item * Spurious text after =pod / =cut The commands C<=pod> and C<=cut> do not take any arguments. -=item * Spurious =cut command +=item * =back doesn't take any parameters, but you said =back I<ARGUMENT> -A C<=cut> command was found without a preceding POD paragraph. +The C<=back> command does not take any arguments. -=item * Spurious =pod command +=item * =pod directives shouldn't be over one line long! Ignoring all I<N> lines of content -A C<=pod> command was found after a preceding POD paragraph. +Self explanatory -=item * Spurious character(s) after =back +=item * =cut found outside a pod block. -The C<=back> command does not take any arguments. +A '=cut' directive found in the middle of non-POD + +=item * Invalid =encoding syntax: I<CONTENT> + +Syntax error in =encoding directive =back @@ -217,7 +229,12 @@ These may not necessarily cause trouble, but indicate mediocre style. =over 4 -=item * multiple occurrence of link target I<name> +=item * nested commands I<CMD>E<lt>...I<CMD>E<lt>...E<gt>...E<gt> + +Two nested identical markup commands have been found. Generally this +does not make sense. + +=item * multiple occurrences (I<N>) of link target I<name> The POD file has some C<=item> and/or C<=head> commands that have the same text. Potential hyperlinks to such a text cannot be unique then. @@ -229,59 +246,46 @@ There is some whitespace on a seemingly empty line. POD is very sensitive to such things, so this is flagged. B<vi> users switch on the B<list> option to avoid this problem. -=begin _disabled_ - -=item * file does not start with =head +=item * =item has no contents -The file starts with a different POD directive than head. -This is most probably something you do not want. +There is a list C<=item> that has no text contents. You probably want to delete +empty items. -=end _disabled_ - -=item * previous =item has no contents - -There is a list C<=item> right above the flagged line that has no -text contents. You probably want to delete empty items. - -=item * preceding non-item paragraph(s) +=item * You can't have =items (as at line I<N>) unless the first thing after the =over is an =item A list introduced by C<=over> starts with a text or verbatim paragraph, but continues with C<=item>s. Move the non-item paragraph out of the C<=over>/C<=back> block. -=item * =item type mismatch (I<one> vs. I<two>) +=item * Expected '=item I<EXPECTED VALUE>' + +=item * Expected '=item *' + +=item * Possible =item type mismatch: 'I<x>' found leading a supposed definition =item A list started with e.g. a bullet-like C<=item> and continued with a numbered one. This is obviously inconsistent. For most translators the type of the I<first> C<=item> determines the type of the list. -=item * I<N> unescaped C<E<lt>E<gt>> in paragraph +=item * You have '=item x' instead of the expected '=item I<N>' -Angle brackets not written as C<E<lt>ltE<gt>> and C<E<lt>gtE<gt>> -can potentially cause errors as they could be misinterpreted as -markup commands. This is only printed when the -warnings level is -greater than 1. +Erroneous numbering of =item numbers; they need to ascend consecutively. -=item * Unknown entity +=item * Unknown E content in EE<lt>I<CONTENT>E<gt> A character entity was found that does not belong to the standard -ISO set or the POD specials C<verbar> and C<sol>. - -=item * No items in =over +ISO set or the POD specials C<verbar> and C<sol>. I<Currently, this warning +only appears if a character entity was found that does not have a Unicode +character. This should be fixed to adhere to the original warning.> -The list opened with C<=over> does not contain any items. +=item * empty =over/=back block -=item * No argument for =item - -C<=item> without any parameters is deprecated. It should either be followed -by C<*> to indicate an unordered list, by a number (optionally followed -by a dot) to indicate an ordered (numbered) list or simple text for a -definition list. +The list opened with C<=over> does not contain anything. =item * empty section in previous paragraph The previous section (introduced by a C<=head> command) does not contain -any text. This usually indicates that something is missing. Note: A +any valid content. This usually indicates that something is missing. Note: A C<=head1> followed immediately by C<=head2> does not trigger this warning. =item * Verbatim paragraph in NAME section @@ -308,14 +312,6 @@ There are some warnings with respect to malformed hyperlinks: There is whitespace at the beginning or the end of the contents of LE<lt>...E<gt>. -=item * (section) in '$page' deprecated - -There is a section detected in the page name of LE<lt>...E<gt>, e.g. -C<LE<lt>passwd(2)E<gt>>. POD hyperlinks may point to POD documents only. -Please write C<CE<lt>passwd(2)E<gt>> instead. Some formatters are able -to expand this to appropriate code. For links to (builtin) functions, -please say C<LE<lt>perlfunc/mkdirE<gt>>, without (). - =item * alternative text/node '%s' contains non-escaped | or / The characters C<|> and C</> are special in the LE<lt>...E<gt> context. @@ -328,6 +324,11 @@ these literal characters like this: =back +Note that the line number of the error/warning may refer to the line number of +the start of the paragraph in which the error/warning exists, not the line +number that the error/warning is on. This bug is present in errors/warnings +related to formatting codes. I<This should be fixed.> + =head1 RETURN VALUE B<podchecker> returns the number of POD syntax errors found or -1 if @@ -337,6 +338,14 @@ there were no POD commands at all found in the file. See L</SYNOPSIS> +=head1 SCRIPTS + +The B<podchecker> script that comes with this distribution is a lean wrapper +around this module. See the online manual with + + podchecker -help + podchecker -man + =head1 INTERFACE While checking, this module collects document properties, e.g. the nodes @@ -345,169 +354,28 @@ POD translators can use this feature to syntax-check and get the nodes in a first pass before actually starting to convert. This is expensive in terms of execution time, but allows for very robust conversions. -Since PodParser-1.24 the B<Pod::Checker> module uses only the B<poderror> +Since v1.24 the B<Pod::Checker> module uses only the B<poderror> method to print errors and warnings. The summary output (e.g. "Pod syntax OK") has been dropped from the module and has been included in B<podchecker> (the script). This allows users of B<Pod::Checker> to control completely the output behavior. Users of B<podchecker> (the script) get the well-known behavior. +v1.45 inherits from Pod::Simple as opposed to all previous versions +inheriting from Pod::Parser. Do B<not> use Pod::Simple's interface when +using Pod::Checker unless it is documented somewhere on this page. I +repeat, DO B<NOT> USE POD::SIMPLE'S INTERFACE. + =cut ############################################################################# #use diagnostics; use Carp qw(croak); -use Exporter; -use Pod::Parser; - -@ISA = qw(Pod::Parser); -@EXPORT = qw(&podchecker); - -my %VALID_COMMANDS = ( - 'pod' => 1, - 'cut' => 1, - 'head1' => 1, - 'head2' => 1, - 'head3' => 1, - 'head4' => 1, - 'over' => 1, - 'back' => 1, - 'item' => 1, - 'for' => 1, - 'begin' => 1, - 'end' => 1, - 'encoding' => 1, -); - -my %VALID_SEQUENCES = ( - 'I' => 1, - 'B' => 1, - 'S' => 1, - 'C' => 1, - 'L' => 1, - 'F' => 1, - 'X' => 1, - 'Z' => 1, - 'E' => 1, -); - -# stolen from HTML::Entities -my %ENTITIES = ( - # Some normal chars that have special meaning in SGML context - amp => '&', # ampersand -'gt' => '>', # greater than -'lt' => '<', # less than - quot => '"', # double quote - - # PUBLIC ISO 8879-1986//ENTITIES Added Latin 1//EN//HTML - AElig => 'Æ', # capital AE diphthong (ligature) - Aacute => 'Á', # capital A, acute accent - Acirc => 'Â', # capital A, circumflex accent - Agrave => 'À', # capital A, grave accent - Aring => 'Å', # capital A, ring - Atilde => 'Ã', # capital A, tilde - Auml => 'Ä', # capital A, dieresis or umlaut mark - Ccedil => 'Ç', # capital C, cedilla - ETH => 'Ð', # capital Eth, Icelandic - Eacute => 'É', # capital E, acute accent - Ecirc => 'Ê', # capital E, circumflex accent - Egrave => 'È', # capital E, grave accent - Euml => 'Ë', # capital E, dieresis or umlaut mark - Iacute => 'Í', # capital I, acute accent - Icirc => 'Î', # capital I, circumflex accent - Igrave => 'Ì', # capital I, grave accent - Iuml => 'Ï', # capital I, dieresis or umlaut mark - Ntilde => 'Ñ', # capital N, tilde - Oacute => 'Ó', # capital O, acute accent - Ocirc => 'Ô', # capital O, circumflex accent - Ograve => 'Ò', # capital O, grave accent - Oslash => 'Ø', # capital O, slash - Otilde => 'Õ', # capital O, tilde - Ouml => 'Ö', # capital O, dieresis or umlaut mark - THORN => 'Þ', # capital THORN, Icelandic - Uacute => 'Ú', # capital U, acute accent - Ucirc => 'Û', # capital U, circumflex accent - Ugrave => 'Ù', # capital U, grave accent - Uuml => 'Ü', # capital U, dieresis or umlaut mark - Yacute => 'Ý', # capital Y, acute accent - aacute => 'á', # small a, acute accent - acirc => 'â', # small a, circumflex accent - aelig => 'æ', # small ae diphthong (ligature) - agrave => 'à', # small a, grave accent - aring => 'å', # small a, ring - atilde => 'ã', # small a, tilde - auml => 'ä', # small a, dieresis or umlaut mark - ccedil => 'ç', # small c, cedilla - eacute => 'é', # small e, acute accent - ecirc => 'ê', # small e, circumflex accent - egrave => 'è', # small e, grave accent - eth => 'ð', # small eth, Icelandic - euml => 'ë', # small e, dieresis or umlaut mark - iacute => 'í', # small i, acute accent - icirc => 'î', # small i, circumflex accent - igrave => 'ì', # small i, grave accent - iuml => 'ï', # small i, dieresis or umlaut mark - ntilde => 'ñ', # small n, tilde - oacute => 'ó', # small o, acute accent - ocirc => 'ô', # small o, circumflex accent - ograve => 'ò', # small o, grave accent - oslash => 'ø', # small o, slash - otilde => 'õ', # small o, tilde - ouml => 'ö', # small o, dieresis or umlaut mark - szlig => 'ß', # small sharp s, German (sz ligature) - thorn => 'þ', # small thorn, Icelandic - uacute => 'ú', # small u, acute accent - ucirc => 'û', # small u, circumflex accent - ugrave => 'ù', # small u, grave accent - uuml => 'ü', # small u, dieresis or umlaut mark - yacute => 'ý', # small y, acute accent - yuml => 'ÿ', # small y, dieresis or umlaut mark - - # Some extra Latin 1 chars that are listed in the HTML3.2 draft (21-May-96) - copy => '©', # copyright sign - reg => '®', # registered sign - nbsp => "\240", # non breaking space - - # Additional ISO-8859/1 entities listed in rfc1866 (section 14) - iexcl => '¡', - cent => '¢', - pound => '£', - curren => '¤', - yen => '¥', - brvbar => '¦', - sect => '§', - uml => '¨', - ordf => 'ª', - laquo => '«', -'not' => '¬', # not is a keyword in perl - shy => '', - macr => '¯', - deg => '°', - plusmn => '±', - sup1 => '¹', - sup2 => '²', - sup3 => '³', - acute => '´', - micro => 'µ', - para => '¶', - middot => '·', - cedil => '¸', - ordm => 'º', - raquo => '»', - frac14 => '¼', - frac12 => '½', - frac34 => '¾', - iquest => '¿', -'times' => '×', # times is a keyword in perl - divide => '÷', - -# some POD special entities - verbar => '|', - sol => '/' -); +use Exporter 'import'; +use base qw/Pod::Simple::Methody/; -##--------------------------------------------------------------------------- +our @EXPORT = qw(&podchecker); ##--------------------------------- ## Function definitions begin here @@ -522,7 +390,7 @@ sub podchecker { $outfile ||= \*STDERR; ## Now create a pod checker - my $checker = new Pod::Checker(%options); + my $checker = Pod::Checker->new(%options); ## Now check the pod document for errors $checker->parse_from_file($infile, $outfile); @@ -531,6 +399,7 @@ sub podchecker { return $checker->num_errors(); } + ##--------------------------------------------------------------------------- ##------------------------------- @@ -544,7 +413,7 @@ sub podchecker { =item C<Pod::Checker-E<gt>new( %options )> Return a reference to a new Pod::Checker object that inherits from -Pod::Parser and is used for calling the required methods later. The +Pod::Simple and is used for calling the required methods later. The following options are recognized: C<-warnings =E<gt> num> @@ -558,35 +427,41 @@ POD formatters. =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; - ## Initialize number of errors, and setup an error function to - ## increment this number and then print to the designated output. - $self->{_NUM_ERRORS} = 0; - $self->{_NUM_WARNINGS} = 0; - $self->{-quiet} ||= 0; - # set the error handling subroutine - $self->errorsub($self->{-quiet} ? sub { 1; } : 'poderror'); - $self->{_commands} = 0; # total number of POD commands encountered - $self->{_list_stack} = []; # stack for nested lists - $self->{_have_begin} = ''; # stores =begin - $self->{_links} = []; # stack for internal hyperlinks - $self->{_nodes} = []; # stack for =head/=item nodes - $self->{_index} = []; # text in X<> - # print warnings? - $self->{-warnings} = 1 unless(defined $self->{-warnings}); - $self->{_current_head1} = ''; # the current =head1 block - $self->parseopts(-process_cut_cmd => 1, -warnings => $self->{-warnings}); +sub new { + my $new = shift->SUPER::new(@_); + $new->{'output_fh'} ||= *STDERR{IO}; + + # Set options + my %opts = @_; + $new->{'-warnings'} = defined $opts{'-warnings'} ? + $opts{'-warnings'} : 1; # default on + $new->{'-quiet'} = $opts{'-quiet'} || 0; # default off + + # Initialize number of errors/warnings + $new->{'_NUM_ERRORS'} = 0; + $new->{'_NUM_WARNINGS'} = 0; + + # 'current' also means 'most recent' in the follow comments + $new->{'_thispara'} = ''; # current POD paragraph + $new->{'_line'} = 0; # current line number + $new->{'_head_num'} = 0; # current =head level (set to 0 to make + # logic easier down the road) + $new->{'_cmds_since_head'} = 0; # num of POD directives since prev. =headN + $new->{'_nodes'} = []; # stack for =head/=item nodes + $new->{'_fcode_stack'} = []; # stack for nested formatting codes + $new->{'_fcode_pos'} = []; # stack for position in paragraph of fcodes + $new->{'_begin_stack'} = []; # stack for =begins: [line #, target] + $new->{'_links'} = []; # stack for hyperlinks to external entities + $new->{'_internal_links'} = []; # set of linked-to internal sections + $new->{'_index'} = []; # stack for text in X<>s + + $new->accept_targets('*'); # check all =begin/=for blocks + $new->cut_handler( \&handle_pod_and_cut ); # warn if text after =cut + $new->pod_handler( \&handle_pod_and_cut ); # warn if text after =pod + $new->whiteline_handler( \&handle_whiteline ); # warn if whiteline + $new->parse_empty_lists(1); # warn if they are empty + + return $new; } ################################## @@ -595,9 +470,9 @@ sub initialize { =item C<$checker-E<gt>poderror( {%opts}, @args )> -Internal method for printing errors and warnings. If no options are -given, simply prints "@_". The following options are recognized and used -to form the output: +Internal method for printing errors and warnings. If no options are given, +simply prints "@_". The following options are recognized and used to form +the output: -msg @@ -609,7 +484,8 @@ The line number the error occurred in. -file -The file (name) the error occurred in. +The file (name) the error occurred in. Defaults to the name of the current +file being processed. -severity @@ -623,24 +499,28 @@ sub poderror { my %opts = (ref $_[0]) ? %{shift()} : (); ## Retrieve options - chomp( my $msg = ($opts{-msg} || '')."@_" ); - my $line = (exists $opts{-line}) ? " at line $opts{-line}" : ''; - my $file = (exists $opts{-file}) ? " in file $opts{-file}" : ''; - unless (exists $opts{-severity}) { + chomp( my $msg = ($opts{'-msg'} || '')."@_" ); + my $line = (exists $opts{'-line'}) ? " at line $opts{'-line'}" : ''; + my $file = ' in file ' . ((exists $opts{'-file'}) + ? $opts{'-file'} + : ((defined $self->source_filename) + ? $self->source_filename + : "???")); + unless (exists $opts{'-severity'}) { ## See if can find severity in message prefix - $opts{-severity} = $1 if ( $msg =~ s/^\**\s*([A-Z]{3,}):\s+// ); + $opts{'-severity'} = $1 if ( $msg =~ s/^\**\s*([A-Z]{3,}):\s+// ); } - my $severity = (exists $opts{-severity}) ? "*** $opts{-severity}: " : ''; + my $severity = (exists $opts{'-severity'}) ? "*** $opts{-severity}: " : ''; ## Increment error count and print message " - ++($self->{_NUM_ERRORS}) - if(!%opts || ($opts{-severity} && $opts{-severity} eq 'ERROR')); - ++($self->{_NUM_WARNINGS}) - if(!%opts || ($opts{-severity} && $opts{-severity} eq 'WARNING')); - unless($self->{-quiet}) { - my $out_fh = $self->output_handle() || \*STDERR; + ++($self->{'_NUM_ERRORS'}) + if(!%opts || ($opts{-severity} && $opts{'-severity'} eq 'ERROR')); + ++($self->{'_NUM_WARNINGS'}) + if(!%opts || ($opts{-severity} && $opts{'-severity'} eq 'WARNING')); + unless($self->{'-quiet'}) { + my $out_fh = $self->{'output_fh'} || \*STDERR; print $out_fh ($severity, $msg, $line, $file, "\n") - if($self->{-warnings} || !%opts || $opts{-severity} ne 'WARNING'); + if($self->{'-warnings'} || !%opts || $opts{'-severity'} ne 'WARNING'); } } @@ -653,7 +533,7 @@ Set (if argument specified) and retrieve the number of errors found. =cut sub num_errors { - return (@_ > 1) ? ($_[0]->{_NUM_ERRORS} = $_[1]) : $_[0]->{_NUM_ERRORS}; + return (@_ > 1) ? ($_[0]->{'_NUM_ERRORS'} = $_[1]) : $_[0]->{'_NUM_ERRORS'}; } ################################## @@ -665,7 +545,8 @@ Set (if argument specified) and retrieve the number of warnings found. =cut sub num_warnings { - return (@_ > 1) ? ($_[0]->{_NUM_WARNINGS} = $_[1]) : $_[0]->{_NUM_WARNINGS}; + return (@_ > 1) ? ($_[0]->{'_NUM_WARNINGS'} = $_[1]) : + $_[0]->{'_NUM_WARNINGS'}; } ################################## @@ -679,7 +560,7 @@ found in the C<=head1 NAME> section. sub name { return (@_ > 1 && $_[1]) ? - ($_[0]->{-name} = $_[1]) : $_[0]->{-name}; + ($_[0]->{'_pod_name'} = $_[1]) : $_[0]->{'_pod_name'}; } ################################## @@ -699,12 +580,12 @@ sub node { $text =~ s/\s+$//s; # strip trailing whitespace $text =~ s/\s+/ /gs; # collapse whitespace # add node, order important! - push(@{$self->{_nodes}}, $text); + push(@{$self->{'_nodes'}}, $text); # keep also a uniqueness counter - $self->{_unique_nodes}->{$text}++ if($text !~ /^\s*$/s); + $self->{'_unique_nodes'}->{$text}++ if($text !~ /^\s*$/s); return $text; } - @{$self->{_nodes}}; + @{$self->{'_nodes'}}; } ################################## @@ -724,58 +605,270 @@ sub idx { $text =~ s/\s+$//s; # strip trailing whitespace $text =~ s/\s+/ /gs; # collapse whitespace # add node, order important! - push(@{$self->{_index}}, $text); + push(@{$self->{'_index'}}, $text); # keep also a uniqueness counter - $self->{_unique_nodes}->{$text}++ if($text !~ /^\s*$/s); + $self->{'_unique_nodes'}->{$text}++ if($text !~ /^\s*$/s); return $text; } - @{$self->{_index}}; + @{$self->{'_index'}}; } ################################## -=item C<$checker-E<gt>hyperlink()> +# add a hyperlink to the list of those of the current POD; returns current +# list after the addition has been done +sub hyperlink { + my $self = shift; + push(@{$self->{'_links'}}, $_[0]); + return $_[0]; +} -Add (if argument specified) and retrieve the hyperlinks (as defined by -C<LE<lt>E<gt>>) of the current POD. They consist of a 2-item array: line -number and C<Pod::Hyperlink> object. +=item C<$checker-E<gt>hyperlinks()> -=back +Retrieve an array containing the hyperlinks to things outside +the current POD (as defined by C<LE<lt>E<gt>>). + +Each is an instance of a class with the following methods: =cut -# set/return hyperlinks of the current POD -sub hyperlink { - my $self = shift; - if($_[0]) { - push(@{$self->{_links}}, $_[0]); - return $_[0]; +sub hyperlinks { + @{shift->{'_links'}}; +} + +################################## + +# override Pod::Simple's whine() and scream() to use poderror() + +# Note: +# Ignore $self->{'no_whining'} b/c $self->{'quiet'} takes care of it in poderror +# Don't bother incrementing $self->{'errors_seen'} -- it's not used +# Don't bother pushing to $self->{'errata'} b/c poderror() outputs immediately +# We don't need to set $self->no_errata_section(1) b/c of these overrides + + +sub whine { + my ($self, $line, $complaint) = @_; + + my $severity = 'ERROR'; + + if (0) { + # XXX: Let's standardize what's a warning and what's an error. Let's not + # move stuff up and down the severity tree. -- rjbs, 2013-04-12 + # Convert errors in Pod::Simple that are warnings in Pod::Checker + # XXX Do differently so the $complaint can be reworded without this breaking + $severity = 'WARNING' if + $complaint =~ /^Expected '=item .+?'$/ || + $complaint =~ /^You can't have =items \(as at line .+?\) unless the first thing after the =over is an =item$/ || + $complaint =~ /^You have '=item .+?' instead of the expected '=item .+?'$/; + } + + $self->poderror({ -line => $line, + -severity => $severity, + -msg => $complaint }); + + return 1; # assume everything is peachy keen +} + +sub scream { + my ($self, $line, $complaint) = @_; + + $self->poderror({ -line => $line, + -severity => 'ERROR', # consider making severity 'FATAL' + -msg => $complaint }); + + return 1; +} + + +################################## + +# Some helper subroutines + +sub _init_event { # assignments done at the start of most events + $_[0]{'_thispara'} = ''; + $_[0]{'_line'} = $_[1]{'start_line'}; + $_[0]{'_cmds_since_head'}++; +} + +sub _check_fcode { + my ($self, $inner, $outers) = @_; + # Check for an fcode inside another of the same fcode + # XXX line number is the line of the start of the paragraph that the warning + # is in, not the line that the warning is on. Fix this + + # Later versions of Pod::Simple forbid nested L<>'s + return if $inner eq 'L' && $Pod::Simple::VERSION ge '3.33'; + + if (grep { $_ eq $inner } @$outers) { + $self->poderror({ -line => $self->{'_line'}, + -severity => 'WARNING', + -msg => "nested commands $inner<...$inner<...>...>"}); + } +} + +################################## + +sub handle_text { $_[0]{'_thispara'} .= $_[1] } + +# whiteline is a seemingly blank line that matches /[^\S\r\n]/ +sub handle_whiteline { + my ($line, $line_n, $self) = @_; + $self->poderror({ + -line => $line_n, + -severity => 'WARNING', + -msg => 'line containing nothing but whitespace in paragraph'}); +} + +######## Directives +sub handle_pod_and_cut { + my ($line, $line_n, $self) = @_; + $self->{'_cmds_since_head'}++; + if ($line =~ /=(pod|cut)\s+\S/) { + $self->poderror({ -line => $line_n, + -severity => 'ERROR', + -msg => "Spurious text after =$1"}); } - @{$self->{_links}}; } -## overrides for Pod::Parser - -sub end_pod { - ## Do some final checks and - ## print the number of errors found - my $self = shift; - my $infile = $self->input_file(); - - if(@{$self->{_list_stack}}) { - my $list; - while(($list = $self->_close_list('EOF',$infile)) && - $list->indent() ne 'auto') { - $self->poderror({ -line => 'EOF', -file => $infile, - -severity => 'ERROR', -msg => '=over on line ' . - $list->start() . ' without closing =back' }); +sub start_Para { shift->_init_event(@_); } +sub end_Para { + my $self = shift; + # Get the NAME of the pod document + if ($self->{'_head_num'} == 1 && $self->{'_head_text'} eq 'NAME') { + if ($self->{'_thispara'} =~ /^\s*(\S+?)\s*[,-]/) { + $self->{'_pod_name'} = $1 unless defined $self->{'_pod_name'}; } } +} + +sub start_Verbatim { + my $self = shift; + $self->_init_event(@_); + + if ($self->{'_head_num'} == 1 && $self->{'_head_text'} eq 'NAME') { + $self->poderror({ -line => $self->{'_line'}, + -severity => 'WARNING', + -msg => 'Verbatim paragraph in NAME section' }); + } +} +# Don't need an end_Verbatim + +# Do I need to do anything else with this? +sub start_Data { shift->_init_event() } + +sub start_head1 { shift->start_head(1, @_) } +sub start_head2 { shift->start_head(2, @_) } +sub start_head3 { shift->start_head(3, @_) } +sub start_head4 { shift->start_head(4, @_) } +sub start_head { + my $self = shift; + my $h = shift; + $self->_init_event(@_); + my $prev_h = $self->{'_head_num'}; + $self->{'_head_num'} = $h; + $self->{"_count_head$h"}++; + + if ($h > 1 && !$self->{'_count_head'.($h-1)}) { + $self->poderror({ -line => $self->{'_line'}, + -severity => 'WARNING', + -msg => "=head$h without preceding higher level"}); + } + + # If this is the first =head of the doc, $prev_h is 0, thus less than $h + if ($self->{'_cmds_since_head'} == 1 && $prev_h >= $h) { + $self->poderror({ -line => $self->{'_line'}, + -severity => 'WARNING', + -msg => 'empty section in previous paragraph'}); + } +} + +sub end_head1 { shift->end_head(@_) } +sub end_head2 { shift->end_head(@_) } +sub end_head3 { shift->end_head(@_) } +sub end_head4 { shift->end_head(@_) } +sub end_head { + my $self = shift; + my $arg = $self->{'_thispara'}; + $arg =~ s/\s+$//; + $self->{'_head_text'} = $arg; + $self->{'_cmds_since_head'} = 0; + my $h = $self->{'_head_num'}; + $self->node($arg); # remember this node + if ($arg eq '') { + $self->poderror({ -line => $self->{'_line'}, + -severity => 'ERROR', + -msg => "empty =head$h" }); + } +} + +sub start_over_bullet { shift->start_over(@_, 'bullet') } +sub start_over_number { shift->start_over(@_, 'number') } +sub start_over_text { shift->start_over(@_, 'definition') } +sub start_over_block { shift->start_over(@_, 'block') } +sub start_over_empty { + my $self = shift; + $self->start_over(@_, 'empty'); + $self->poderror({ -line => $self->{'_line'}, + -severity => 'WARNING', + -msg => 'empty =over/=back block' }); +} +sub start_over { + my $self = shift; + my $type = pop; + $self->_init_event(@_); +} + +sub start_item_bullet { shift->_init_event(@_) } +sub start_item_number { shift->_init_event(@_) } +sub start_item_text { shift->_init_event(@_) } +sub end_item_bullet { shift->end_item('bullet') } +sub end_item_number { shift->end_item('number') } +sub end_item_text { shift->end_item('definition') } +sub end_item { + my $self = shift; + my $type = shift; + # If there is verbatim text in this item, it will show up as part of + # 'paras', and not part of '_thispara'. If the first para after this is a + # verbatim one, it actually will be (part of) the contents for this item. + if ( $self->{'_thispara'} eq '' + && ( ! @{$self->{'paras'}} + || $self->{'paras'}[0][0] !~ /Verbatim/i)) + { + $self->poderror({ -line => $self->{'_line'}, + -severity => 'WARNING', + -msg => '=item has no contents' }); + } + + $self->node($self->{'_thispara'}); # remember this node +} + +sub start_for { # =for and =begin directives + my ($self, $flags) = @_; + $self->_init_event($flags); + push @{$self->{'_begin_stack'}}, [$self->{'_line'}, $flags->{'target'}]; +} + +sub end_for { + my ($self, $flags) = @_; + my ($line, $target) = @{pop @{$self->{'_begin_stack'}}}; + if ($flags->{'fake-closer'}) { # meaning Pod::Simple generated this =end + $self->poderror({ -line => $line, + -severity => 'ERROR', + -msg => "=begin $target without matching =end $target" + }); + } +} + +sub end_Document { + # Some final error checks + my $self = shift; + + # no POD found here + $self->num_errors(-1) && return unless $self->content_seen; - # check validity of document internal hyperlinks - # first build the node names from the paragraph text my %nodes; - foreach($self->node()) { + for ($self->node()) { $nodes{$_} = 1; if(/^(\S+)\s+\S/) { # we have more than one word. Use the first as a node, too. @@ -783,548 +876,215 @@ sub end_pod { $nodes{$1} ||= 2; # derived node } } - foreach($self->idx()) { + for ($self->idx()) { $nodes{$_} = 3; # index node } - foreach($self->hyperlink()) { - my ($line,$link) = @$_; - # _TODO_ what if there is a link to the page itself by the name, - # e.g. in Tk::Pod : L<Tk::Pod/"DESCRIPTION"> - if($link->node() && !$link->page() && $link->type() ne 'hyperlink') { - my $node = $self->_check_ptree($self->parse_text($link->node(), - $line), $line, $infile, 'L'); - if($node && !$nodes{$node}) { - $self->poderror({ -line => $line || '', -file => $infile, - -severity => 'ERROR', - -msg => "unresolved internal link '$node'"}); - } + + # XXX update unresolved internal link POD -- single word not enclosed in ""? + # I don't know what I was thinking when I made the above TODO, and I don't + # know what it means... + + for my $link (@{ $self->{'_internal_links'} }) { + my ($name, $line) = @$link; + unless ( $nodes{$name} ) { + $self->poderror({ -line => $line, + -severity => 'ERROR', + -msg => "unresolved internal link '$name'"}); } } # check the internal nodes for uniqueness. This pertains to # =headX, =item and X<...> - if($self->{-warnings} && $self->{-warnings}>1) { - foreach(grep($self->{_unique_nodes}->{$_} > 1, - keys %{$self->{_unique_nodes}})) { - $self->poderror({ -line => '-', -file => $infile, - -severity => 'WARNING', - -msg => "multiple occurrence of link target '$_'"}); - } - } - - # no POD found here - $self->num_errors(-1) if($self->{_commands} == 0); -} - -# check a POD command directive -sub command { - my ($self, $cmd, $paragraph, $line_num, $pod_para) = @_; - my ($file, $line) = $pod_para->file_line; - ## Check the command syntax - my $arg; # this will hold the command argument - if (! $VALID_COMMANDS{$cmd}) { - $self->poderror({ -line => $line, -file => $file, -severity => 'ERROR', - -msg => "Unknown command '$cmd'" }); - } - else { # found a valid command - $self->{_commands}++; # delete this line if below is enabled again - - $self->_commands_in_paragraphs($paragraph, $pod_para); - - ##### following check disabled due to strong request - #if(!$self->{_commands}++ && $cmd !~ /^head/) { - # $self->poderror({ -line => $line, -file => $file, - # -severity => 'WARNING', - # -msg => "file does not start with =head" }); - #} - - # check syntax of particular command - if($cmd eq 'over') { - # check for argument - $arg = $self->interpolate_and_check($paragraph, $line,$file); - my $indent = 4; # default - if($arg && $arg =~ /^\s*(\d+)\s*$/) { - $indent = $1; - } - # start a new list - $self->_open_list($indent,$line,$file); - } - elsif($cmd eq 'item') { - # are we in a list? - unless(@{$self->{_list_stack}}) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'ERROR', - -msg => '=item without previous =over' }); - # auto-open in case we encounter many more - $self->_open_list('auto',$line,$file); - } - my $list = $self->{_list_stack}->[0]; - # check whether the previous item had some contents - if(defined $self->{_list_item_contents} && - $self->{_list_item_contents} == 0) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'WARNING', - -msg => 'previous =item has no contents' }); - } - if($list->{_has_par}) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'WARNING', - -msg => 'preceding non-item paragraph(s)' }); - delete $list->{_has_par}; - } - # check for argument - $arg = $self->interpolate_and_check($paragraph, $line, $file); - if($arg && $arg =~ /(\S+)/) { - $arg =~ s/[\s\n]+$//; - my $type; - if($arg =~ /^[*]\s*(\S*.*)/) { - $type = 'bullet'; - $self->{_list_item_contents} = $1 ? 1 : 0; - $arg = $1; - } - elsif($arg =~ /^\d+\.?\s+(\S*)/) { - $type = 'number'; - $self->{_list_item_contents} = $1 ? 1 : 0; - $arg = $1; - } - else { - $type = 'definition'; - $self->{_list_item_contents} = 1; - } - my $first = $list->type(); - if($first && $first ne $type) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'WARNING', - -msg => "=item type mismatch ('$first' vs. '$type')"}); - } - else { # first item - $list->type($type); - } - } - else { - $self->poderror({ -line => $line, -file => $file, - -severity => 'WARNING', - -msg => 'No argument for =item' }); - $arg = ' '; # empty - $self->{_list_item_contents} = 0; - } - # add this item - $list->item($arg); - # remember this node - $self->node($arg); - } - elsif($cmd eq 'back') { - # check if we have an open list - unless(@{$self->{_list_stack}}) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'ERROR', - -msg => '=back without previous =over' }); - } - else { - # check for spurious characters - $arg = $self->interpolate_and_check($paragraph, $line,$file); - if($arg && $arg =~ /\S/) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'ERROR', - -msg => 'Spurious character(s) after =back' }); - } - # close list - my $list = $self->_close_list($line,$file); - # check for empty lists - if(!$list->item() && $self->{-warnings}) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'WARNING', - -msg => 'No items in =over (at line ' . - $list->start() . ') / =back list'}); - } - } - } - elsif($cmd =~ /^head(\d+)/) { - my $hnum = $1; - $self->{"_have_head_$hnum"}++; # count head types - if($hnum > 1 && !$self->{'_have_head_'.($hnum -1)}) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'WARNING', - -msg => "=head$hnum without preceding higher level"}); - } - # check whether the previous =head section had some contents - if(defined $self->{_commands_in_head} && - $self->{_commands_in_head} == 0 && - defined $self->{_last_head} && - $self->{_last_head} >= $hnum) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'WARNING', - -msg => 'empty section in previous paragraph'}); - } - $self->{_commands_in_head} = -1; - $self->{_last_head} = $hnum; - # check if there is an open list - if(@{$self->{_list_stack}}) { - my $list; - while(($list = $self->_close_list($line,$file)) && - $list->indent() ne 'auto') { - $self->poderror({ -line => $line, -file => $file, - -severity => 'ERROR', - -msg => '=over on line '. $list->start() . - " without closing =back (at $cmd)" }); - } - } - # remember this node - $arg = $self->interpolate_and_check($paragraph, $line,$file); - $arg =~ s/[\s\n]+$//s; - $self->node($arg); - unless(length($arg)) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'ERROR', - -msg => "empty =$cmd"}); - } - if($cmd eq 'head1') { - $self->{_current_head1} = $arg; - } else { - $self->{_current_head1} = ''; - } - } - elsif($cmd eq 'begin') { - if($self->{_have_begin}) { - # already have a begin - $self->poderror({ -line => $line, -file => $file, - -severity => 'ERROR', - -msg => q{Nested =begin's (first at line } . - $self->{_have_begin} . ')'}); - } - else { - # check for argument - $arg = $self->interpolate_and_check($paragraph, $line,$file); - unless($arg && $arg =~ /(\S+)/) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'ERROR', - -msg => 'No argument for =begin'}); - } - # remember the =begin - $self->{_have_begin} = "$line:$1"; - } - } - elsif($cmd eq 'end') { - if($self->{_have_begin}) { - # close the existing =begin - $self->{_have_begin} = ''; - # check for spurious characters - $arg = $self->interpolate_and_check($paragraph, $line,$file); - # the closing argument is optional - #if($arg && $arg =~ /\S/) { - # $self->poderror({ -line => $line, -file => $file, - # -severity => 'WARNING', - # -msg => "Spurious character(s) after =end" }); - #} - } - else { - # don't have a matching =begin - $self->poderror({ -line => $line, -file => $file, - -severity => 'ERROR', - -msg => '=end without =begin' }); - } - } - elsif($cmd eq 'for') { - unless($paragraph =~ /\s*(\S+)\s*/) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'ERROR', - -msg => '=for without formatter specification' }); - } - $arg = ''; # do not expand paragraph below - } - elsif($cmd =~ /^(pod|cut)$/) { - # check for argument - $arg = $self->interpolate_and_check($paragraph, $line,$file); - if($arg && $arg =~ /(\S+)/) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'ERROR', - -msg => "Spurious text after =$cmd"}); + if ($self->{'-warnings'} > 1 ) { + for my $node (sort keys %{ $self->{'_unique_nodes'} }) { + my $count = $self->{'_unique_nodes'}{$node}; + if ($count > 1) { # not unique + $self->poderror({ + -line => '-', + -severity => 'WARNING', + -msg => "multiple occurrences ($count) of link target ". + "'$node'"}); } - if($cmd eq 'cut' && (!$self->{_PREVIOUS} || $self->{_PREVIOUS} eq 'cut')) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'ERROR', - -msg => "Spurious =cut command"}); - } - if($cmd eq 'pod' && $self->{_PREVIOUS} && $self->{_PREVIOUS} ne 'cut') { - $self->poderror({ -line => $line, -file => $file, - -severity => 'ERROR', - -msg => "Spurious =pod command"}); - } } - $self->{_commands_in_head}++; - ## Check the interior sequences in the command-text - $self->interpolate_and_check($paragraph, $line,$file) - unless(defined $arg); } } -sub _open_list -{ - my ($self,$indent,$line,$file) = @_; - my $list = Pod::List->new( - -indent => $indent, - -start => $line, - -file => $file); - unshift(@{$self->{_list_stack}}, $list); - undef $self->{_list_item_contents}; - $list; -} +######## Formatting codes -sub _close_list -{ - my ($self,$line,$file) = @_; - my $list = shift(@{$self->{_list_stack}}); - if(defined $self->{_list_item_contents} && - $self->{_list_item_contents} == 0) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'WARNING', - -msg => 'previous =item has no contents' }); - } - undef $self->{_list_item_contents}; - $list; +sub start_B { shift->start_fcode('B') } +sub start_C { shift->start_fcode('C') } +sub start_F { shift->start_fcode('F') } +sub start_I { shift->start_fcode('I') } +sub start_S { shift->start_fcode('S') } +sub start_fcode { + my ($self, $fcode) = @_; + unshift @{$self->{'_fcode_stack'}}, $fcode; } -# process a block of some text -sub interpolate_and_check { - my ($self, $paragraph, $line, $file) = @_; - ## Check the interior sequences in the command-text - # and return the text - $self->_check_ptree( - $self->parse_text($paragraph,$line), $line, $file, ''); +sub end_B { shift->end_fcode() } +sub end_C { shift->end_fcode() } +sub end_F { shift->end_fcode() } +sub end_I { shift->end_fcode() } +sub end_S { shift->end_fcode() } +sub end_fcode { + my $self = shift; + $self->_check_fcode(shift @{$self->{'_fcode_stack'}}, # current fcode removed + $self->{'_fcode_stack'}); # previous fcodes } -sub _check_ptree { - my ($self,$ptree,$line,$file,$nestlist) = @_; - local($_); - my $text = ''; - # process each node in the parse tree - foreach(@$ptree) { - # regular text chunk - unless(ref) { - # count the unescaped angle brackets - # complain only when warning level is greater than 1 - if($self->{-warnings} && $self->{-warnings}>1) { - my $count; - if($count = tr/<>/<>/) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'WARNING', - -msg => "$count unescaped <> in paragraph" }); - } - } - $text .= $_; - next; - } - # have an interior sequence - my $cmd = $_->cmd_name(); - my $contents = $_->parse_tree(); - ($file,$line) = $_->file_line(); - # check for valid tag - if (! $VALID_SEQUENCES{$cmd}) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'ERROR', - -msg => qq(Unknown interior-sequence '$cmd')}); - # expand it anyway - $text .= $self->_check_ptree($contents, $line, $file, "$nestlist$cmd"); - next; - } - if(index($nestlist, $cmd) != -1) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'WARNING', - -msg => "nested commands $cmd<...$cmd<...>...>"}); - # _TODO_ should we add the contents anyway? - # expand it anyway, see below - } - if($cmd eq 'E') { - # preserve entities - if(@$contents > 1 || ref $$contents[0] || $$contents[0] !~ /^\w+$/) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'ERROR', - -msg => 'garbled entity ' . $_->raw_text()}); - next; - } - my $ent = $$contents[0]; - my $val; - if($ent =~ /^0x[0-9a-f]+$/i) { - # hexadec entity - $val = hex($ent); - } - elsif($ent =~ /^0\d+$/) { - # octal - $val = oct($ent); - } - elsif($ent =~ /^\d+$/) { - # numeric entity - $val = $ent; - } - if(defined $val) { - if($val>0 && $val<256) { - $text .= chr($val); - } - else { - $self->poderror({ -line => $line, -file => $file, - -severity => 'ERROR', - -msg => 'Entity number out of range ' . $_->raw_text()}); - } - } - elsif($ENTITIES{$ent}) { - # known ISO entity - $text .= $ENTITIES{$ent}; - } - else { - $self->poderror({ -line => $line, -file => $file, - -severity => 'WARNING', - -msg => 'Unknown entity ' . $_->raw_text()}); - $text .= "E<$ent>"; - } - } - elsif($cmd eq 'L') { - # try to parse the hyperlink - my $link = Pod::Hyperlink->new($contents->raw_text()); - unless(defined $link) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'ERROR', - -msg => 'malformed link ' . $_->raw_text() ." : $@"}); - next; - } - $link->line($line); # remember line - if($self->{-warnings}) { - foreach my $w ($link->warning()) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'WARNING', - -msg => $w }); - } - } - # check the link text - $text .= $self->_check_ptree($self->parse_text($link->text(), - $line), $line, $file, "$nestlist$cmd"); - # remember link - $self->hyperlink([$line,$link]); - } - elsif($cmd =~ /[BCFIS]/) { - # add the guts - $text .= $self->_check_ptree($contents, $line, $file, "$nestlist$cmd"); - } - elsif($cmd eq 'Z') { - if(length($contents->raw_text())) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'ERROR', - -msg => 'Nonempty Z<>'}); - } - } - elsif($cmd eq 'X') { - my $idx = $self->_check_ptree($contents, $line, $file, "$nestlist$cmd"); - if($idx =~ /^\s*$/s) { - $self->poderror({ -line => $line, -file => $file, - -severity => 'ERROR', - -msg => 'Empty X<>'}); - } - else { - # remember this node - $self->idx($idx); - } +sub start_L { + my ($self, $flags) = @_; + $self->start_fcode('L'); + + my $link = Pod::Checker::Hyperlink->new($flags, $self); + if ($link) { + if ( $link->type eq 'pod' + && $link->node + # It's an internal-to-this-page link if no page is given, or + # if the given one is to our NAME. + && (! $link->page || ( $self->{'_pod_name'} + && $link->page eq $self->{'_pod_name'}))) + { + push @{ $self->{'_internal_links'} }, [ $link->{'-raw_node'}, $link->line ]; } else { - # not reached - croak 'internal error'; + $self->hyperlink($link); } } - $text; } -# process a block of verbatim text -sub verbatim { - ## Nothing particular to check - my ($self, $paragraph, $line_num, $pod_para) = @_; - - $self->_preproc_par($paragraph); - $self->_commands_in_paragraphs($paragraph, $pod_para); +sub end_L { + my $self = shift; + $self->end_fcode(); +} - if($self->{_current_head1} eq 'NAME') { - my ($file, $line) = $pod_para->file_line; - $self->poderror({ -line => $line, -file => $file, - -severity => 'WARNING', - -msg => 'Verbatim paragraph in NAME section' }); +sub start_X { + my $self = shift; + $self->start_fcode('X'); + # keep track of where X<> starts in the paragraph + # (this is a stack so nested X<>s are handled correctly) + push @{$self->{'_fcode_pos'}}, length $self->{'_thispara'}; +} +sub end_X { + my $self = shift; + # extract contents of X<> and replace with '' + my $start = pop @{$self->{'_fcode_pos'}}; # start at the beginning of X<> + my $end = length($self->{'_thispara'}) - $start; # end at end of X<> + my $x = substr($self->{'_thispara'}, $start, $end, ''); + if ($x eq "") { + $self->poderror({ -line => $self->{'_line'}, + -severity => 'ERROR', + -msg => "An empty X<>" }); } + $self->idx($x); # remember this node + $self->end_fcode(); } -# process a block of regular text -sub textblock { - my ($self, $paragraph, $line_num, $pod_para) = @_; - my ($file, $line) = $pod_para->file_line; - - $self->_preproc_par($paragraph); - $self->_commands_in_paragraphs($paragraph, $pod_para); - - # skip this paragraph if in a =begin block - unless($self->{_have_begin}) { - my $block = $self->interpolate_and_check($paragraph, $line,$file); - if($self->{_current_head1} eq 'NAME') { - if($block =~ /^\s*(\S+?)\s*[,-]/) { - # this is the canonical name - $self->{-name} = $1 unless(defined $self->{-name}); - } - } +package Pod::Checker::Hyperlink; + +# This class is used to represent L<> link structures, so that the individual +# elements are easily accessible. It is based on code in Pod::Hyperlink + +sub new { + my ($class, + $simple_link, # The link structure returned by Pod::Simple + $caller # The caller class + ) = @_; + + my $self = +{}; + bless $self, $class; + + $self->{'-line'} ||= $caller->{'_line'}; + $self->{'-type'} ||= $simple_link->{'type'}; + + # Force stringification of page and node. (This expands any E<>.) + $self->{'-page'} = exists $simple_link->{'to'} ? "$simple_link->{'to'}" : ""; + $self->{'-node'} = exists $simple_link->{'section'} ? "$simple_link->{'section'}" : ""; + + # Save the unmodified node text, as the .t files are expecting the message + # for internal link failures to include it (hence this preserves backward + # compatibility). + $self->{'-raw_node'} = $self->{'-node'}; + + # Remove leading/trailing white space. Pod::Simple already warns about + # these, so if the only error is this, and the link is otherwise correct, + # only the Pod::Simple warning will be output, avoiding unnecessary + # confusion. + $self->{'-page'} =~ s/ ^ \s+ //x; + $self->{'-page'} =~ s/ \s+ $ //x; + + $self->{'-node'} =~ s/ ^ \s+ //x; + $self->{'-node'} =~ s/ \s+ $ //x; + + # Pod::Simple warns about L<> and L< >, but not L</> + if ($self->{'-page'} eq "" && $self->{'-node'} eq "") { + $caller->poderror({ -line => $caller->{'_line'}, + -severity => 'WARNING', + -msg => 'empty link'}); + return; } + + return $self; } -sub _preproc_par -{ - my $self = shift; - $_[0] =~ s/[\s\n]+$//; - if($_[0]) { - $self->{_commands_in_head}++; - $self->{_list_item_contents}++ if(defined $self->{_list_item_contents}); - if(@{$self->{_list_stack}} && !$self->{_list_stack}->[0]->item()) { - $self->{_list_stack}->[0]->{_has_par} = 1; - } - } +=item line() + +Returns the approximate line number in which the link was encountered + +=cut + +sub line { + return $_[0]->{-line}; } -# look for =foo commands at the start of a line within a paragraph, as for -# instance the following which prints as "* one =item two". -# -# =item one -# =item two -# -# Examples of =foo written in docs are expected to be indented in a verbatim -# or marked up C<=foo> so won't be caught. A double-angle C<< =foo >> could -# have the =foo at the start of a line, but that should be unlikely and is -# easily enough dealt with by not putting a newline after the C<<. -# -sub _commands_in_paragraphs { - my ($self, $str, $pod_para) = @_; - while ($str =~ /[^\n]\n=([a-z][a-z0-9]+)/sg) { - my $cmd = $1; - my $pos = pos($str); - if ($VALID_COMMANDS{$cmd}) { - my ($file, $line) = $pod_para->file_line; - my $part = substr($str, 0, $pos); - $line += ($part =~ tr/\n//); # count of newlines - - $self->poderror - ({ -line => $line, -file => $file, - -severity => 'ERROR', - -msg => "Apparent command =$cmd not preceded by blank line"}); - } - } +=item type() + +Returns the type of the link; one of: +C<"url"> for things like +C<http://www.foo>, C<"man"> for man pages, or C<"pod">. + +=cut + +sub type { + return $_[0]->{-type}; } -1; +=item page() -__END__ +Returns the linked-to page or url. + +=cut + +sub page { + return $_[0]->{-page}; +} + +=item node() + +Returns the anchor or node within the linked-to page, or an empty string +(C<"">) if none appears in the link. + +=back + +=cut + +sub node { + return $_[0]->{-node}; +} =head1 AUTHOR Please report bugs using L<http://rt.cpan.org>. Brad Appleton E<lt>bradapp@enteract.comE<gt> (initial version), -Marek Rouchal E<lt>marekr@cpan.orgE<gt> +Marek Rouchal E<lt>marekr@cpan.orgE<gt>, +Marc Green E<lt>marcgreen@cpan.orgE<gt> (port to Pod::Simple) +Ricardo Signes E<lt>rjbs@cpan.orgE<gt> (more porting to Pod::Simple) +Karl Williamson E<lt>khw@cpan.orgE<gt> (more porting to Pod::Simple) Based on code for B<Pod::Text::pod2text()> written by Tom Christiansen E<lt>tchrist@mox.perl.comE<gt> -B<Pod::Checker> is part of the Pod-Checker distribution, and is based on -L<Pod::Parser>. - =cut +1 diff --git a/Master/tlpkg/tlperl/lib/Pod/Functions.pm b/Master/tlpkg/tlperl/lib/Pod/Functions.pm index 55d6e826659..f71f6e375b1 100644 --- a/Master/tlpkg/tlperl/lib/Pod/Functions.pm +++ b/Master/tlpkg/tlperl/lib/Pod/Functions.pm @@ -8,7 +8,7 @@ Pod::Functions - Group Perl's functions a la perlfunc.pod =head1 SYNOPSIS use Pod::Functions; - + my @misc_ops = @{ $Kinds{ 'Misc' } }; my $misc_dsc = $Type_Description{ 'Misc' }; @@ -54,7 +54,7 @@ L<perlfunc/"Perl Functions by Category"> section. =cut -our $VERSION = '1.10'; +our $VERSION = '1.11'; require Exporter; @@ -312,7 +312,7 @@ sqrt Math square root function srand Math seed the random number generator stat File get a file's status information state Namespace declare and assign a persistent lexical variable -study Regexp optimize input data for repeated searches +study Regexp no-op, formerly optimized input data for repeated searches sub Flow declare a subroutine, possibly anonymously __SUB__ Flow the current subroutine, or C<undef> if not in a subroutine substr String get or alter a portion of a string diff --git a/Master/tlpkg/tlperl/lib/Pod/Html.pm b/Master/tlpkg/tlperl/lib/Pod/Html.pm index cef329e1ef9..5b3463687b6 100644 --- a/Master/tlpkg/tlperl/lib/Pod/Html.pm +++ b/Master/tlpkg/tlperl/lib/Pod/Html.pm @@ -3,7 +3,7 @@ use strict; require Exporter; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); -$VERSION = 1.2201; +$VERSION = 1.2202; @ISA = qw(Exporter); @EXPORT = qw(pod2html htmlify); @EXPORT_OK = qw(anchorify); @@ -486,7 +486,7 @@ sub parse_command_line { my ($opt_backlink,$opt_cachedir,$opt_css,$opt_flush,$opt_header, $opt_help,$opt_htmldir,$opt_htmlroot,$opt_index,$opt_infile, $opt_outfile,$opt_poderrors,$opt_podpath,$opt_podroot, - $opt_quiet,$opt_recurse,$opt_title,$opt_verbose,$opt_libpods); + $opt_quiet,$opt_recurse,$opt_title,$opt_verbose); unshift @ARGV, split ' ', $Config{pod2html} if $Config{pod2html}; my $result = GetOptions( @@ -500,7 +500,6 @@ sub parse_command_line { 'htmlroot=s' => \$opt_htmlroot, 'index!' => \$opt_index, 'infile=s' => \$opt_infile, - 'libpods=s' => \$opt_libpods, # deprecated 'outfile=s' => \$opt_outfile, 'poderrors!' => \$opt_poderrors, 'podpath=s' => \$opt_podpath, @@ -516,7 +515,6 @@ sub parse_command_line { $opt_help = ""; # just to make -w shut-up. @Podpath = split(":", $opt_podpath) if defined $opt_podpath; - warn "--libpods is no longer supported" if defined $opt_libpods; $Backlink = $opt_backlink if defined $opt_backlink; $Cachedir = _unixify($opt_cachedir) if defined $opt_cachedir; diff --git a/Master/tlpkg/tlperl/lib/Pod/Man.pm b/Master/tlpkg/tlperl/lib/Pod/Man.pm index b739559551d..886f614c7e6 100644 --- a/Master/tlpkg/tlperl/lib/Pod/Man.pm +++ b/Master/tlpkg/tlperl/lib/Pod/Man.pm @@ -43,7 +43,7 @@ BEGIN { @ISA = qw(Pod::Simple); -$VERSION = '4.07'; +$VERSION = '4.09'; # Set the debugging level. If someone has inserted a debug function into this # class already, use that. Otherwise, use any Pod::Simple debug function @@ -216,12 +216,13 @@ sub init_fonts { } # Initialize the quotes that we'll be using for C<> text. This requires some -# special handling, both to parse the user parameter if given and to make sure -# that the quotes will be safe against *roff. Sets the internal hash keys -# LQUOTE and RQUOTE. +# special handling, both to parse the user parameters if given and to make +# sure that the quotes will be safe against *roff. Sets the internal hash +# keys LQUOTE and RQUOTE. sub init_quotes { my ($self) = (@_); + # Handle the quotes option first, which sets both quotes at once. $$self{quotes} ||= '"'; if ($$self{quotes} eq 'none') { $$self{LQUOTE} = $$self{RQUOTE} = ''; @@ -235,6 +236,14 @@ sub init_quotes { croak(qq(Invalid quote specification "$$self{quotes}")) } + # Now handle the lquote and rquote options. + if (defined $$self{lquote}) { + $$self{LQUOTE} = $$self{lquote} eq 'none' ? q{} : $$self{lquote}; + } + if (defined $$self{rquote}) { + $$self{RQUOTE} = $$self{rquote} eq 'none' ? q{} : $$self{rquote}; + } + # Double the first quote; note that this should not be s///g as two double # quotes is represented in *roff as three double quotes, not four. Weird, # I know. @@ -514,9 +523,9 @@ sub guesswork { # entire warranty disclaimers in man page output into small caps. if ($$self{MAGIC_SMALLCAPS}) { s{ - ( ^ | [\s\(\"\'\`\[\{<>] | \\[ ] ) # (1) - ( [A-Z] [A-Z] (?: [/A-Z+:\d_\$&] | \\- | [.,\"\s] )* ) # (2) - (?= [\s>\}\]\(\)\'\".?!,;] | \\*\(-- | \\[ ] | $ ) # (3) + ( ^ | [\s\(\"\'\`\[\{<>] | \\[ ] ) # (1) + ( [A-Z] [A-Z] (?: \s? [/A-Z+:\d_\$&] | \\- | \s? [.,\"] )* ) # (2) + (?= [\s>\}\]\(\)\'\".?!,;] | \\*\(-- | \\[ ] | $ ) # (3) } { $1 . '\s-1' . $2 . '\s0' }egx; @@ -549,6 +558,7 @@ sub guesswork { if ($$self{MAGIC_MANREF}) { s{ ( \b | \\s-1 ) + (?<! \\ ) # rule out \s0(1) ( [A-Za-z_] (?:[.:\w] | \\- | \\s-?[01])+ ) ( \( \d [a-z]* \) ) } { @@ -854,12 +864,16 @@ sub devise_title { # If Pod::Parser gave us an IO::File reference as the source file name, # convert that to the empty string as well. Then, if we don't have a - # valid name, emit a warning and convert it to STDIN. + # valid name, convert it to STDIN. + # + # In podlators 4.00 through 4.07, this also produced a warning, but that + # was surprising to a lot of programs that had expected to be able to pipe + # POD through pod2man without specifying the name. In the name of + # backward compatibility, just quietly set STDIN as the page title. if ($name =~ /^IO::File(?:=\w+)\(0x[\da-f]+\)$/i) { $name = ''; } if ($name eq '') { - $self->whine (1, 'No name given for document'); $name = 'STDIN'; } @@ -1632,7 +1646,7 @@ __END__ =for stopwords en em ALLCAPS teeny fixedbold fixeditalic fixedbolditalic stderr utf8 UTF-8 Allbery Sean Burke Ossanna Solaris formatters troff uppercased -Christiansen nourls parsers Kernighan +Christiansen nourls parsers Kernighan lquote rquote =head1 NAME @@ -1743,6 +1757,20 @@ Pod::Man doesn't assume you have this, and defaults to C<CB>. Some systems (such as Solaris) have this font available as C<CX>. Only matters for B<troff> output. +=item lquote + +=item rquote + +Sets the quote marks used to surround CE<lt>> text. C<lquote> sets the +left quote mark and C<rquote> sets the right quote mark. Either may also +be set to the special value C<none>, in which case no quote mark is added +on that side of CE<lt>> text (but the font is still changed for troff +output). + +Also see the C<quotes> option, which can be used to set both quotes at once. +If both C<quotes> and one of the other options is set, C<lquote> or C<rquote> +overrides C<quotes>. + =item name Set the name of the manual page for the C<.TH> macro. Without this @@ -1752,9 +1780,9 @@ parsed to see if it is a Perl module path. If it is, a path like C<.../lib/Pod/Man.pm> is converted into a name like C<Pod::Man>. This option, if given, overrides any automatic determination of the name. -If generating a manual page from standard input, this option is required, -since there's otherwise no way for Pod::Man to know what to use for the -manual page name. +If generating a manual page from standard input, the name will be set to +C<STDIN> if this option is not provided. Providing this option is strongly +recommended to set a meaningful manual page name. =item nourls @@ -1783,6 +1811,10 @@ This may also be set to the special value C<none>, in which case no quote marks are added around CE<lt>> text (but the font is still changed for troff output). +Also see the C<lquote> and C<rquote> options, which can be used to set the +left and right quotes independently. If both C<quotes> and one of the other +options is set, C<lquote> or C<rquote> overrides C<quotes>. + =item release Set the centered footer for the C<.TH> macro. By default, this is set to diff --git a/Master/tlpkg/tlperl/lib/Pod/ParseLink.pm b/Master/tlpkg/tlperl/lib/Pod/ParseLink.pm index a9e6b34d3ab..9a37a0532c2 100644 --- a/Master/tlpkg/tlperl/lib/Pod/ParseLink.pm +++ b/Master/tlpkg/tlperl/lib/Pod/ParseLink.pm @@ -31,7 +31,7 @@ use Exporter; @ISA = qw(Exporter); @EXPORT = qw(parselink); -$VERSION = '4.07'; +$VERSION = '4.09'; ############################################################################## # Implementation diff --git a/Master/tlpkg/tlperl/lib/Pod/Perldoc.pm b/Master/tlpkg/tlperl/lib/Pod/Perldoc.pm index 787353ba588..8d695b2b4b6 100644 --- a/Master/tlpkg/tlperl/lib/Pod/Perldoc.pm +++ b/Master/tlpkg/tlperl/lib/Pod/Perldoc.pm @@ -12,8 +12,7 @@ use File::Spec::Functions qw(catfile catdir splitdir); use vars qw($VERSION @Pagers $Bindir $Pod2man $Temp_Files_Created $Temp_File_Lifetime ); -$VERSION = '3.25_03'; # patched in perl5.git -$VERSION =~ s/_//; +$VERSION = '3.28'; #.......................................................................... @@ -285,7 +284,8 @@ Options: -m Display module's file in its entirety -n Specify replacement for groff -l Display the module's file name - -F Arguments are file names, not modules + -U Don't attempt to drop privs for security + -F Arguments are file names, not modules (implies -U) -D Verbosely describe what's going on -T Send output to STDOUT without any pager -d output_filename_to_send_to @@ -393,7 +393,7 @@ sub usage_brief { my $program_name = $self->program_name; CORE::die( <<"EOUSAGE" ); -Usage: $program_name [-hVriDtumFXlT] [-n nroffer_program] +Usage: $program_name [-hVriDtumUFXlT] [-n nroffer_program] [-d output_filename] [-o output_format] [-M FormatterModule] [-w formatter_option:option_value] [-L translation_code] PageName|ModuleName|ProgramName @@ -486,7 +486,8 @@ sub init_formatter_class_list { $self->opt_M_with('Pod::Perldoc::ToPod'); # the always-there fallthru $self->opt_o_with('text'); - $self->opt_o_with('term') unless $self->is_mswin32 || $self->is_dos || $self->is_amigaos + $self->opt_o_with('term') + unless $self->is_mswin32 || $self->is_dos || $self->is_amigaos || !($ENV{TERM} && ( ($ENV{TERM} || '') !~ /dumb|emacs|none|unknown/i )); @@ -521,7 +522,7 @@ sub process { $self->options_reading; $self->pagers_guessing; $self->aside(sprintf "$0 => %s v%s\n", ref($self), $self->VERSION); - $self->drop_privs_maybe unless $self->opt_U; + $self->drop_privs_maybe unless ($self->opt_U || $self->opt_F); $self->options_processing; # Hm, we have @pages and @found, but we only really act on one @@ -850,8 +851,11 @@ sub grand_search_init { =~ s/\.P(?:[ML]|OD)\z//; } else { - print STDERR "No " . + print STDERR "No " . ($self->opt_m ? "module" : "documentation") . " found for \"$_\".\n"; + if ( /^https/ ) { + print STDERR "You may need an SSL library (such as IO::Socket::SSL) for that URL.\n"; + } } next; } @@ -1326,7 +1330,7 @@ sub search_perlfunc { local $_; while (<$fh>) { /^=encoding\s+(\S+)/ && $self->set_encoding($fh, $1); - last if /^=head2 $re/; + last if /^=head2 (?:$re|Alphabetical Listing of Perl Functions)/; } # Look for our function @@ -1360,7 +1364,7 @@ sub search_perlfunc { last if $found > 1 and $inlist < 2; } } - elsif (/^=item/) { + elsif (/^=item|^=back/) { last if $found > 1 and $inlist < 2; } elsif ($found and /^X<[^>]+>/) { @@ -1669,9 +1673,9 @@ sub pagers_guessing { push @pagers, qw( less.exe more.com< ); unshift @pagers, $ENV{PAGER} if $ENV{PAGER}; } - elsif ( $self->is_amigaos) { - push @pagers, qw( /SYS/Utilities/MultiView /SYS/Utilities/More /C/TYPE ); - unshift @pagers, "$ENV{PAGER}" if $ENV{PAGER}; + elsif ( $self->is_amigaos) { + push @pagers, qw( /SYS/Utilities/MultiView /SYS/Utilities/More /C/TYPE ); + unshift @pagers, "$ENV{PAGER}" if $ENV{PAGER}; } else { if ($self->is_os2) { @@ -1696,7 +1700,7 @@ sub pagers_guessing { unshift @pagers, "$ENV{PERLDOC_PAGER} <" if $ENV{PERLDOC_PAGER}; } - $self->aside("Pagers: ", @pagers); + $self->aside("Pagers: ", (join ", ", @pagers)); return; } @@ -1923,19 +1927,21 @@ sub page { # apply a pager to the output file # many many corners of the OS don't like it. So we # have to force it to be "\" to make everyone happy. - # if we are on an amiga convert unix path to an amiga one - $output =~ s/^\/(.*)\/(.*)/$1:$2/ if $self->is_amigaos; + # if we are on an amiga convert unix path to an amiga one + $output =~ s/^\/(.*)\/(.*)/$1:$2/ if $self->is_amigaos; foreach my $pager (@pagers) { $self->aside("About to try calling $pager $output\n"); if ($self->is_vms) { last if system("$pager $output") == 0; - } elsif($self->is_amigaos) { + } elsif($self->is_amigaos) { last if system($pager, $output) == 0; } else { - # fix visible escape codes in ToTerm output - # https://bugs.debian.org/758689 - local $ENV{LESS} = defined $ENV{LESS} ? "$ENV{LESS} -R" : "-R"; + my $formatter = $self->{'formatter_class'}; + if ( $formatter->can('pager_configuration') ) { + $self->aside("About to call $formatter" . "->pager_configuration(\"$pager\")\n"); + $formatter->pager_configuration($pager, $self); + } last if system("$pager \"$output\"") == 0; } } diff --git a/Master/tlpkg/tlperl/lib/Pod/Perldoc/BaseTo.pm b/Master/tlpkg/tlperl/lib/Pod/Perldoc/BaseTo.pm index 304da44ede2..37f651047d6 100644 --- a/Master/tlpkg/tlperl/lib/Pod/Perldoc/BaseTo.pm +++ b/Master/tlpkg/tlperl/lib/Pod/Perldoc/BaseTo.pm @@ -3,7 +3,7 @@ use strict; use warnings; use vars qw($VERSION); -$VERSION = '3.25'; +$VERSION = '3.28'; use Carp qw(croak carp); use Config qw(%Config); @@ -33,6 +33,7 @@ BEGIN { *is_linux = $^O eq 'linux' ? \&TRUE : \&FALSE unless defined &is_linux; *is_hpux = $^O =~ m/hpux/ ? \&TRUE : \&FALSE unless defined &is_hpux; *is_openbsd = $^O =~ m/openbsd/ ? \&TRUE : \&FALSE unless defined &is_openbsd; + *is_freebsd = $^O =~ m/freebsd/ ? \&TRUE : \&FALSE unless defined &is_freebsd; *is_bitrig = $^O =~ m/bitrig/ ? \&TRUE : \&FALSE unless defined &is_bitrig; } diff --git a/Master/tlpkg/tlperl/lib/Pod/Perldoc/GetOptsOO.pm b/Master/tlpkg/tlperl/lib/Pod/Perldoc/GetOptsOO.pm index 71fcc7bc9a2..afa2574ec7e 100644 --- a/Master/tlpkg/tlperl/lib/Pod/Perldoc/GetOptsOO.pm +++ b/Master/tlpkg/tlperl/lib/Pod/Perldoc/GetOptsOO.pm @@ -2,7 +2,7 @@ package Pod::Perldoc::GetOptsOO; use strict; use vars qw($VERSION); -$VERSION = '3.25'; +$VERSION = '3.28'; BEGIN { # Make a DEBUG constant ASAP *DEBUG = defined( &Pod::Perldoc::DEBUG ) diff --git a/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToANSI.pm b/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToANSI.pm index 26a11d3c809..8217c7b1bc4 100644 --- a/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToANSI.pm +++ b/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToANSI.pm @@ -4,7 +4,7 @@ use warnings; use parent qw(Pod::Perldoc::BaseTo); use vars qw($VERSION); -$VERSION = '3.25'; +$VERSION = '3.28'; sub is_pageable { 1 } sub write_with_binmode { 0 } diff --git a/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToChecker.pm b/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToChecker.pm index 3d161acf51c..a6dbbe3f033 100644 --- a/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToChecker.pm +++ b/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToChecker.pm @@ -4,7 +4,7 @@ use warnings; use vars qw(@ISA); use vars qw($VERSION); -$VERSION = '3.25'; +$VERSION = '3.28'; # Pick our superclass... # diff --git a/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToMan.pm b/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToMan.pm index e22e05044d1..bfcb5c40ee6 100644 --- a/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToMan.pm +++ b/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToMan.pm @@ -5,7 +5,7 @@ use warnings; use parent qw(Pod::Perldoc::BaseTo); use vars qw($VERSION); -$VERSION = '3.25'; +$VERSION = '3.28'; use File::Spec::Functions qw(catfile); use Pod::Man 2.18; @@ -63,7 +63,7 @@ sub init { sub _roffer_candidates { my( $self ) = @_; - if( $self->is_openbsd || $self->is_bitrig ) { qw( mandoc groff nroff ) } + if( $self->is_openbsd || $self->is_freebsd || $self->is_bitrig ) { qw( mandoc groff nroff ) } else { qw( groff nroff mandoc ) } } diff --git a/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToNroff.pm b/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToNroff.pm index ac4a8aa17d4..a52f6160192 100644 --- a/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToNroff.pm +++ b/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToNroff.pm @@ -4,7 +4,7 @@ use warnings; use parent qw(Pod::Perldoc::BaseTo); use vars qw($VERSION); -$VERSION = '3.25'; +$VERSION = '3.28'; # This is unlike ToMan.pm in that it emits the raw nroff source! diff --git a/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToPod.pm b/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToPod.pm index 8433e8ca409..825a1caaf5b 100644 --- a/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToPod.pm +++ b/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToPod.pm @@ -4,7 +4,7 @@ use warnings; use parent qw(Pod::Perldoc::BaseTo); use vars qw($VERSION); -$VERSION = '3.25'; +$VERSION = '3.28'; sub is_pageable { 1 } sub write_with_binmode { 0 } diff --git a/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToRtf.pm b/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToRtf.pm index 81f019f8a20..d084816cab2 100644 --- a/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToRtf.pm +++ b/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToRtf.pm @@ -4,7 +4,7 @@ use warnings; use parent qw( Pod::Simple::RTF ); use vars qw($VERSION); -$VERSION = '3.25'; +$VERSION = '3.28'; sub is_pageable { 0 } sub write_with_binmode { 0 } diff --git a/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToTerm.pm b/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToTerm.pm index e97a775e10e..9501d6310e7 100644 --- a/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToTerm.pm +++ b/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToTerm.pm @@ -3,7 +3,7 @@ use strict; use warnings; use vars qw($VERSION); -$VERSION = '3.25'; +$VERSION = '3.28'; use parent qw(Pod::Perldoc::BaseTo); @@ -26,6 +26,34 @@ sub width { $self->_get_default_width; } +sub pager_configuration { + my($self, $pager, $perldoc) = @_; + + # do not modify anything on Windows or DOS + return if ( $perldoc->is_mswin32 || $perldoc->is_dos ); + + if ( $pager =~ /less/ ) { + $self->_maybe_modify_environment('LESS'); + } + elsif ( $pager =~ /more/ ) { + $self->_maybe_modify_environment('MORE'); + } + + return; +} + +sub _maybe_modify_environment { + my($self, $name) = @_; + + if ( ! defined $ENV{$name} ) { + $ENV{$name} = "-R"; + } + + # if the environment is set, don't modify + # anything + +} + sub _get_stty { `stty -a` } sub _get_columns_from_stty { @@ -89,7 +117,7 @@ sub parse_from_file { =head1 NAME -Pod::Perldoc::ToTerm - render Pod with terminal escapes +Pod::Perldoc::ToTerm - render Pod with terminal escapes =head1 SYNOPSIS @@ -107,6 +135,14 @@ For example: perldoc -o term -w indent:5 Some::Modulename +=head1 PAGER FORMATTING + +Depending on the platform, and because this class emits terminal escapes it +will attempt to set the C<-R> flag on your pager by injecting the flag into +your environment variable for C<less> or C<more>. + +On Windows and DOS, this class will not modify any environment variables. + =head1 CAVEAT This module may change to use a different text formatter class in the @@ -118,7 +154,7 @@ L<Pod::Text>, L<Pod::Text::Termcap>, L<Pod::Perldoc> =head1 COPYRIGHT AND DISCLAIMERS -Copyright (c) 2011 Mark Allen. +Copyright (c) 2017 Mark Allen. This program is free software; you can redistribute it and/or modify it under the terms of either: the GNU General Public License as published diff --git a/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToText.pm b/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToText.pm index dbd47438d3a..99ab66c3048 100644 --- a/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToText.pm +++ b/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToText.pm @@ -3,7 +3,7 @@ use strict; use warnings; use vars qw($VERSION); -$VERSION = '3.25'; +$VERSION = '3.28'; use parent qw(Pod::Perldoc::BaseTo); diff --git a/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToTk.pm b/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToTk.pm index 40b51c5b438..6ca7542c7af 100644 --- a/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToTk.pm +++ b/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToTk.pm @@ -3,7 +3,7 @@ use strict; use warnings; use vars qw($VERSION); -$VERSION = '3.25'; +$VERSION = '3.28'; use parent qw(Pod::Perldoc::BaseTo); diff --git a/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToXml.pm b/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToXml.pm index 9da514f7f61..0161c048a9c 100644 --- a/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToXml.pm +++ b/Master/tlpkg/tlperl/lib/Pod/Perldoc/ToXml.pm @@ -6,7 +6,7 @@ use vars qw($VERSION); use parent qw( Pod::Simple::XMLOutStream ); use vars qw($VERSION); -$VERSION = '3.25'; +$VERSION = '3.28'; sub is_pageable { 0 } sub write_with_binmode { 0 } diff --git a/Master/tlpkg/tlperl/lib/Pod/Simple.pm b/Master/tlpkg/tlperl/lib/Pod/Simple.pm index d8521b2e8be..20924153b65 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.32'; +$VERSION = '3.35'; @Known_formatting_codes = qw(I B C L E F S X Z); %Known_formatting_codes = map(($_=>1), @Known_formatting_codes); diff --git a/Master/tlpkg/tlperl/lib/Pod/Simple/BlackBox.pm b/Master/tlpkg/tlperl/lib/Pod/Simple/BlackBox.pm index 7021e6c9f15..9fe3f702ef9 100644 --- a/Master/tlpkg/tlperl/lib/Pod/Simple/BlackBox.pm +++ b/Master/tlpkg/tlperl/lib/Pod/Simple/BlackBox.pm @@ -22,7 +22,7 @@ use integer; # vroom! use strict; use Carp (); use vars qw($VERSION ); -$VERSION = '3.32'; +$VERSION = '3.35'; #use constant DEBUG => 7; BEGIN { require Pod::Simple; @@ -198,7 +198,12 @@ sub parse_lines { # Usage: $parser->parse_lines(@lines) # On Perls that have this function, we can see if the sequence is # valid UTF-8 or not. - if (! utf8::decode($non_ascii_seq)) { + my $is_utf8; + { + no warnings 'utf8'; + $is_utf8 = utf8::decode($non_ascii_seq); + } + if (! $is_utf8) { $encoding = 'CP1252'; goto guessed; } diff --git a/Master/tlpkg/tlperl/lib/Pod/Simple/Checker.pm b/Master/tlpkg/tlperl/lib/Pod/Simple/Checker.pm index a32d8b813c2..83415f8e25e 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.32'; +$VERSION = '3.35'; @ISA = ('Pod::Simple::Methody'); BEGIN { *DEBUG = defined(&Pod::Simple::DEBUG) ? \&Pod::Simple::DEBUG diff --git a/Master/tlpkg/tlperl/lib/Pod/Simple/Debug.pm b/Master/tlpkg/tlperl/lib/Pod/Simple/Debug.pm index 603d4a5b2d0..428cc723594 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.32'; +$VERSION = '3.35'; 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 a2325626f08..71bef5070be 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.32'; +$VERSION = '3.35'; 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 bd3919852c7..9d84878cb78 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.32'; +$VERSION = '3.35'; 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 9d8f978eea1..9cdbed217e5 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.32'; +$VERSION = '3.35'; BEGIN { if(defined &DEBUG) { } # no-op elsif( defined &Pod::Simple::DEBUG ) { *DEBUG = \&Pod::Simple::DEBUG } diff --git a/Master/tlpkg/tlperl/lib/Pod/Simple/HTMLBatch.pm b/Master/tlpkg/tlperl/lib/Pod/Simple/HTMLBatch.pm index 5758645073a..661266d0de4 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.32'; +$VERSION = '3.35'; @ISA = (); # Yup, we're NOT a subclass of Pod::Simple::HTML! # TODO: nocontents stylesheets. Strike some of the color variations? diff --git a/Master/tlpkg/tlperl/lib/Pod/Simple/LinkSection.pm b/Master/tlpkg/tlperl/lib/Pod/Simple/LinkSection.pm index 0d487313b2d..04612f202e9 100644 --- a/Master/tlpkg/tlperl/lib/Pod/Simple/LinkSection.pm +++ b/Master/tlpkg/tlperl/lib/Pod/Simple/LinkSection.pm @@ -3,12 +3,12 @@ require 5; package Pod::Simple::LinkSection; # Based somewhat dimly on Array::Autojoin use vars qw($VERSION ); -$VERSION = '3.32'; +$VERSION = '3.35'; use strict; use Pod::Simple::BlackBox; use vars qw($VERSION ); -$VERSION = '3.32'; +$VERSION = '3.35'; 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 29ed32090be..67b87067416 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.32'; +$VERSION = '3.35'; @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 af24049f11f..0c18a5b37d6 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.32'; +$VERSION = '3.35'; 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 758f42d6594..7c326ec6aee 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.32'; +$VERSION = '3.35'; 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 0d68841d095..d3066a8e87c 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.32'; +$VERSION = '3.35'; 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 f09c10915e1..d938e0adb21 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.32'; +$VERSION = '3.35'; 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 17d065535cd..a11ce0fd92d 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.32'; +$VERSION = '3.35'; 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 7f493b964d7..c6618168e6b 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.32'; +$VERSION = '3.35'; 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 9aea743a7e0..153c3d3e287 100644 --- a/Master/tlpkg/tlperl/lib/Pod/Simple/RTF.pm +++ b/Master/tlpkg/tlperl/lib/Pod/Simple/RTF.pm @@ -8,7 +8,7 @@ package Pod::Simple::RTF; use strict; use vars qw($VERSION @ISA %Escape $WRAP %Tagmap); -$VERSION = '3.32'; +$VERSION = '3.35'; use Pod::Simple::PullParser (); BEGIN {@ISA = ('Pod::Simple::PullParser')} diff --git a/Master/tlpkg/tlperl/lib/Pod/Simple/Search.pm b/Master/tlpkg/tlperl/lib/Pod/Simple/Search.pm index d5a4a020811..df499cacf2d 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.32'; ## Current version of this package +$VERSION = '3.35'; ## Current version of this package BEGIN { *DEBUG = sub () {0} unless defined &DEBUG; } # set DEBUG level use Carp (); diff --git a/Master/tlpkg/tlperl/lib/Pod/Simple/SimpleTree.pm b/Master/tlpkg/tlperl/lib/Pod/Simple/SimpleTree.pm index 436cd25e462..bff5af84c4b 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.32'; +$VERSION = '3.35'; BEGIN { @ISA = ('Pod::Simple'); *DEBUG = \&Pod::Simple::DEBUG unless defined &DEBUG; diff --git a/Master/tlpkg/tlperl/lib/Pod/Simple/Text.pm b/Master/tlpkg/tlperl/lib/Pod/Simple/Text.pm index e1c2d0b21f0..66e15f48cce 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.32'; +$VERSION = '3.35'; @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 e0db26defb4..980612b3132 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.32'; +$VERSION = '3.35'; @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 6abba4defab..a7364dfa585 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.32'; +$VERSION = '3.35'; #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/Master/tlpkg/tlperl/lib/Pod/Simple/Transcode.pm b/Master/tlpkg/tlperl/lib/Pod/Simple/Transcode.pm index ae9298ef311..a4bb29ffdb6 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.32'; +$VERSION = '3.35'; 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 80b828a753f..c2069056574 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.32'; +$VERSION = '3.35'; # 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 335654998ec..e4d4f7eb60e 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.32'; +$VERSION = '3.35'; 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 67b259cb98f..8c2cf1a01ba 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.32'; +$VERSION = '3.35'; use Pod::Simple::Methody (); @ISA = ('Pod::Simple::Methody'); diff --git a/Master/tlpkg/tlperl/lib/Pod/Simple/XMLOutStream.pm b/Master/tlpkg/tlperl/lib/Pod/Simple/XMLOutStream.pm index 03f2930e967..62fe39549da 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.32'; +$VERSION = '3.35'; 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 e141da2fd6d..211de5a7de8 100644 --- a/Master/tlpkg/tlperl/lib/Pod/Text.pm +++ b/Master/tlpkg/tlperl/lib/Pod/Text.pm @@ -1,4 +1,4 @@ -# Pod::Text -- Convert POD data to formatted text. +# Convert POD data to formatted text. # # This module converts POD to formatted text. It replaces the old Pod::Text # module that came with versions of Perl prior to 5.6.0 and attempts to match @@ -12,7 +12,7 @@ # standard Perl mailing lists. # # Copyright 1999, 2000, 2001, 2002, 2004, 2006, 2008, 2009, 2012, 2013, 2014, -# 2015 Russ Allbery <rra@cpan.org> +# 2015, 2016 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. @@ -39,7 +39,26 @@ use Pod::Simple (); # We have to export pod2text for backward compatibility. @EXPORT = qw(pod2text); -$VERSION = '4.07'; +$VERSION = '4.09'; + +# 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. +my ($NBSP, $SHY); +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"; + } +} ############################################################################## # Initialization @@ -273,7 +292,12 @@ sub reformat { sub output { my ($self, @text) = @_; my $text = join ('', @text); - $text =~ tr/\240\255/ /d; + if ($NBSP) { + $text =~ s/$NBSP/ /g; + } + if ($SHY) { + $text =~ s/$SHY//g; + } unless ($$self{opt_utf8}) { my $encoding = $$self{encoding} || ''; if ($encoding && $encoding ne $$self{ENCODING}) { @@ -999,7 +1023,7 @@ how to use Pod::Simple. =head1 COPYRIGHT AND LICENSE Copyright 1999, 2000, 2001, 2002, 2004, 2006, 2008, 2009, 2012, 2013, 2014, -2015 Russ Allbery <rra@cpan.org> +2015, 2016 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/Color.pm b/Master/tlpkg/tlperl/lib/Pod/Text/Color.pm index b67742e32c3..a26e43db813 100644 --- a/Master/tlpkg/tlperl/lib/Pod/Text/Color.pm +++ b/Master/tlpkg/tlperl/lib/Pod/Text/Color.pm @@ -27,7 +27,7 @@ use vars qw(@ISA $VERSION); @ISA = qw(Pod::Text); -$VERSION = '4.07'; +$VERSION = '4.09'; ############################################################################## # Overrides diff --git a/Master/tlpkg/tlperl/lib/Pod/Text/Overstrike.pm b/Master/tlpkg/tlperl/lib/Pod/Text/Overstrike.pm index 1592026e9f7..f611a4225b3 100644 --- a/Master/tlpkg/tlperl/lib/Pod/Text/Overstrike.pm +++ b/Master/tlpkg/tlperl/lib/Pod/Text/Overstrike.pm @@ -35,7 +35,7 @@ use Pod::Text (); @ISA = qw(Pod::Text); -$VERSION = '4.07'; +$VERSION = '4.09'; ############################################################################## # Overrides diff --git a/Master/tlpkg/tlperl/lib/Pod/Text/Termcap.pm b/Master/tlpkg/tlperl/lib/Pod/Text/Termcap.pm index d533e76ddde..91939331f80 100644 --- a/Master/tlpkg/tlperl/lib/Pod/Text/Termcap.pm +++ b/Master/tlpkg/tlperl/lib/Pod/Text/Termcap.pm @@ -28,7 +28,7 @@ use vars qw(@ISA $VERSION); @ISA = qw(Pod::Text); -$VERSION = '4.07'; +$VERSION = '4.09'; ############################################################################## # Overrides diff --git a/Master/tlpkg/tlperl/lib/Pod/Usage.pm b/Master/tlpkg/tlperl/lib/Pod/Usage.pm index cc4f2e1e4fd..8f7985040f3 100644 --- a/Master/tlpkg/tlperl/lib/Pod/Usage.pm +++ b/Master/tlpkg/tlperl/lib/Pod/Usage.pm @@ -12,7 +12,7 @@ package Pod::Usage; use strict; use vars qw($VERSION @ISA @EXPORT); -$VERSION = '1.68'; ## Current version of this package +$VERSION = '1.69'; ## Current version of this package require 5.006; ## requires this Perl version or later #use diagnostics; |