summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Pod/Simple/BlackBox.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Pod/Simple/BlackBox.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/Simple/BlackBox.pm63
1 files changed, 52 insertions, 11 deletions
diff --git a/Master/tlpkg/tlperl/lib/Pod/Simple/BlackBox.pm b/Master/tlpkg/tlperl/lib/Pod/Simple/BlackBox.pm
index c17cfd0ad51..a1b570810d0 100644
--- a/Master/tlpkg/tlperl/lib/Pod/Simple/BlackBox.pm
+++ b/Master/tlpkg/tlperl/lib/Pod/Simple/BlackBox.pm
@@ -23,7 +23,7 @@ use integer; # vroom!
use strict;
use Carp ();
use vars qw($VERSION );
-$VERSION = '3.20';
+$VERSION = '3.28';
#use constant DEBUG => 7;
BEGIN {
require Pod::Simple;
@@ -91,6 +91,7 @@ sub parse_lines { # Usage: $parser->parse_lines(@lines)
if( ($line = $source_line) =~ s/^\xEF\xBB\xBF//s ) {
DEBUG and print "UTF-8 BOM seen. Faking a '=encoding utf8'.\n";
$self->_handle_encoding_line( "=encoding utf8" );
+ delete $self->{'_processed_encoding'};
$line =~ tr/\n\r//d;
} elsif( $line =~ s/^\xFE\xFF//s ) {
@@ -123,6 +124,22 @@ sub parse_lines { # Usage: $parser->parse_lines(@lines)
}
}
+ # Try to guess encoding. Inlined for performance reasons.
+ if(!$self->{'parse_characters'} && !$self->{'encoding'}
+ && ($self->{'in_pod'} || $line =~ /^=/s)
+ && $line =~ /[^\x00-\x7f]/
+ ) {
+ my $encoding = $line =~ /^[\x00-\x7f]*[\xC0-\xFD][\x80-\xBF]/ ? 'UTF-8' : 'ISO8859-1';
+ $self->_handle_encoding_line( "=encoding $encoding" );
+ $self->{'_transcoder'} && $self->{'_transcoder'}->($line);
+
+ my ($word) = $line =~ /(\S*[^\x00-\x7f]\S*)/;
+
+ $self->whine(
+ $self->{'line_count'},
+ "Non-ASCII character seen before =encoding in '$word'. Assuming $encoding"
+ );
+ }
DEBUG > 5 and print "# Parsing line: [$line]\n";
@@ -176,6 +193,7 @@ sub parse_lines { # Usage: $parser->parse_lines(@lines)
# HERE WE CATCH =encoding EARLY!
if( $line =~ m/^=encoding\s+\S+\s*$/s ) {
+ next if $self->parse_characters; # Ignore this line
$line = $self->_handle_encoding_line( $line );
}
@@ -269,6 +287,8 @@ sub parse_lines { # Usage: $parser->parse_lines(@lines)
sub _handle_encoding_line {
my($self, $line) = @_;
+ return if $self->parse_characters;
+
# The point of this routine is to set $self->{'_transcoder'} as indicated.
return $line unless $line =~ m/^=encoding\s+(\S+)\s*$/s;
@@ -324,6 +344,7 @@ sub _handle_encoding_line {
$@ && die( $enc_error =
"Really unexpected error setting up encoding $e: $@\nAborting"
);
+ $self->{'detected_encoding'} = $e;
} else {
my @supported = Pod::Simple::Transcode::->all_encodings;
@@ -354,8 +375,13 @@ sub _handle_encoding_line {
$self->scream( $self->{'line_count'}, $enc_error );
}
push @{ $self->{'encoding_command_statuses'} }, $enc_error;
+ if (defined($self->{'_processed_encoding'})) {
+ # Should never happen
+ die "Nested processed encoding.";
+ }
+ $self->{'_processed_encoding'} = $orig;
- return '=encoding ALREADYDONE';
+ return $line;
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@@ -371,7 +397,11 @@ sub _handle_encoding_second_level {
DEBUG > 2 and print "Ogling encoding directive: =encoding $content\n";
- if($content eq 'ALREADYDONE') {
+ if (defined($self->{'_processed_encoding'})) {
+ #if($content ne $self->{'_processed_encoding'}) {
+ # Could it happen?
+ #}
+ delete $self->{'_processed_encoding'};
# It's already been handled. Check for errors.
if(! $self->{'encoding_command_statuses'} ) {
DEBUG > 2 and print " CRAZY ERROR: It wasn't really handled?!\n";
@@ -642,8 +672,10 @@ sub _ponder_paragraph_buffer {
if($item_type eq 'text') {
# Nothing special needs doing for 'text'
} elsif($item_type eq 'number' or $item_type eq 'bullet') {
- die "Unknown item type $item_type"
- unless $item_type eq 'number' or $item_type eq 'bullet';
+ $self->whine(
+ $para->[1]{'start_line'},
+ "Expected text after =item, not a $item_type"
+ );
# Undo our clobbering:
push @$para, $para->[1]{'~orig_content'};
delete $para->[1]{'number'};
@@ -772,8 +804,8 @@ sub _ponder_paragraph_buffer {
} elsif($para_type eq '=encoding') {
# Not actually acted on here, but we catch errors here.
$self->_handle_encoding_second_level($para);
-
- next; # and skip
+ next unless $self->keep_encoding_directive;
+ $para_type = 'Plain';
} elsif($para_type eq '~Verbatim') {
$para->[0] = 'Verbatim';
$para_type = '?Verbatim';
@@ -1250,8 +1282,10 @@ sub _ponder_item {
if($item_type eq 'text') {
# Nothing special needs doing for 'text'
} elsif($item_type eq 'number' or $item_type eq 'bullet') {
- die "Unknown item type $item_type"
- unless $item_type eq 'number' or $item_type eq 'bullet';
+ $self->whine(
+ $para->[1]{'start_line'},
+ "Expected text after =item, not a $item_type"
+ );
# Undo our clobbering:
push @$para, $para->[1]{'~orig_content'};
delete $para->[1]{'number'};
@@ -1459,10 +1493,12 @@ sub _traverse_treelet_bit { # for use only by the routine above
my $scratch;
$self->_handle_element_start(($scratch=$name), shift @_);
- foreach my $x (@_) {
- if(ref($x)) {
+ while (@_) {
+ my $x = shift;
+ if (ref($x)) {
&_traverse_treelet_bit($self, @$x);
} else {
+ $x .= shift while @_ && !ref($_[0]);
$self->_handle_text($x);
}
}
@@ -1483,6 +1519,11 @@ sub _closers_for_all_curr_open {
if($copy[0] eq '=for') {
$copy[0] = '=end';
} elsif($copy[0] eq '=over') {
+ $self->whine(
+ $still_open->[1]{start_line} ,
+ "=over without closing =back"
+ );
+
$copy[0] = '=back';
} else {
die "I don't know how to auto-close an open $copy[0] region";