diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Pod/Simple.pm')
| -rw-r--r-- | Master/tlpkg/tlperl/lib/Pod/Simple.pm | 51 |
1 files changed, 48 insertions, 3 deletions
diff --git a/Master/tlpkg/tlperl/lib/Pod/Simple.pm b/Master/tlpkg/tlperl/lib/Pod/Simple.pm index ad7a19b8eff..fb5438f7f71 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.20'; +$VERSION = '3.28'; @Known_formatting_codes = qw(I B C L E F S X Z); %Known_formatting_codes = map(($_=>1), @Known_formatting_codes); @@ -80,6 +80,7 @@ __PACKAGE__->_accessorize( 'bare_output', # For some subclasses: whether to prepend # header-code and postpend footer-code + 'keep_encoding_directive', # whether to emit =encoding 'nix_X_codes', # whether to ignore X<...> codes 'merge_text', # whether to avoid breaking a single piece of # text up into several events @@ -87,6 +88,8 @@ __PACKAGE__->_accessorize( 'preserve_whitespace', # whether to try to keep whitespace as-is 'strip_verbatim_indent', # What indent to strip from verbatim + 'parse_characters', # Whether parser should expect chars rather than octets + 'content_seen', # whether we've seen any real Pod content 'errors_seen', # TODO: document. whether we've seen any errors (fatal or not) @@ -111,6 +114,35 @@ sub any_errata_seen { # good for using as an exit() value... return shift->{'errors_seen'} || 0; } +# Returns the encoding only if it was recognized as being handled and set +sub detected_encoding { + return shift->{'detected_encoding'}; +} + +sub encoding { + my $this = shift; + return $this->{'encoding'} unless @_; # GET. + + $this->_handle_encoding_line("=encoding $_[0]"); + if ($this->{'_processed_encoding'}) { + delete $this->{'_processed_encoding'}; + if(! $this->{'encoding_command_statuses'} ) { + DEBUG > 2 and print " CRAZY ERROR: encoding wasn't really handled?!\n"; + } elsif( $this->{'encoding_command_statuses'}[-1] ) { + $this->scream( "=encoding $_[0]", + sprintf "Couldn't do %s: %s", + $this->{'encoding_command_reqs' }[-1], + $this->{'encoding_command_statuses'}[-1], + ); + } else { + DEBUG > 2 and print " (encoding successfully handled.)\n"; + } + return $this->{'encoding'}; + } else { + return undef; + } +} + #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ # Pull in some functions that, for some reason, I expect to see here too: BEGIN { @@ -1033,6 +1065,12 @@ sub _treat_Ls { # Process our dear dear friends, the L<...> sequences $treelet->[$i] = 'L<>'; # just make it a text node next; # and move on } + + if( (! ref $ell->[2] && $ell->[2] =~ /\A\s/) + ||(! ref $ell->[-1] && $ell->[-1] =~ /\s\z/) + ) { + $self->whine( $start_line, "L<> starts or ends with whitespace" ); + } # Catch URLs: @@ -1092,7 +1130,7 @@ sub _treat_Ls { # Process our dear dear friends, the L<...> sequences # Catch some very simple and/or common cases if(@{$ell} == 3 and ! ref $ell->[2]) { my $it = $ell->[2]; - if($it =~ m/^[-a-zA-Z0-9]+\([-a-zA-Z0-9]+\)$/s) { # man sections + if($it =~ m{^[^/|]+[(][-a-zA-Z0-9]+[)]$}s) { # man sections # Hopefully neither too broad nor too restrictive a RE DEBUG > 1 and print "Catching \"$it\" as manpage link.\n"; $ell->[1]{'type'} = 'man'; @@ -1148,6 +1186,13 @@ sub _treat_Ls { # Process our dear dear friends, the L<...> sequences DEBUG > 3 and print " FOUND a '|' in it. Splitting into [$1] + [$2]\n"; + if ($link_text[0] =~ m{[|/]}) { + $self->whine( + $start_line, + "alternative text '$link_text[0]' contains non-escaped | or /" + ); + } + unshift @link_text, splice @ell_content, 0, $j; # leaving only things at J and after @ell_content = grep ref($_)||length($_), @ell_content ; @@ -1251,7 +1296,7 @@ sub _treat_Ls { # Process our dear dear friends, the L<...> sequences # And the E resolver will have to deal with all our treeletty things: if(@ell_content == 1 and !ref($ell_content[0]) - and $ell_content[0] =~ m/^[-a-zA-Z0-9]+\([-a-zA-Z0-9]+\)$/s + and $ell_content[0] =~ m{^[^/]+[(][-a-zA-Z0-9]+[)]$}s ) { $ell->[1]{'type'} = 'man'; DEBUG > 3 and print "Considering this ($ell_content[0]) a man link.\n"; |