[gimp-perl] Deeper ->section[s] methods.

[Ed J <edj src gnome org>]

commit 5902c3952db824325bf5b0aa78c5190d39dff349
Author: Ed J <edj src gnome org>
Date:   Mon May 19 06:42:14 2014 +0100

    Deeper ->section[s] methods.

 Gimp/Pod.pm |   65 +++++++++++++++++++++++++++++++++++++++--------------------
 t/gimppod.t |   29 +++++++++++++++++++++++++-
 2 files changed, 71 insertions(+), 23 deletions(-)
---
diff --git a/Gimp/Pod.pm b/Gimp/Pod.pm
index 5f838a7..6b9489b 100644
--- a/Gimp/Pod.pm
+++ b/Gimp/Pod.pm
@@ -27,28 +27,46 @@ sub _cache {
 }
 
 sub sections {
-  map $_->[2], grep { ref eq 'ARRAY' and $_->[0] eq 'head1' } @{$_[0]->_cache};
+  my ($self, $sub) = @_;
+  my $doc = $self->_cache;
+  if (defined $sub) {
+    my $i = 2; # skip 'Document' and initial attrs
+    $i++ until
+      $i >= @$doc or ($doc->[$i]->[0] eq 'head1' and $doc->[$i]->[2] eq $sub);
+    return if $i >= @$doc;
+    my $i2 = ++$i;
+    $i2++ until $i2 >= @$doc or $doc->[$i2]->[0] =~ /^head1/;
+    $i2--;
+    map { $_->[2] } grep { ref and $_->[0] eq 'head2' } @{$doc}[$i..$i2];
+  } else {
+    map $_->[2], grep { ref eq 'ARRAY' and $_->[0] eq 'head1' } @$doc;
+  }
 }
 
 sub _flatten_para {
-   my $para = shift;
-   join '', map { ref($_) ? _flatten_para($_) : $_ } @{$para}[2..$#{$para}];
+  my $para = shift;
+  join '', map { ref($_) ? _flatten_para($_) : $_ } @{$para}[2..$#{$para}];
 }
 
 sub section {
-   my $self = shift;
-   warn __PACKAGE__."::section(@_)" if $Gimp::verbose >= 2;
-   return unless defined(my $doc = $self->_cache);
-   my $i = 2; # skip 'Document' and initial attrs
-   $i++ until
-      $i >= @$doc or ($doc->[$i]->[0] eq 'head1' and $doc->[$i]->[2] eq $_[0]);
-   return if $i >= @$doc;
-   my $i2 = ++$i;
-   $i2++ until $i2 >= @$doc or $doc->[$i2]->[0] =~ /^head/;
-   $i2--;
-   my $text = join "\n\n", map { _flatten_para($_) } @{$doc}[$i..$i2];
-   warn __PACKAGE__."::section returning '$text'" if $Gimp::verbose >= 2;
-   $text;
+  my $self = shift;
+  warn __PACKAGE__."::section(@_)" if $Gimp::verbose >= 2;
+  return unless defined(my $doc = $self->_cache);
+  my $i = 2; # skip 'Document' and initial attrs
+  my $depth = 0;
+  while (defined(my $sec = shift)) {
+    $depth++;
+    $i++ until
+      $i >= @$doc or
+      ($doc->[$i]->[0] eq "head$depth" and $doc->[$i]->[2] eq $sec);
+    return if $i >= @$doc;
+  }
+  my $i2 = ++$i;
+  $i2++ until $i2 >= @$doc or $doc->[$i2]->[0] eq "head$depth";
+  $i2--;
+  my $text = join "\n\n", map { _flatten_para($_) } @{$doc}[$i..$i2];
+  warn __PACKAGE__."::section returning '$text'" if $Gimp::verbose >= 2;
+  $text;
 }
 
 my %IND2SECT = (
@@ -108,7 +126,8 @@ Gimp::Pod - Evaluate pod documentation embedded in scripts.
   use Gimp::Pod;
   my $pod = Gimp::Pod->new;
   my $synopsis = $pod->section('SYNOPSIS');
-  my @sections = $pod->sections;
+  my @temp_procs = $pod->sections('TEMPORARY PROCEDURES');
+  my $text = $pod->section('TEMPORARY PROCEDURES', 'p1 - x', 'PARAMETERS');
 
   my @args = fixup_args(@register_args);
 
@@ -206,14 +225,16 @@ an empty string).
 Return a new Gimp::Pod object representing the current script or undef, if
 an error occured.
 
-=item section($header)
+=item section(@headers)
 
-Return the section with the header C<$header>, or undef if not
-found. There is no trailing newline on the returned string.
+Return the section with the header described by C<@headers>, the first
+being a C<head1>, the second <head2>, etc, or undef if not found. There
+is no trailing newline on the returned string.
 
-=item sections
+=item sections(@headers)
 
-Returns a list of section titles found in the pod.
+Returns a list of section titles found in the pod, described similarly
+to above.
 
 =back
 
diff --git a/t/gimppod.t b/t/gimppod.t
index 2cbfedf..ea358d6 100644
--- a/t/gimppod.t
+++ b/t/gimppod.t
@@ -6,7 +6,8 @@ my $p = Gimp::Pod->new;
 ok($p, 'obj init');
 is_deeply(
   [ $p->sections ],
-  [ ('NAME', 'SPACE NAME', 'VERBATIM', 'OTHER') ], 'sections'
+  [ 'NAME', 'SPACE NAME', 'VERBATIM', 'TEMPORARY PROCEDURES', 'OTHER' ],
+  'sections'
 );
 is($p->section('NAME'), 'test - Run some tests', 'sect name');
 is(
@@ -21,6 +22,16 @@ is(
 );
 is($p->section('OTHER'), 'Other text.', 'sect at eof');
 is($p->section('NOT THERE'), undef, 'sect not there');
+is_deeply(
+  [ $p->sections('TEMPORARY PROCEDURES') ],
+  [ 'p1 - text', 'p2 - other' ],
+  'sub-sections'
+);
+is(
+  $p->section('TEMPORARY PROCEDURES', 'p1 - text', 'PARAMETERS'),
+  ' p1 params',
+  'sub-section'
+);
 
 done_testing;
 __END__
@@ -42,6 +53,22 @@ Second para.
 
  new verbatim para
 
+=head1 TEMPORARY PROCEDURES
+
+=head2 p1 - text
+
+p1 description.
+
+=head3 PARAMETERS
+
+ p1 params
+
+=head3 SYNOPSIS
+
+<Image>/Menu
+
+=head2 p2 - other
+
 =head1 OTHER
 
 Other text.