r929@llin: dpavlin | 2006-09-11 13:56:02 +0200

[webpac2] / lib / WebPAC / Validate.pm

diff --git a/lib/WebPAC/Validate.pm b/lib/WebPAC/Validate.pm
index b3905ff..b417e99 100644 (file)
--- a/lib/WebPAC/Validate.pm
+++ b/lib/WebPAC/Validate.pm
@@ -272,39 +272,64 @@ Produce nice humanly readable report of errors
 sub report {
        my $self = shift;
 
+       my $log = $self->_get_logger();
+
        sub unroll {
-               my ($rest,$o, $dump) = @_;
+               my ($tree, $accumulated) = @_;
 
-#warn "# rest: $rest o: $o\n";
+               $log->debug("# ",
+                       ( $tree                 ? "tree: $tree "                                        : '' ),
+                       ( $accumulated  ? "accumulated: $accumulated "          : '' ),
+               );
 
-               return unless ($rest);
+               my $results;
 
-               if (ref($rest) ne 'HASH') {
-                       $o .= "($rest)";
-                       return ($o,$dump);
+               if (ref($tree) ne 'HASH') {
+                       return ("$accumulated\t($tree)", undef);
                }
 
-               foreach my $k (sort keys %{ $rest }) {
+               my $dump;
+
+               foreach my $k (sort keys %{ $tree }) {
 
                        if ($k eq 'dump') {
-                               $dump = $rest->{dump};
+                               $dump = $tree->{dump};
                                warn "## dump: $dump\n";
                                next;
                        }
-                       my $u;
-                       ($u, $dump) = unroll($rest->{$k}, $o, $dump);
-                       $o .= "$k $u";
 
+                       $log->debug("current: $k");
+
+                       my ($new_results, $new_dump) = unroll($tree->{$k},
+                               $accumulated ? "$accumulated\t$k" : $k
+                       );
+
+                       $log->debug(
+                               ( $new_results          ? "new_results: " . dump($new_results) ." "     : '' ),
+                       );
 
+                       push @$results, $new_results if ($new_results);
+                       $dump = $new_dump if ($new_dump);
+
+               }
+
+               $log->debug(
+                       ( $results              ? "results: " . dump($results) ." "     : '' ),
+               );
+
+               if ($#$results == 0) {
+                       return ($results->[0], $dump);
+               } else {
+                       return ($results, $dump);
                }
-               return ($o,$dump);
        }
 
        my $out = '';
+       my $e = $self->{errors} || return;
 
-       foreach my $mfn (sort keys %{ $self->{errors} }) {
-               my ($msg,$dump) = unroll( $self->{errors}->{$mfn}, '', '' );
-               $out .= "MFN $mfn\n$msg\t$dump\n\n";
+       foreach my $mfn (sort keys %$e) {
+               my ($r, $d) = unroll( $e->{$mfn} );
+               $out .= "MFN $mfn\n", dump($r), "\t$d\n\n";
        }
 
        return $out;