From 88a80e355757eba474e92a2fe576a2dfeb940f3e Mon Sep 17 00:00:00 2001
From: Dobrica Pavlinusic <dpavlin@rot13.org>
Date: Mon, 11 Sep 2006 11:57:30 +0000
Subject: [PATCH]  r929@llin:  dpavlin | 2006-09-11 13:56:02 +0200  another cut
 at simplification of report

git-svn-id: svn+ssh://mjesec/home/dpavlin/svn/webpac2/trunk@665 07558da8-63fa-0310-ba24-9fe276d99e06
---
 lib/WebPAC/Validate.pm | 55 ++++++++++++++++++++++++++++++------------
 t/1-validate.t         | 16 ++++++++++--
 2 files changed, 54 insertions(+), 17 deletions(-)

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;
diff --git a/t/1-validate.t b/t/1-validate.t
index 68ad24c..05728cb 100755
--- a/t/1-validate.t
+++ b/t/1-validate.t
@@ -1,7 +1,7 @@
 #!/usr/bin/perl -w
 
 use strict;
-use Test::More tests => 50;
+use Test::More tests => 51;
 use Test::Exception;
 use blib;
 
@@ -112,7 +112,6 @@ is_deeply(
 test_v({
 	'903' => [ { 'a' => 0 }, { 'b' => 1 }, { 'c' => 2 }, { 'd' => 3 }, { 'e' => 4 } ]
 }, qw/field 903 subfield extra/),
-
 { 'd' => 1, 'e' => 1 }, 'additional fields d, e');
 
 test_v({
@@ -134,3 +133,16 @@ test_v({
 test_v({
 	'905' => [ ]
 });
+
+test_v({
+	'900' => 'foo',
+	'901' => [ qw/foo bar baz/ ],
+	'902' => [ { 'a' => 1, 'b' => [ 1,2 ] } ],
+	'903' => [ { 'a' => [ 1, 2 ], 'c' => 1, } ],
+	'904' => [ { 'b' => 1 } ],
+	'905' => [ { 'a' => 1 } ],
+});
+
+diag "errors: ",dump( $v->all_errors );
+
+print $v->report;
-- 
2.20.1