From 34bcefd09797a3605c4f0aff1c6b5b20fd5a0bcd Mon Sep 17 00:00:00 2001 From: Marc Green Date: Sat, 13 Aug 2011 20:50:26 -0400 Subject: [PATCH] Implement 'whiteline_handler' attribute. It is much like 'code_handler', 'cut_handler', and 'pod_handler', except it is triggered on white lines. White lines are defined as seemingly blank lines that match /[\t ]/. Included is the updated code, documentation, and test cases. --- lib/Pod/Simple.pm | 7 ++++--- lib/Pod/Simple/BlackBox.pm | 8 +++++++- lib/Pod/Simple/Subclassing.pod | 8 ++++++++ t/cbacks.t | 25 +++++++++++++++---------- 4 files changed, 34 insertions(+), 14 deletions(-) diff --git a/lib/Pod/Simple.pm b/lib/Pod/Simple.pm index fbe0305d..f737b669 100644 --- a/lib/Pod/Simple.pm +++ b/lib/Pod/Simple.pm @@ -93,13 +93,14 @@ __PACKAGE__->_accessorize( 'codes_in_verbatim', # for PseudoPod extensions 'code_handler', # coderef to call when a code (non-pod) line is seen - 'cut_handler', # coderef to call when a =cut line is seen - 'pod_handler', # coderef to call when a =pod line is seen + 'cut_handler', # ... when a =cut line is seen + 'pod_handler', # ... when a =pod line is seen + 'whiteline_handler', # ... when a line with only whitespace is seen #Called like: # $code_handler->($line, $self->{'line_count'}, $self) if $code_handler; # $cut_handler->($line, $self->{'line_count'}, $self) if $cut_handler; # $pod_handler->($line, $self->{'line_count'}, $self) if $pod_handler; - + # $wl_handler->($line, $self->{'line_count'}, $self) if $wl_handler; 'parse_empty_lists', # whether to acknowledge empty =over/=back blocks ); diff --git a/lib/Pod/Simple/BlackBox.pm b/lib/Pod/Simple/BlackBox.pm index 4b4b0866..5e9e8335 100644 --- a/lib/Pod/Simple/BlackBox.pm +++ b/lib/Pod/Simple/BlackBox.pm @@ -42,6 +42,7 @@ sub parse_lines { # Usage: $parser->parse_lines(@lines) my $code_handler = $self->{'code_handler'}; my $cut_handler = $self->{'cut_handler'}; + my $wl_handler = $self->{'whiteline_handler'}; $self->{'line_count'} ||= 0; my $scratch; @@ -191,7 +192,12 @@ sub parse_lines { # Usage: $parser->parse_lines(@lines) # TODO: add to docs: Note: this may cause cuts to be processed out # of order relative to pods, but in order relative to code. - } elsif($line =~ m/^\s*$/s) { # it's a blank line + } elsif($line =~ m/^(\s*)$/s) { # it's a blank line + if (defined $1 and $1 =~ /[\t ]/) { # it's a white line + $wl_handler->(map $_, $line, $self->{'line_count'}, $self) + if $wl_handler; + } + 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"; push @{$paras->[-1]}, $line; diff --git a/lib/Pod/Simple/Subclassing.pod b/lib/Pod/Simple/Subclassing.pod index f4cbf867..997ec071 100644 --- a/lib/Pod/Simple/Subclassing.pod +++ b/lib/Pod/Simple/Subclassing.pod @@ -826,6 +826,14 @@ This is just like the code_handler attribute, except that it's for unlikely to be interesting, but this is included for completeness. +=item C<< $parser->whiteline_handler( I ) >> + +This is just like the code_handler attribute, except that it's for +lines that are seemingly blank but have whitespace (" " and/or "\t") on them, +not code lines. The same caveats apply. These lines are unlikely to be +interesting, but this is included for completeness. + + =item C<< $parser->whine( I, I ) >> This notes a problem in the Pod, which will be reported to in the "Pod diff --git a/t/cbacks.t b/t/cbacks.t index 4e0700cc..1d639bbf 100644 --- a/t/cbacks.t +++ b/t/cbacks.t @@ -43,18 +43,20 @@ while(@from) { sub { $_[0]->code_handler(sub { $more .= $_[1] . ":" . $_[0] . "\n" } ); $_[0]->cut_handler( sub { $more .= "~" . $_[1] . ":" . $_[0]. "\n" } ); - $_[0]->pod_handler( sub { $more .= "~" . $_[1] . ":" . $_[0]. "\n" } ); + $_[0]->pod_handler( sub { $more .= "+" . $_[1] . ":" . $_[0]. "\n" } ); + $_[0]->whiteline_handler( + sub { $more .= "=" . $_[1] . ":" . $_[0]. "\n" } ); } => join "\n", - "", + " ", # space outside pod "\t# This is handy...", "=pod text", - "", + "\t", # tab inside pod "=cut more text", - "", + "\t", # tab outside pod "=pod", - "", + " \t ", # spaces and tabs inside pod "=head1 I LIKE PIE", - "", + " ", # space inside pod "=cut", "use Test::Harness;", "runtests(sort glob 't/*.t');", @@ -69,12 +71,15 @@ while(@from) { } ok scalar($got = $more), scalar($exp = join "\n" => - "1:", + "1: ", "2:\t# This is handy...", - "~3:=pod text", + "=4:\t", + "+3:=pod text", "~5:=cut more text", - "6:", - "~7:=pod", + "6:\t", + "=8: \t ", + "+7:=pod", + "=10: ", "~11:=cut", "12:use Test::Harness;", "13:runtests(sort glob 't/*.t');",