diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Pod/Simple/BlackBox.pm')
-rw-r--r-- | Master/tlpkg/tlperl/lib/Pod/Simple/BlackBox.pm | 63 |
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"; |