"miyagawa@gmail.com via RT" <bug-Test-Synopsis@rt.cpan.org> writes:
Show quoted text>
> Can you provide a patch?
I got to the few lines below. It seems a slightly big chunk of code for
a little parse, but should do things like cooperate with unrelated
=for/=begin directives in ways that would be hard with just regexps.
diff --git a/lib/Test/Synopsis.pm b/lib/Test/Synopsis.pm
index fedeacd..eb1495d 100644
--- a/lib/Test/Synopsis.pm
+++ b/lib/Test/Synopsis.pm
@@ -42,16 +42,72 @@ sub _compile {
sub extract_synopsis {
my $file = shift;
- my $content = do {
- local $/;
- open my $fh, "<", $file or die "$file: $!";
- <$fh>;
- };
+ my $parser = Test::Synopsis::Parser->new;
+ $parser->parse_from_file ($file);
+ return ($parser->{'test_synopsis'},
+ $parser->{'test_synopsis_linenum'},
+ @{$parser->{'test_synopsis_options'}});
+}
+
- my $code = ($content =~ m/^=head1\s+SYNOPSIS(.+?)^=head1/ms)[0];
- my $line = ($` || '') =~ tr/\n/\n/;
+package Test::Synopsis::Parser;
+use base 'Pod::Parser';
- return $code, $line-1, ($content =~ m/^=for\s+test_synopsis\s+(.+?)^=/msg);
+sub new {
+ my $class = shift;
+ return $class->SUPER::new (@_,
+ within_begin => '',
+ test_synopsis_options => []);
+}
+sub command {
+ my $self = shift;
+ my ($command, $text, $linenum, $paraobj) = @_;
+ ## print "command: '$command' -- '$text'\n";
+
+ if ($command eq 'for') {
+ if ($text =~ /^test_synopsis\s+(.*)/s) {
+ push @{$self->{'test_synopsis_options'}}, $1;
+ }
+ } elsif ($command eq 'begin') {
+ $self->{'within_begin'} = $text;
+ } elsif ($command eq 'end') {
+ $self->{'within_begin'} = '';
+ } elsif ($command eq 'pod') {
+ # resuming pod, retain begin/end/synopsis state
+ } else {
+ # Synopsis is "=head1 SYNOPSIS" through to next command other than
+ # the above "=for", "=begin", "=end", "=pod". This means
+ # * "=for" directives for other programs are skipped
+ # (eg. HTML::Scrubber)
+ # * "=begin" to "=end" for other program are skipped
+ # (eg. Date::Simple)
+ # * "=cut" to "=pod" actual code is skipped (perhaps unlikely in
+ # practice)
+ #
+ # Could think about not stopping at "=head2" etc subsections of a
+ # synopsis, but a synopsis with subsections usually means different
+ # sample bits meant for different places and so probably won't
+ # actually run.
+ #
+ $self->{'within_synopsis'}
+ = ($command eq 'head1' && $text =~ /^SYNOPSIS\s*$/);
+ }
+ return '';
+}
+sub verbatim {
+ my ($self, $text, $linenum, $paraobj) = @_;
+ if ($self->{'within_begin'} =~ /^test_synopsis\b/) {
+ push @{$self->{'test_synopsis_options'}}, $text;
+
+ } elsif ($self->{'within_synopsis'} && ! $self->{'within_begin'}) {
+ $self->{'test_synopsis_linenum'} ||= $linenum; # first occurance
+ $self->{'test_synopsis'} .= $text;
+ }
+ return '';
+}
+sub textblock {
+ # ignore text paragraphs, only take "verbatim" blocks to be code
+ return '';
}
1;
