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.pm390
1 files changed, 239 insertions, 151 deletions
diff --git a/Master/tlpkg/tlperl/lib/Pod/Simple/BlackBox.pm b/Master/tlpkg/tlperl/lib/Pod/Simple/BlackBox.pm
index ee6e747a6a0..7021e6c9f15 100644
--- a/Master/tlpkg/tlperl/lib/Pod/Simple/BlackBox.pm
+++ b/Master/tlpkg/tlperl/lib/Pod/Simple/BlackBox.pm
@@ -22,13 +22,27 @@ use integer; # vroom!
use strict;
use Carp ();
use vars qw($VERSION );
-$VERSION = '3.29';
+$VERSION = '3.32';
#use constant DEBUG => 7;
BEGIN {
require Pod::Simple;
*DEBUG = \&Pod::Simple::DEBUG unless defined &DEBUG
}
+# Matches a character iff the character will have a different meaning
+# if we choose CP1252 vs UTF-8 if there is no =encoding line.
+# This is broken for early Perls on non-ASCII platforms.
+my $non_ascii_re = eval "qr/[[:^ascii:]]/";
+$non_ascii_re = qr/[\x80-\xFF]/ if ! defined $non_ascii_re;
+
+my $utf8_bom;
+if (($] ge 5.007_003)) {
+ $utf8_bom = "\x{FEFF}";
+ utf8::encode($utf8_bom);
+} else {
+ $utf8_bom = "\xEF\xBB\xBF"; # No EBCDIC BOM detection for early Perls.
+}
+
#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
sub parse_line { shift->parse_lines(@_) } # alias
@@ -47,10 +61,10 @@ sub parse_lines { # Usage: $parser->parse_lines(@lines)
my $scratch;
DEBUG > 4 and
- print "# Parsing starting at line ", $self->{'line_count'}, ".\n";
+ print STDERR "# Parsing starting at line ", $self->{'line_count'}, ".\n";
DEBUG > 5 and
- print "# About to parse lines: ",
+ print STDERR "# About to parse lines: ",
join(' ', map defined($_) ? "[$_]" : "EOF", @_), "\n";
my $paras = ($self->{'paras'} ||= []);
@@ -63,12 +77,12 @@ sub parse_lines { # Usage: $parser->parse_lines(@lines)
my $line;
foreach my $source_line (@_) {
if( $self->{'source_dead'} ) {
- DEBUG > 4 and print "# Source is dead.\n";
+ DEBUG > 4 and print STDERR "# Source is dead.\n";
last;
}
unless( defined $source_line ) {
- DEBUG > 4 and print "# Undef-line seen.\n";
+ DEBUG > 4 and print STDERR "# Undef-line seen.\n";
push @$paras, ['~end', {'start_line' => $self->{'line_count'}}];
push @$paras, $paras->[-1], $paras->[-1];
@@ -85,16 +99,16 @@ sub parse_lines { # Usage: $parser->parse_lines(@lines)
# tr/// modding the (potentially read-only) original source line!
} else {
- DEBUG > 2 and print "First line: [$source_line]\n";
+ DEBUG > 2 and print STDERR "First line: [$source_line]\n";
- if( ($line = $source_line) =~ s/^\xEF\xBB\xBF//s ) {
- DEBUG and print "UTF-8 BOM seen. Faking a '=encoding utf8'.\n";
+ if( ($line = $source_line) =~ s/^$utf8_bom//s ) {
+ DEBUG and print STDERR "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 ) {
- DEBUG and print "Big-endian UTF-16 BOM seen. Aborting parsing.\n";
+ DEBUG and print STDERR "Big-endian UTF-16 BOM seen. Aborting parsing.\n";
$self->scream(
$self->{'line_count'},
"UTF16-BE Byte Encoding Mark found; but Pod::Simple v$Pod::Simple::VERSION doesn't implement UTF16 yet."
@@ -106,7 +120,7 @@ sub parse_lines { # Usage: $parser->parse_lines(@lines)
# TODO: implement somehow?
} elsif( $line =~ s/^\xFF\xFE//s ) {
- DEBUG and print "Little-endian UTF-16 BOM seen. Aborting parsing.\n";
+ DEBUG and print STDERR "Little-endian UTF-16 BOM seen. Aborting parsing.\n";
$self->scream(
$self->{'line_count'},
"UTF16-LE Byte Encoding Mark found; but Pod::Simple v$Pod::Simple::VERSION doesn't implement UTF16 yet."
@@ -118,33 +132,107 @@ sub parse_lines { # Usage: $parser->parse_lines(@lines)
# TODO: implement somehow?
} else {
- DEBUG > 2 and print "First line is BOM-less.\n";
+ DEBUG > 2 and print STDERR "First line is BOM-less.\n";
($line = $source_line) =~ tr/\n\r//d;
}
}
- # Try to guess encoding. Inlined for performance reasons.
if(!$self->{'parse_characters'} && !$self->{'encoding'}
&& ($self->{'in_pod'} || $line =~ /^=/s)
- && $line =~ /[[:^ascii:]]/
+ && $line =~ /$non_ascii_re/
) {
+
my $encoding;
- if (ord("A") != 65) {
- # Hard to figure out on non-ASCII platform if UTF-8 or not. This
- # won't work if it isn't UTF-8, so just assume it is and hope for the
- # best. It's not clear that the other encodings work on non-ASCII
- # platforms anyway.
- $encoding = 'UTF-8';
- }
- else {
- $encoding = $line =~ /^[\x00-\x7f]*[\xC0-\xFD][\x80-\xBF]/ ? 'UTF-8' : 'ISO8859-1';
- }
+ # No =encoding line, and we are at the first line in the input that
+ # contains a non-ascii byte, that is one whose meaning varies depending
+ # on whether the file is encoded in UTF-8 or CP1252, which are the two
+ # possibilities permitted by the pod spec. (ASCII is assumed if the
+ # file only contains ASCII bytes.) In order to process this line, we
+ # need to figure out what encoding we will use for the file.
+ #
+ # Strictly speaking ISO 8859-1 (Latin 1) refers to the code points
+ # 160-255, but it is used here, as it often colloquially is, to refer to
+ # the complete set of code points 0-255, including ASCII (0-127), the C1
+ # controls (128-159), and strict Latin 1 (160-255).
+ #
+ # CP1252 is effectively a superset of Latin 1, because it differs only
+ # from colloquial 8859-1 in the C1 controls, which are very unlikely to
+ # actually be present in 8859-1 files, so can be used for other purposes
+ # without conflict. CP 1252 uses most of them for graphic characters.
+ #
+ # Note that all ASCII-range bytes represent their corresponding code
+ # points in CP1252 and UTF-8. In ASCII platform UTF-8 all other code
+ # points require multiple (non-ASCII) bytes to represent. (A separate
+ # paragraph for EBCDIC is below.) The multi-byte representation is
+ # quite structured. If we find an isolated byte that requires multiple
+ # bytes to represent in UTF-8, we know that the encoding is not UTF-8.
+ # If we find a sequence of bytes that violates the UTF-8 structure, we
+ # also can presume the encoding isn't UTF-8, and hence must be 1252.
+ #
+ # But there are ambiguous cases where we could guess wrong. If so, the
+ # user will end up having to supply an =encoding line. We use all
+ # readily available information to improve our chances of guessing
+ # right. The odds of something not being UTF-8, but still passing a
+ # UTF-8 validity test go down very rapidly with increasing length of the
+ # sequence. Therefore we look at all the maximal length non-ascii
+ # sequences on the line. If any of the sequences can't be UTF-8, we
+ # quit there and choose CP1252. If all could be UTF-8, we guess UTF-8.
+ #
+ # On EBCDIC platforms, the situation is somewhat different. In
+ # UTF-EBCDIC, not only do ASCII-range bytes represent their code points,
+ # but so do the bytes that are for the C1 controls. Recall that these
+ # correspond to the unused portion of 8859-1 that 1252 mostly takes
+ # over. That means that there are fewer code points that are
+ # represented by multi-bytes. But, note that the these controls are
+ # very unlikely to be in pod text. So if we encounter one of them, it
+ # means that it is quite likely CP1252 and not UTF-8. The net result is
+ # the same code below is used for both platforms.
+ while ($line =~ m/($non_ascii_re+)/g) {
+ my $non_ascii_seq = $1;
+
+ if (length $non_ascii_seq == 1) {
+ $encoding = 'CP1252';
+ goto guessed;
+ } elsif ($] ge 5.007_003) {
+
+ # On Perls that have this function, we can see if the sequence is
+ # valid UTF-8 or not.
+ if (! utf8::decode($non_ascii_seq)) {
+ $encoding = 'CP1252';
+ goto guessed;
+ }
+ } elsif (ord("A") == 65) { # An early Perl, ASCII platform
+
+ # Without utf8::decode, it's a lot harder to do a rigorous check
+ # (though some early releases had a different function that
+ # accomplished the same thing). Since these are ancient Perls, not
+ # likely to be in use today, we take the easy way out, and look at
+ # just the first two bytes of the sequence to see if they are the
+ # start of a UTF-8 character. In ASCII UTF-8, continuation bytes
+ # must be between 0x80 and 0xBF. Start bytes can range from 0xC2
+ # through 0xFF, but anything above 0xF4 is not Unicode, and hence
+ # extremely unlikely to be in a pod.
+ if ($non_ascii_seq !~ /^[\xC2-\xF4][\x80-\xBF]/) {
+ $encoding = 'CP1252';
+ goto guessed;
+ }
+
+ # We don't bother doing anything special for EBCDIC on early Perls.
+ # If there is a solitary variant, CP1252 will be chosen; otherwise
+ # UTF-8.
+ }
+ } # End of loop through all variant sequences on the line
+
+ # All sequences in the line could be UTF-8. Guess that.
+ $encoding = 'UTF-8';
+
+ guessed:
$self->_handle_encoding_line( "=encoding $encoding" );
delete $self->{'_processed_encoding'};
$self->{'_transcoder'} && $self->{'_transcoder'}->($line);
- my ($word) = $line =~ /(\S*[[:^ascii:]]\S*)/;
+ my ($word) = $line =~ /(\S*$non_ascii_re\S*)/;
$self->whine(
$self->{'line_count'},
@@ -152,10 +240,10 @@ sub parse_lines { # Usage: $parser->parse_lines(@lines)
);
}
- DEBUG > 5 and print "# Parsing line: [$line]\n";
+ DEBUG > 5 and print STDERR "# Parsing line: [$line]\n";
if(!$self->{'in_pod'}) {
- if($line =~ m/^=([a-zA-Z]+)/s) {
+ if($line =~ m/^=([a-zA-Z][a-zA-Z0-9]*)(?:\s|$)/s) {
if($1 eq 'cut') {
$self->scream(
$self->{'line_count'},
@@ -175,7 +263,7 @@ sub parse_lines { # Usage: $parser->parse_lines(@lines)
# And fall thru to the pod-mode block further down
}
} else {
- DEBUG > 5 and print "# It's a code-line.\n";
+ DEBUG > 5 and print STDERR "# It's a code-line.\n";
$code_handler->(map $_, $line, $self->{'line_count'}, $self)
if $code_handler;
# Note: this may cause code to be processed out of order relative
@@ -187,8 +275,8 @@ sub parse_lines { # Usage: $parser->parse_lines(@lines)
if( $line =~ m/^#\s*line\s+(\d+)\s*(?:\s"([^"]+)")?\s*$/ ) {
# That RE is from perlsyn, section "Plain Old Comments (Not!)",
#$fname = $2 if defined $2;
- #DEBUG > 1 and defined $2 and print "# Setting fname to \"$fname\"\n";
- DEBUG > 1 and print "# Setting nextline to $1\n";
+ #DEBUG > 1 and defined $2 and print STDERR "# Setting fname to \"$fname\"\n";
+ DEBUG > 1 and print STDERR "# Setting nextline to $1\n";
$self->{'line_count'} = $1 - 1;
}
@@ -210,7 +298,7 @@ sub parse_lines { # Usage: $parser->parse_lines(@lines)
if($line =~ m/^=cut/s) {
# here ends the pod block, and therefore the previous pod para
- DEBUG > 1 and print "Noting =cut at line ${$self}{'line_count'}\n";
+ DEBUG > 1 and print STDERR "Noting =cut at line ${$self}{'line_count'}\n";
$self->{'in_pod'} = 0;
# ++$self->{'pod_para_count'};
$self->_ponder_paragraph_buffer();
@@ -228,12 +316,12 @@ sub parse_lines { # Usage: $parser->parse_lines(@lines)
}
if(!$self->{'start_of_pod_block'} and @$paras and $paras->[-1][0] eq '~Verbatim') {
- DEBUG > 1 and print "Saving blank line at line ${$self}{'line_count'}\n";
+ DEBUG > 1 and print STDERR "Saving blank line at line ${$self}{'line_count'}\n";
push @{$paras->[-1]}, $line;
} # otherwise it's not interesting
if(!$self->{'start_of_pod_block'} and !$self->{'last_was_blank'}) {
- DEBUG > 1 and print "Noting para ends with blank line at ${$self}{'line_count'}\n";
+ DEBUG > 1 and print STDERR "Noting para ends with blank line at ${$self}{'line_count'}\n";
}
$self->{'last_was_blank'} = 1;
@@ -252,18 +340,18 @@ sub parse_lines { # Usage: $parser->parse_lines(@lines)
# by now it's safe to consider the previous paragraph as done.
push @$paras, $new; # the new incipient paragraph
- DEBUG > 1 and print "Starting new ${$paras}[-1][0] para at line ${$self}{'line_count'}\n";
+ DEBUG > 1 and print STDERR "Starting new ${$paras}[-1][0] para at line ${$self}{'line_count'}\n";
} elsif($line =~ m/^\s/s) {
if(!$self->{'start_of_pod_block'} and @$paras and $paras->[-1][0] eq '~Verbatim') {
- DEBUG > 1 and print "Resuming verbatim para at line ${$self}{'line_count'}\n";
+ DEBUG > 1 and print STDERR "Resuming verbatim para at line ${$self}{'line_count'}\n";
push @{$paras->[-1]}, $line;
} else {
++$self->{'pod_para_count'};
$self->_ponder_paragraph_buffer();
# by now it's safe to consider the previous paragraph as done.
- DEBUG > 1 and print "Starting verbatim para at line ${$self}{'line_count'}\n";
+ DEBUG > 1 and print STDERR "Starting verbatim para at line ${$self}{'line_count'}\n";
push @$paras, ['~Verbatim', {'start_line' => $self->{'line_count'}}, $line];
}
} else {
@@ -271,14 +359,14 @@ sub parse_lines { # Usage: $parser->parse_lines(@lines)
$self->_ponder_paragraph_buffer();
# by now it's safe to consider the previous paragraph as done.
push @$paras, ['~Para', {'start_line' => $self->{'line_count'}}, $line];
- DEBUG > 1 and print "Starting plain para at line ${$self}{'line_count'}\n";
+ DEBUG > 1 and print STDERR "Starting plain para at line ${$self}{'line_count'}\n";
}
$self->{'last_was_blank'} = $self->{'start_of_pod_block'} = 0;
} else {
# It's a non-blank line /continuing/ the current para
if(@$paras) {
- DEBUG > 2 and print "Line ${$self}{'line_count'} continues current paragraph\n";
+ DEBUG > 2 and print STDERR "Line ${$self}{'line_count'} continues current paragraph\n";
push @{$paras->[-1]}, $line;
} else {
# Unexpected case!
@@ -289,7 +377,7 @@ sub parse_lines { # Usage: $parser->parse_lines(@lines)
} # ends the big while loop
- DEBUG > 1 and print(pretty(@$paras), "\n");
+ DEBUG > 1 and print STDERR (pretty(@$paras), "\n");
return $self;
}
@@ -303,7 +391,7 @@ sub _handle_encoding_line {
# The point of this routine is to set $self->{'_transcoder'} as indicated.
return $line unless $line =~ m/^=encoding\s+(\S+)\s*$/s;
- DEBUG > 1 and print "Found an encoding line \"=encoding $1\"\n";
+ DEBUG > 1 and print STDERR "Found an encoding line \"=encoding $1\"\n";
my $e = $1;
my $orig = $e;
@@ -323,24 +411,24 @@ sub _handle_encoding_line {
$that =~ s/[-_]//g;
}
if($norm_current eq $norm_e) {
- DEBUG > 1 and print "The '=encoding $orig' line is ",
+ DEBUG > 1 and print STDERR "The '=encoding $orig' line is ",
"redundant. ($norm_current eq $norm_e). Ignoring.\n";
$enc_error = '';
# But that doesn't necessarily mean that the earlier one went okay
} else {
$enc_error = "Encoding is already set to " . $self->{'encoding'};
- DEBUG > 1 and print $enc_error;
+ DEBUG > 1 and print STDERR $enc_error;
}
} elsif (
# OK, let's turn on the encoding
do {
- DEBUG > 1 and print " Setting encoding to $e\n";
+ DEBUG > 1 and print STDERR " Setting encoding to $e\n";
$self->{'encoding'} = $e;
1;
}
and $e eq 'HACKRAW'
) {
- DEBUG and print " Putting in HACKRAW (no-op) encoding mode.\n";
+ DEBUG and print STDERR " Putting in HACKRAW (no-op) encoding mode.\n";
} elsif( Pod::Simple::Transcode::->encoding_is_available($e) ) {
@@ -361,7 +449,7 @@ sub _handle_encoding_line {
my @supported = Pod::Simple::Transcode::->all_encodings;
# Note unsupported, and complain
- DEBUG and print " Encoding [$e] is unsupported.",
+ DEBUG and print STDERR " Encoding [$e] is unsupported.",
"\nSupporteds: @supported\n";
my $suggestion = '';
@@ -406,7 +494,7 @@ sub _handle_encoding_second_level {
$content =~ s/^\s+//s;
$content =~ s/\s+$//s;
- DEBUG > 2 and print "Ogling encoding directive: =encoding $content\n";
+ DEBUG > 2 and print STDERR "Ogling encoding directive: =encoding $content\n";
if (defined($self->{'_processed_encoding'})) {
#if($content ne $self->{'_processed_encoding'}) {
@@ -415,7 +503,7 @@ sub _handle_encoding_second_level {
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";
+ DEBUG > 2 and print STDERR " CRAZY ERROR: It wasn't really handled?!\n";
} elsif( $self->{'encoding_command_statuses'}[-1] ) {
$self->whine( $para->[1]{'start_line'},
sprintf "Couldn't do %s: %s",
@@ -423,7 +511,7 @@ sub _handle_encoding_second_level {
$self->{'encoding_command_statuses'}[-1],
);
} else {
- DEBUG > 2 and print " (Yup, it was successfully handled already.)\n";
+ DEBUG > 2 and print STDERR " (Yup, it was successfully handled already.)\n";
}
} else {
@@ -480,7 +568,7 @@ sub _gen_errata {
['=back', {'start_line' => $m, 'errata' => 1}, ''],
;
- DEBUG and print "\n<<\n", pretty(\@out), "\n>>\n\n";
+ DEBUG and print STDERR "\n<<\n", pretty(\@out), "\n>>\n\n";
return @out;
}
@@ -526,7 +614,7 @@ sub _ponder_paragraph_buffer {
my $scratch;
- DEBUG > 10 and print "# Paragraph buffer: <<", pretty($paras), ">>\n";
+ DEBUG > 10 and print STDERR "# Paragraph buffer: <<", pretty($paras), ">>\n";
# We have something in our buffer. So apparently the document has started.
unless($self->{'doc_has_started'}) {
@@ -540,7 +628,7 @@ sub _ponder_paragraph_buffer {
# i.e., if the paras is all ~ends
)
;
- DEBUG and print "# Starting ",
+ DEBUG and print STDERR "# Starting ",
$starting_contentless ? 'contentless' : 'contentful',
" document\n"
;
@@ -572,7 +660,7 @@ sub _ponder_paragraph_buffer {
$para = shift @$paras;
$para_type = $para->[0];
- DEBUG > 1 and print "Pondering a $para_type paragraph, given the stack: (",
+ DEBUG > 1 and print STDERR "Pondering a $para_type paragraph, given the stack: (",
$self->_dump_curr_open(), ")\n";
if($para_type eq '=for') {
@@ -593,7 +681,7 @@ sub _ponder_paragraph_buffer {
#~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
if(grep $_->[1]{'~ignore'}, @$curr_open) {
DEBUG > 1 and
- print "Skipping $para_type paragraph because in ignore mode.\n";
+ print STDERR "Skipping $para_type paragraph because in ignore mode.\n";
next;
}
#~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
@@ -616,7 +704,7 @@ sub _ponder_paragraph_buffer {
# mean how it should get treated, not as what the element name
# should be.
- DEBUG > 1 and print "Pondering non-magical $para_type\n";
+ DEBUG > 1 and print STDERR "Pondering non-magical $para_type\n";
my $i;
@@ -626,7 +714,7 @@ sub _ponder_paragraph_buffer {
and @$curr_open
and $curr_open->[-1][0] eq '=over'
) {
- DEBUG > 2 and print "'=$para_type' inside an '=over'!\n";
+ DEBUG > 2 and print STDERR "'=$para_type' inside an '=over'!\n";
$self->whine(
$para->[1]{'start_line'},
"You forgot a '=back' before '$para_type'"
@@ -678,7 +766,7 @@ sub _ponder_paragraph_buffer {
} elsif($over_type eq 'text') {
my $item_type = $self->_get_item_type($para);
# That kills the content of the item if it's a number or bullet.
- DEBUG and print " Item is of type ", $para->[0], " under $over_type\n";
+ DEBUG and print STDERR " Item is of type ", $para->[0], " under $over_type\n";
if($item_type eq 'text') {
# Nothing special needs doing for 'text'
@@ -701,7 +789,7 @@ sub _ponder_paragraph_buffer {
} elsif($over_type eq 'number') {
my $item_type = $self->_get_item_type($para);
# That kills the content of the item if it's a number or bullet.
- DEBUG and print " Item is of type ", $para->[0], " under $over_type\n";
+ DEBUG and print STDERR " Item is of type ", $para->[0], " under $over_type\n";
my $expected_value = ++ $curr_open->[-1][1]{'~counter'};
@@ -728,10 +816,10 @@ sub _ponder_paragraph_buffer {
die "Unknown item type $item_type"; # should never happen
} elsif($expected_value == $para->[1]{'number'}) {
- DEBUG > 1 and print " Numeric item has the expected value of $expected_value\n";
+ DEBUG > 1 and print STDERR " Numeric item has the expected value of $expected_value\n";
} else {
- DEBUG > 1 and print " Numeric item has ", $para->[1]{'number'},
+ DEBUG > 1 and print STDERR " Numeric item has ", $para->[1]{'number'},
" instead of the expected value of $expected_value\n";
$self->whine(
$para->[1]{'start_line'},
@@ -744,10 +832,10 @@ sub _ponder_paragraph_buffer {
if(@$para == 2) {
# For the cases where we /didn't/ push to @$para
if($paras->[0][0] eq '~Para') {
- DEBUG and print "Assimilating following ~Para content into $over_type item\n";
+ DEBUG and print STDERR "Assimilating following ~Para content into $over_type item\n";
push @$para, splice @{shift @$paras},2;
} else {
- DEBUG and print "Can't assimilate following ", $paras->[0][0], "\n";
+ DEBUG and print STDERR "Can't assimilate following ", $paras->[0][0], "\n";
push @$para, ''; # Just so it's not contentless
}
}
@@ -756,13 +844,13 @@ sub _ponder_paragraph_buffer {
} elsif($over_type eq 'bullet') {
my $item_type = $self->_get_item_type($para);
# That kills the content of the item if it's a number or bullet.
- DEBUG and print " Item is of type ", $para->[0], " under $over_type\n";
+ DEBUG and print STDERR " Item is of type ", $para->[0], " under $over_type\n";
if($item_type eq 'bullet') {
# as expected!
if( $para->[1]{'~_freaky_para_hack'} ) {
- DEBUG and print "Accomodating '=item * Foo' tolerance hack.\n";
+ DEBUG and print STDERR "Accomodating '=item * Foo' tolerance hack.\n";
push @$para, delete $para->[1]{'~_freaky_para_hack'};
}
@@ -790,10 +878,10 @@ sub _ponder_paragraph_buffer {
if(@$para == 2) {
# For the cases where we /didn't/ push to @$para
if($paras->[0][0] eq '~Para') {
- DEBUG and print "Assimilating following ~Para content into $over_type item\n";
+ DEBUG and print STDERR "Assimilating following ~Para content into $over_type item\n";
push @$para, splice @{shift @$paras},2;
} else {
- DEBUG and print "Can't assimilate following ", $paras->[0][0], "\n";
+ DEBUG and print STDERR "Can't assimilate following ", $paras->[0][0], "\n";
push @$para, ''; # Just so it's not contentless
}
}
@@ -829,10 +917,10 @@ sub _ponder_paragraph_buffer {
} elsif( $para_type =~ s/^=//s
and defined( $para_type = $self->{'accept_directives'}{$para_type} )
) {
- DEBUG > 1 and print " Pondering known directive ${$para}[0] as $para_type\n";
+ DEBUG > 1 and print STDERR " Pondering known directive ${$para}[0] as $para_type\n";
} else {
# An unknown directive!
- DEBUG > 1 and printf "Unhandled directive %s (Handled: %s)\n",
+ DEBUG > 1 and printf STDERR "Unhandled directive %s (Handled: %s)\n",
$para->[0], join(' ', sort keys %{$self->{'accept_directives'}} )
;
$self->whine(
@@ -846,14 +934,14 @@ sub _ponder_paragraph_buffer {
if($para_type =~ s/^\?//s) {
if(! @$curr_open) { # usual case
- DEBUG and print "Treating $para_type paragraph as such because stack is empty.\n";
+ DEBUG and print STDERR "Treating $para_type paragraph as such because stack is empty.\n";
} else {
my @fors = grep $_->[0] eq '=for', @$curr_open;
- DEBUG > 1 and print "Containing fors: ",
+ DEBUG > 1 and print STDERR "Containing fors: ",
join(',', map $_->[1]{'target'}, @fors), "\n";
if(! @fors) {
- DEBUG and print "Treating $para_type paragraph as such because stack has no =for's\n";
+ DEBUG and print STDERR "Treating $para_type paragraph as such because stack has no =for's\n";
#} elsif(grep $_->[1]{'~resolve'}, @fors) {
#} elsif(not grep !$_->[1]{'~resolve'}, @fors) {
@@ -861,14 +949,14 @@ sub _ponder_paragraph_buffer {
# Look to the immediately containing for
if($para_type eq 'Data') {
- DEBUG and print "Treating Data paragraph as Plain/Verbatim because the containing =for ($fors[-1][1]{'target'}) is a resolver\n";
+ DEBUG and print STDERR "Treating Data paragraph as Plain/Verbatim because the containing =for ($fors[-1][1]{'target'}) is a resolver\n";
$para->[0] = 'Para';
$para_type = 'Plain';
} else {
- DEBUG and print "Treating $para_type paragraph as such because the containing =for ($fors[-1][1]{'target'}) is a resolver\n";
+ DEBUG and print STDERR "Treating $para_type paragraph as such because the containing =for ($fors[-1][1]{'target'}) is a resolver\n";
}
} else {
- DEBUG and print "Treating $para_type paragraph as Data because the containing =for ($fors[-1][1]{'target'}) is a non-resolver\n";
+ DEBUG and print STDERR "Treating $para_type paragraph as Data because the containing =for ($fors[-1][1]{'target'}) is a non-resolver\n";
$para->[0] = $para_type = 'Data';
}
}
@@ -889,7 +977,7 @@ sub _ponder_paragraph_buffer {
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
$para->[0] =~ s/^[~=]//s;
- DEBUG and print "\n", pretty($para), "\n";
+ DEBUG and print STDERR "\n", pretty($para), "\n";
# traverse the treelet (which might well be just one string scalar)
$self->{'content_seen'} ||= 1;
@@ -912,7 +1000,7 @@ sub _ponder_for {
my $target;
if(grep $_->[1]{'~ignore'}, @$curr_open) {
- DEBUG > 1 and print "Ignoring ignorable =for\n";
+ DEBUG > 1 and print STDERR "Ignoring ignorable =for\n";
return 1;
}
@@ -930,7 +1018,7 @@ sub _ponder_for {
return 1;
}
DEBUG > 1 and
- print "Faking out a =for $target as a =begin $target / =end $target\n";
+ print STDERR "Faking out a =for $target as a =begin $target / =end $target\n";
$para->[0] = 'Data';
@@ -959,7 +1047,7 @@ sub _ponder_begin {
$para->[1]{'start_line'},
"=begin without a target?"
);
- DEBUG and print "Ignoring targetless =begin\n";
+ DEBUG and print STDERR "Ignoring targetless =begin\n";
return 1;
}
@@ -981,11 +1069,11 @@ sub _ponder_begin {
$neg ? () : '*'
) {
DEBUG > 2 and
- print " Considering whether =begin $content matches $target_name\n";
+ print STDERR " Considering whether =begin $content matches $target_name\n";
next unless $self->{'accept_targets'}{$target_name};
DEBUG > 2 and
- print " It DOES match the acceptable target $target_name!\n";
+ print STDERR " It DOES match the acceptable target $target_name!\n";
$to_resolve = 1
if $self->{'accept_targets'}{$target_name} eq 'force_resolve';
$dont_ignore = 1;
@@ -997,11 +1085,11 @@ sub _ponder_begin {
if( $dont_ignore ) {
$dont_ignore = '';
delete $para->[1]{'target_matching'};
- DEBUG > 2 and print " But the leading ! means that this is a NON-match!\n";
+ DEBUG > 2 and print STDERR " But the leading ! means that this is a NON-match!\n";
} else {
$dont_ignore = 1;
$para->[1]{'target_matching'} = '!';
- DEBUG > 2 and print " But the leading ! means that this IS a match!\n";
+ DEBUG > 2 and print STDERR " But the leading ! means that this IS a match!\n";
}
}
@@ -1010,15 +1098,15 @@ sub _ponder_begin {
$para->[1]{'~ignore'} = (! $dont_ignore) || 0;
$para->[1]{'~resolve'} = $to_resolve || 0;
- DEBUG > 1 and print " Making note to ", $dont_ignore ? 'not ' : '',
+ DEBUG > 1 and print STDERR " Making note to ", $dont_ignore ? 'not ' : '',
"ignore contents of this region\n";
- DEBUG > 1 and $dont_ignore and print " Making note to treat contents as ",
+ DEBUG > 1 and $dont_ignore and print STDERR " Making note to treat contents as ",
($to_resolve ? 'verbatim/plain' : 'data'), " paragraphs\n";
- DEBUG > 1 and print " (Stack now: ", $self->_dump_curr_open(), ")\n";
+ DEBUG > 1 and print STDERR " (Stack now: ", $self->_dump_curr_open(), ")\n";
push @$curr_open, $para;
if(!$dont_ignore or scalar grep $_->[1]{'~ignore'}, @$curr_open) {
- DEBUG > 1 and print "Ignoring ignorable =begin\n";
+ DEBUG > 1 and print STDERR "Ignoring ignorable =begin\n";
} else {
$self->{'content_seen'} ||= 1;
$self->_handle_element_start((my $scratch='for'), $para->[1]);
@@ -1032,7 +1120,7 @@ sub _ponder_end {
my $content = join ' ', splice @$para, 2;
$content =~ s/^\s+//s;
$content =~ s/\s+$//s;
- DEBUG and print "Ogling '=end $content' directive\n";
+ DEBUG and print STDERR "Ogling '=end $content' directive\n";
unless(length($content)) {
$self->whine(
@@ -1043,7 +1131,7 @@ sub _ponder_end {
: ''
)
);
- DEBUG and print "Ignoring targetless =end\n";
+ DEBUG and print STDERR "Ignoring targetless =end\n";
return 1;
}
@@ -1053,7 +1141,7 @@ sub _ponder_end {
"'=end $content' is invalid. (Stack: "
. $self->_dump_curr_open() . ')'
);
- DEBUG and print "Ignoring mistargetted =end $content\n";
+ DEBUG and print STDERR "Ignoring mistargetted =end $content\n";
return 1;
}
@@ -1063,7 +1151,7 @@ sub _ponder_end {
"=end $content without matching =begin. (Stack: "
. $self->_dump_curr_open() . ')'
);
- DEBUG and print "Ignoring mistargetted =end $content\n";
+ DEBUG and print STDERR "Ignoring mistargetted =end $content\n";
return 1;
}
@@ -1075,13 +1163,13 @@ sub _ponder_end {
. ". (Stack: "
. $self->_dump_curr_open() . ')'
);
- DEBUG and print "Ignoring mistargetted =end $content at line $para->[1]{'start_line'}\n";
+ DEBUG and print STDERR "Ignoring mistargetted =end $content at line $para->[1]{'start_line'}\n";
return 1;
}
# Else it's okay to close...
if(grep $_->[1]{'~ignore'}, @$curr_open) {
- DEBUG > 1 and print "Not firing any event for this =end $content because in an ignored region\n";
+ DEBUG > 1 and print STDERR "Not firing any event for this =end $content because in an ignored region\n";
# And that may be because of this to-be-closed =for region, or some
# other one, but it doesn't matter.
} else {
@@ -1091,7 +1179,7 @@ sub _ponder_end {
$self->{'content_seen'} ||= 1;
$self->_handle_element_end( my $scratch = 'for', $para->[1]);
}
- DEBUG > 1 and print "Popping $curr_open->[-1][0] $curr_open->[-1][1]{'target'} because of =end $content\n";
+ DEBUG > 1 and print STDERR "Popping $curr_open->[-1][0] $curr_open->[-1][1]{'target'} because of =end $content\n";
pop @$curr_open;
return 1;
@@ -1100,10 +1188,10 @@ sub _ponder_end {
sub _ponder_doc_end {
my ($self,$para,$curr_open,$paras) = @_;
if(@$curr_open) { # Deal with things left open
- DEBUG and print "Stack is nonempty at end-document: (",
+ DEBUG and print STDERR "Stack is nonempty at end-document: (",
$self->_dump_curr_open(), ")\n";
- DEBUG > 9 and print "Stack: ", pretty($curr_open), "\n";
+ DEBUG > 9 and print STDERR "Stack: ", pretty($curr_open), "\n";
unshift @$paras, $self->_closers_for_all_curr_open;
# Make sure there is exactly one ~end in the parastack, at the end:
@$paras = grep $_->[0] ne '~end', @$paras;
@@ -1114,7 +1202,7 @@ sub _ponder_doc_end {
return 1;
} else {
- DEBUG and print "Okay, stack is empty now.\n";
+ DEBUG and print STDERR "Okay, stack is empty now.\n";
}
# Try generating errata section, if applicable
@@ -1123,13 +1211,13 @@ sub _ponder_doc_end {
my @extras = $self->_gen_errata();
if(@extras) {
unshift @$paras, @extras;
- DEBUG and print "Generated errata... relooping...\n";
+ DEBUG and print STDERR "Generated errata... relooping...\n";
return 1; # I.e., loop around again to process these fake-o paragraphs
}
}
splice @$paras; # Well, that's that for this paragraph buffer.
- DEBUG and print "Throwing end-document event.\n";
+ DEBUG and print STDERR "Throwing end-document event.\n";
$self->_handle_element_end( my $scratch = 'Document' );
return 1; # Hasta la byebye
@@ -1207,7 +1295,7 @@ sub _ponder_over {
);
$para->[1]{'indent'} = 4;
}
- DEBUG > 1 and print "=over found of type $list_type\n";
+ DEBUG > 1 and print STDERR "=over found of type $list_type\n";
$self->{'content_seen'} ||= 1;
$self->_handle_element_start((my $scratch = 'over-' . $list_type), $para->[1]);
@@ -1228,7 +1316,7 @@ sub _ponder_back {
}
if(@$curr_open and $curr_open->[-1][0] eq '=over') {
- DEBUG > 1 and print "=back happily closes matching =over\n";
+ DEBUG > 1 and print STDERR "=back happily closes matching =over\n";
# Expected case: we're closing the most recently opened thing
#my $over = pop @$curr_open;
$self->{'content_seen'} ||= 1;
@@ -1236,7 +1324,7 @@ sub _ponder_back {
'over-' . ( (pop @$curr_open)->[1]{'~type'} ), $para->[1]
);
} else {
- DEBUG > 1 and print "=back found without a matching =over. Stack: (",
+ DEBUG > 1 and print STDERR "=back found without a matching =over. Stack: (",
join(', ', map $_->[0], @$curr_open), ").\n";
$self->whine(
$para->[1]{'start_line'},
@@ -1288,7 +1376,7 @@ sub _ponder_item {
} elsif($over_type eq 'text') {
my $item_type = $self->_get_item_type($para);
# That kills the content of the item if it's a number or bullet.
- DEBUG and print " Item is of type ", $para->[0], " under $over_type\n";
+ DEBUG and print STDERR " Item is of type ", $para->[0], " under $over_type\n";
if($item_type eq 'text') {
# Nothing special needs doing for 'text'
@@ -1311,7 +1399,7 @@ sub _ponder_item {
} elsif($over_type eq 'number') {
my $item_type = $self->_get_item_type($para);
# That kills the content of the item if it's a number or bullet.
- DEBUG and print " Item is of type ", $para->[0], " under $over_type\n";
+ DEBUG and print STDERR " Item is of type ", $para->[0], " under $over_type\n";
my $expected_value = ++ $curr_open->[-1][1]{'~counter'};
@@ -1338,10 +1426,10 @@ sub _ponder_item {
die "Unknown item type $item_type"; # should never happen
} elsif($expected_value == $para->[1]{'number'}) {
- DEBUG > 1 and print " Numeric item has the expected value of $expected_value\n";
+ DEBUG > 1 and print STDERR " Numeric item has the expected value of $expected_value\n";
} else {
- DEBUG > 1 and print " Numeric item has ", $para->[1]{'number'},
+ DEBUG > 1 and print STDERR " Numeric item has ", $para->[1]{'number'},
" instead of the expected value of $expected_value\n";
$self->whine(
$para->[1]{'start_line'},
@@ -1354,10 +1442,10 @@ sub _ponder_item {
if(@$para == 2) {
# For the cases where we /didn't/ push to @$para
if($paras->[0][0] eq '~Para') {
- DEBUG and print "Assimilating following ~Para content into $over_type item\n";
+ DEBUG and print STDERR "Assimilating following ~Para content into $over_type item\n";
push @$para, splice @{shift @$paras},2;
} else {
- DEBUG and print "Can't assimilate following ", $paras->[0][0], "\n";
+ DEBUG and print STDERR "Can't assimilate following ", $paras->[0][0], "\n";
push @$para, ''; # Just so it's not contentless
}
}
@@ -1366,13 +1454,13 @@ sub _ponder_item {
} elsif($over_type eq 'bullet') {
my $item_type = $self->_get_item_type($para);
# That kills the content of the item if it's a number or bullet.
- DEBUG and print " Item is of type ", $para->[0], " under $over_type\n";
+ DEBUG and print STDERR " Item is of type ", $para->[0], " under $over_type\n";
if($item_type eq 'bullet') {
# as expected!
if( $para->[1]{'~_freaky_para_hack'} ) {
- DEBUG and print "Accomodating '=item * Foo' tolerance hack.\n";
+ DEBUG and print STDERR "Accomodating '=item * Foo' tolerance hack.\n";
push @$para, delete $para->[1]{'~_freaky_para_hack'};
}
@@ -1400,10 +1488,10 @@ sub _ponder_item {
if(@$para == 2) {
# For the cases where we /didn't/ push to @$para
if($paras->[0][0] eq '~Para') {
- DEBUG and print "Assimilating following ~Para content into $over_type item\n";
+ DEBUG and print STDERR "Assimilating following ~Para content into $over_type item\n";
push @$para, splice @{shift @$paras},2;
} else {
- DEBUG and print "Can't assimilate following ", $paras->[0][0], "\n";
+ DEBUG and print STDERR "Can't assimilate following ", $paras->[0][0], "\n";
push @$para, ''; # Just so it's not contentless
}
}
@@ -1419,7 +1507,7 @@ sub _ponder_item {
sub _ponder_Plain {
my ($self,$para) = @_;
- DEBUG and print " giving plain treatment...\n";
+ DEBUG and print STDERR " giving plain treatment...\n";
unless( @$para == 2 or ( @$para == 3 and $para->[2] eq '' )
or $para->[1]{'~cooked'}
) {
@@ -1436,7 +1524,7 @@ sub _ponder_Plain {
sub _ponder_Verbatim {
my ($self,$para) = @_;
- DEBUG and print " giving verbatim treatment...\n";
+ DEBUG and print STDERR " giving verbatim treatment...\n";
$para->[1]{'xml:space'} = 'preserve';
@@ -1487,7 +1575,7 @@ sub _ponder_Verbatim {
sub _ponder_Data {
my ($self,$para) = @_;
- DEBUG and print " giving data treatment...\n";
+ DEBUG and print STDERR " giving data treatment...\n";
$para->[1]{'xml:space'} = 'preserve';
push @$para, join "\n", splice(@$para, 2) if @$para > 3;
return;
@@ -1548,7 +1636,7 @@ sub _closers_for_all_curr_open {
$copy[1]{'fake-closer'} = 1;
- DEBUG and print "Queuing up fake-o event: ", pretty(\@copy), "\n";
+ DEBUG and print STDERR "Queuing up fake-o event: ", pretty(\@copy), "\n";
unshift @closers, \@copy;
}
return @closers;
@@ -1562,7 +1650,7 @@ sub _verbatim_format {
my $formatting;
for(my $i = 2; $i < @$p; $i++) { # work backwards over the lines
- DEBUG and print "_verbatim_format appends a newline to $i: $p->[$i]\n";
+ DEBUG and print STDERR "_verbatim_format appends a newline to $i: $p->[$i]\n";
$p->[$i] .= "\n";
# Unlike with simple Verbatim blocks, we don't end up just doing
# a join("\n", ...) on the contents, so we have to append a
@@ -1570,11 +1658,11 @@ sub _verbatim_format {
}
if( DEBUG > 4 ) {
- print "<<\n";
+ print STDERR "<<\n";
for(my $i = $#$p; $i >= 2; $i--) { # work backwards over the lines
- print "_verbatim_format $i: $p->[$i]";
+ print STDERR "_verbatim_format $i: $p->[$i]";
}
- print ">>\n";
+ print STDERR ">>\n";
}
for(my $i = $#$p; $i > 2; $i--) {
@@ -1583,19 +1671,19 @@ sub _verbatim_format {
#next unless $p->[$i] =~ m{^#:([ \^\/\%]*)\n?$}s
# and $p->[$i-1] !~ m{^#:[ \^\/\%]*\n?$}s;
# look at a formatty line preceding a nonformatty one
- DEBUG > 5 and print "Scrutinizing line $i: $$p[$i]\n";
+ DEBUG > 5 and print STDERR "Scrutinizing line $i: $$p[$i]\n";
if($p->[$i] =~ m{^#:([ \^\/\%]*)\n?$}s) {
- DEBUG > 5 and print " It's a formatty line. ",
+ DEBUG > 5 and print STDERR " It's a formatty line. ",
"Peeking at previous line ", $i-1, ": $$p[$i-1]: \n";
if( $p->[$i-1] =~ m{^#:[ \^\/\%]*\n?$}s ) {
- DEBUG > 5 and print " Previous line is formatty! Skipping this one.\n";
+ DEBUG > 5 and print STDERR " Previous line is formatty! Skipping this one.\n";
next;
} else {
- DEBUG > 5 and print " Previous line is non-formatty! Yay!\n";
+ DEBUG > 5 and print STDERR " Previous line is non-formatty! Yay!\n";
}
} else {
- DEBUG > 5 and print " It's not a formatty line. Ignoring\n";
+ DEBUG > 5 and print STDERR " It's not a formatty line. Ignoring\n";
next;
}
@@ -1606,7 +1694,7 @@ sub _verbatim_format {
# #:^^^^^^^^^^^^^^^^^ /////////////
- DEBUG > 4 and print "_verbatim_format considers:\n<$p->[$i-1]>\n<$p->[$i]>\n";
+ DEBUG > 4 and print STDERR "_verbatim_format considers:\n<$p->[$i-1]>\n<$p->[$i]>\n";
$formatting = ' ' . $1;
$formatting =~ s/\s+$//s; # nix trailing whitespace
@@ -1624,19 +1712,19 @@ sub _verbatim_format {
# Make $formatting and the previous line be exactly the same length,
# with $formatting having a " " as the last character.
- DEBUG > 4 and print "Formatting <$formatting> on <", $p->[$i-1], ">\n";
+ DEBUG > 4 and print STDERR "Formatting <$formatting> on <", $p->[$i-1], ">\n";
my @new_line;
while( $formatting =~ m{\G(( +)|(\^+)|(\/+)|(\%+))}g ) {
- #print "Format matches $1\n";
+ #print STDERR "Format matches $1\n";
if($2) {
- #print "SKIPPING <$2>\n";
+ #print STDERR "SKIPPING <$2>\n";
push @new_line,
substr($p->[$i-1], pos($formatting)-length($1), length($1));
} else {
- #print "SNARING $+\n";
+ #print STDERR "SNARING $+\n";
push @new_line, [
(
$3 ? 'VerbatimB' :
@@ -1645,14 +1733,14 @@ sub _verbatim_format {
), {},
substr($p->[$i-1], pos($formatting)-length($1), length($1))
];
- #print "Formatting <$new_line[-1][-1]> as $new_line[-1][0]\n";
+ #print STDERR "Formatting <$new_line[-1][-1]> as $new_line[-1][0]\n";
}
}
my @nixed =
splice @$p, $i-1, 2, @new_line; # replace myself and the next line
- DEBUG > 10 and print "Nixed count: ", scalar(@nixed), "\n";
+ DEBUG > 10 and print STDERR "Nixed count: ", scalar(@nixed), "\n";
- DEBUG > 6 and print "New version of the above line is these tokens (",
+ DEBUG > 6 and print STDERR "New version of the above line is these tokens (",
scalar(@new_line), "):",
map( ref($_)?"<@$_> ":"<$_>", @new_line ), "\n";
$i--; # So the next line we scrutinize is the line before the one
@@ -1664,7 +1752,7 @@ sub _verbatim_format {
# Collapse adjacent text nodes, just for kicks.
for( my $i = 2; $i > $#$p; $i++ ) { # work forwards over the tokens except for the last
if( !ref($p->[$i]) and !ref($p->[$i + 1]) ) {
- DEBUG > 5 and print "_verbatim_format merges {$p->[$i]} and {$p->[$i+1]}\n";
+ DEBUG > 5 and print STDERR "_verbatim_format merges {$p->[$i]} and {$p->[$i+1]}\n";
$p->[$i] .= splice @$p, $i+1, 1; # merge
--$i; # and back up
}
@@ -1675,9 +1763,9 @@ sub _verbatim_format {
# work backwards over the tokens, even the first
if( !ref($p->[$i]) ) {
if($p->[$i] =~ s/\n$//s) {
- DEBUG > 5 and print "_verbatim_format killed the terminal newline on #$i: {$p->[$i]}, after {$p->[$i-1]}\n";
+ DEBUG > 5 and print STDERR "_verbatim_format killed the terminal newline on #$i: {$p->[$i]}, after {$p->[$i-1]}\n";
} else {
- DEBUG > 5 and print
+ DEBUG > 5 and print STDERR
"No terminal newline on #$i: {$p->[$i]}, after {$p->[$i-1]} !?\n";
}
last; # we only want the next one
@@ -1719,7 +1807,7 @@ sub _treelet_from_formatting_codes {
# into just 1 ' '. Is this the regex's doing or 'raw's?
my $inL = 0;
- DEBUG > 4 and print "Paragraph:\n$para\n\n";
+ DEBUG > 4 and print STDERR "Paragraph:\n$para\n\n";
# Here begins our frightening tokenizer RE. The following regex matches
# text in four main parts:
@@ -1777,14 +1865,14 @@ sub _treelet_from_formatting_codes {
)
/xgo
) {
- DEBUG > 4 and print "\nParagraphic tokenstack = (@stack)\n";
+ DEBUG > 4 and print STDERR "\nParagraphic tokenstack = (@stack)\n";
if(defined $1) {
if(defined $2) {
- DEBUG > 3 and print "Found complex start-text code \"$1\"\n";
+ DEBUG > 3 and print STDERR "Found complex start-text code \"$1\"\n";
push @stack, length($2) + 1;
# length of the necessary complex end-code string
} else {
- DEBUG > 3 and print "Found simple start-text code \"$1\"\n";
+ DEBUG > 3 and print STDERR "Found simple start-text code \"$1\"\n";
push @stack, 0; # signal that we're looking for simple
}
push @lineage, [ substr($1,0,1), {}, ]; # new node object
@@ -1797,32 +1885,32 @@ sub _treelet_from_formatting_codes {
}
} elsif(defined $4) {
- DEBUG > 3 and print "Found apparent complex end-text code \"$3$4\"\n";
+ DEBUG > 3 and print STDERR "Found apparent complex end-text code \"$3$4\"\n";
# This is where it gets messy...
if(! @stack) {
# We saw " >>>>" but needed nothing. This is ALL just stuff then.
- DEBUG > 4 and print " But it's really just stuff.\n";
+ DEBUG > 4 and print STDERR " But it's really just stuff.\n";
push @{ $lineage[-1] }, $3, $4;
next;
} elsif(!$stack[-1]) {
# We saw " >>>>" but needed only ">". Back pos up.
- DEBUG > 4 and print " And that's more than we needed to close simple.\n";
+ DEBUG > 4 and print STDERR " And that's more than we needed to close simple.\n";
push @{ $lineage[-1] }, $3; # That was a for-real space, too.
pos($para) = pos($para) - length($4) + 1;
} elsif($stack[-1] == length($4)) {
# We found " >>>>", and it was exactly what we needed. Commonest case.
- DEBUG > 4 and print " And that's exactly what we needed to close complex.\n";
+ DEBUG > 4 and print STDERR " And that's exactly what we needed to close complex.\n";
} elsif($stack[-1] < length($4)) {
# We saw " >>>>" but needed only " >>". Back pos up.
- DEBUG > 4 and print " And that's more than we needed to close complex.\n";
+ DEBUG > 4 and print STDERR " And that's more than we needed to close complex.\n";
pos($para) = pos($para) - length($4) + $stack[-1];
} else {
# We saw " >>>>" but needed " >>>>>>". So this is all just stuff!
- DEBUG > 4 and print " But it's really just stuff, because we needed more.\n";
+ DEBUG > 4 and print STDERR " But it's really just stuff, because we needed more.\n";
push @{ $lineage[-1] }, $3, $4;
next;
}
- #print "\nHOOBOY ", scalar(@{$lineage[-1]}), "!!!\n";
+ #print STDERR "\nHOOBOY ", scalar(@{$lineage[-1]}), "!!!\n";
push @{ $lineage[-1] }, '' if 2 == @{ $lineage[-1] };
# Keep the element from being childless
@@ -1839,11 +1927,11 @@ sub _treelet_from_formatting_codes {
$raw .= $3.$4 if $inL;
} elsif(defined $5) {
- DEBUG > 3 and print "Found apparent simple end-text code \"$5\"\n";
+ DEBUG > 3 and print STDERR "Found apparent simple end-text code \"$5\"\n";
if(@stack and ! $stack[-1]) {
# We're indeed expecting a simple end-code
- DEBUG > 4 and print " It's indeed an end-code.\n";
+ DEBUG > 4 and print STDERR " It's indeed an end-code.\n";
if(length($5) == 2) { # There was a space there: " >"
push @{ $lineage[-1] }, ' ';
@@ -1854,7 +1942,7 @@ sub _treelet_from_formatting_codes {
pop @stack;
pop @lineage;
} else {
- DEBUG > 4 and print " It's just stuff.\n";
+ DEBUG > 4 and print STDERR " It's just stuff.\n";
push @{ $lineage[-1] }, $5;
}
@@ -1867,7 +1955,7 @@ sub _treelet_from_formatting_codes {
$raw .= $5 if $inL;
} elsif(defined $6) {
- DEBUG > 3 and print "Found stuff \"$6\"\n";
+ DEBUG > 3 and print STDERR "Found stuff \"$6\"\n";
push @{ $lineage[-1] }, $6;
$raw .= $6 if $inL;
# XXX does not capture multiplace whitespaces -- 'raw' ends up with
@@ -1875,7 +1963,7 @@ sub _treelet_from_formatting_codes {
} else {
# should never ever ever ever happen
- DEBUG and print "AYYAYAAAAA at line ", __LINE__, "\n";
+ DEBUG and print STDERR "AYYAYAAAAA at line ", __LINE__, "\n";
die "SPORK 512512!";
}
}
@@ -1895,7 +1983,7 @@ sub _treelet_from_formatting_codes {
$x = $code . "<$x>";
}
}
- DEBUG > 1 and print "Unterminated $x sequence\n";
+ DEBUG > 1 and print STDERR "Unterminated $x sequence\n";
$self->whine($start_line,
"Unterminated $x sequence",
);
@@ -2023,7 +2111,7 @@ sub reinit {
my $self = shift;
foreach (qw(source_dead source_filename doc_has_started
start_of_pod_block content_seen last_was_blank paras curr_open
-line_count pod_para_count in_pod ~tried_gen_errata errata errors_seen
+line_count pod_para_count in_pod ~tried_gen_errata all_errata errata errors_seen
Title)) {
delete $self->{$_};