Rework test file parser as a new function getparts() which extracts
multiple parts with the same path. Re-implement getpart() and
getpartattr() in terms of getparts(), for backward compatibility.

---
 tests/getpart.pm |  156 ++++++++++++++++++++++++++++-------------------------
 1 files changed, 82 insertions(+), 74 deletions(-)
diff --git a/tests/getpart.pm b/tests/getpart.pm
index 83e56ca..5a40df9 100644
--- a/tests/getpart.pm
+++ b/tests/getpart.pm
@@ -34,94 +34,102 @@ sub decode_base64 {
   return unpack("u", $len . $_);         # uudecode and print
 }
 
-sub getpartattr {
-    # if $part is undefined (ie only one argument) then
-    # return the attributes of the section
+# Get a list of matching parts identified by section and part.
+# Each returned item is an array with a hash-of-attributes as
+# first element, followed by any content lines.
 
-    my ($section, $part)=@_;
+sub getparts {
+    # if $part is undefined (ie only one argument) then
+    # return the section
 
-    my %hash;
-    my $inside=0;
+    my($section, $part) = @_;
 
- #   print "Section: $section, part: $part\n";
+    my @want = ('testcase',$section);
+    push @want, $part if $part;
+    my @items;
+    my $level = 0;
+    my $item;
+    my $base64;
 
     for(@xml) {
- #       print "$inside: $_";
-        if(!$inside && ($_ =~ /^ *\<$section/)) {
-            $inside++;
-        }
-        if((1 ==$inside) && ( ($_ =~ /^ *\<$part([^>]*)/) ||
-                              !(defined($part)) )
-             ) {
-            $inside++;
-            my $attr=$1;
-
-            while($attr =~ s/ *([^=]*)= *(\"([^\"]*)\"|([^\"> ]*))//) {
-                my ($var, $cont)=($1, $2);
-                $cont =~ s/^\"(.*)\"$/$1/;
-                $hash{$var}=$cont;
+        pos($_) = 0;            # Reset to start for m//g
+        if(/^\s*<(\w+)/gc) {
+            my $tag = $1;
+            if($level < @want && $tag eq $want[$level]) {
+                ++ $level;
+                if($level == @want) {
+                    # Found the path of interest
+                    my %attr;
+                    while(/\G\s+(\w+)=/gc) {
+                        my $name = $1;
+                        if(/\G\"([^\"]*)\"/gc) {
+                            $attr{$name} = $1;
+                        }
+                        elsif(/\G(\w+)/gc) {
+                            $attr{$name} = $1;
+                        }
+                        else {
+                            # FIXME bad attr
+                            last;
+                        }
+                    }
+                    if(! /\G\s*>/) {
+                        # FIXME bad tag
+                    }
+                    $item = [\%attr];
+                    $base64 = exists $attr{'base64'};
+                }
             }
-            last;
-        }
-        # detect end of section when part wasn't found
-        elsif((1 ==$inside) && ($_ =~ /^ *\<\/$section\>/)) {
-            last;
-        }
-        elsif((2 ==$inside) && ($_ =~ /^ *\<\/$part/)) {
-            $inside--;
-        }
-    }
-    return %hash;
-}
-
-sub getpart {
-    my ($section, $part)=@_;
-
-    my @this;
-    my $inside=0;
-    my $base64=0;
-
- #   print "Section: $section, part: $part\n";
-
-    for(@xml) {
- #       print "$inside: $_";
-        if(!$inside && ($_ =~ /^ *\<$section/)) {
-            $inside++;
-        }
-        elsif((1 ==$inside) && ($_ =~ /^ *\<$part[ \>]/)) {
-            if($_ =~ /$part [^>]*base64=/) {
-                # attempt to detect base64 encoded parts
-                $base64=1;
+            else {
+                # Could be irrelevant tag, or real XML file content
+                if($item) {
+                    $_ = decode_base64($_)
+                        if $base64;
+                    push @$item, $_;
+                }
             }
-            $inside++;
         }
-        elsif((2 ==$inside) && ($_ =~ /^ *\<\/$part/)) {
-            $inside--;
-        }
-        elsif((1==$inside) && ($_ =~ /^ *\<\/$section/)) {
-            if($trace) {
-                print STDERR "*** getpart.pm: $section/$part returned data!\n";
-            }
-            if(!@this && $warning) {
-                print STDERR "*** getpart.pm: $section/$part returned empty!\n";
-            }
-            if($base64) {
-                # decode the whole array before returning it!
-                for(@this) {
-                    my $decoded = decode_base64($_);
-                    $_ = $decoded;
+        elsif(/^\s*<\/(\w+)>/) {
+            my $tag = $1;
+            if($level > 0 && $tag eq $want[$level-1]) {
+                # End of the innermost element
+                -- $level;
+                if($item) {
+                    push @items, $item;
+                    $item = undef;
                 }
             }
-            return @this;
         }
-        elsif(2==$inside) {
-            push @this, $_;
+        else {
+            if($item) {
+                $_ = decode_base64($_)
+                    if $base64;
+                push @$item, $_;
+            }
         }
     }
-    if($warning) {
-        print STDERR "*** getpart.pm: $section/$part returned empty!\n";
+    return @items;
+}
+
+sub getonepart {
+    my @parts = getparts(@_);
+    if(@parts > 1) {
+        die "More than one ".join('/',@_)." section defined\n";
     }
-    return @this; #empty!
+    return @{$parts[0]};
+}
+
+sub getpart {
+    my($attr, @lines) = getonepart(@_);
+    return @lines;
+}
+    
+sub getpartattr {
+    # if $part is undefined (ie only one argument) then
+    # return the attributes of the section
+
+    my($attr, @lines) = getonepart(@_);
+    return %$attr;
 }
 
 sub loadtest {
-- 
1.6.5.6
--------------030205040005020403060202
Content-Type: text/plain;
 name="0002-Allow-multiple-client-file-and-verify-file-parts.patch"
Content-Transfer-Encoding: 7bit
Content-Disposition: attachment;
 filename*0="0002-Allow-multiple-client-file-and-verify-file-parts.patch"