X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=lib%2FWebPAC%2FValidate.pm;h=b417e99fca13af27cb6cd0c2ff71048379b1e8f8;hb=88a80e355757eba474e92a2fe576a2dfeb940f3e;hp=b3905ffc0e6008cf86b47cf9b25dc0d9de619e97;hpb=e58df04ca3687af1a5b1b422ad052335532bdb8f;p=webpac2

diff --git a/lib/WebPAC/Validate.pm b/lib/WebPAC/Validate.pm
index b3905ff..b417e99 100644
--- 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;