--- trunk/lib/WebPAC/Validate.pm	2006/09/07 16:41:08	654
+++ trunk/lib/WebPAC/Validate.pm	2006/09/11 11:57:30	665
@@ -18,11 +18,11 @@
 
 =head1 VERSION
 
-Version 0.06
+Version 0.07
 
 =cut
 
-our $VERSION = '0.06';
+our $VERSION = '0.07';
 
 =head1 SYNOPSIS
 
@@ -160,10 +160,10 @@
 			if (ref($r->{$f}) eq 'ARRAY') {
 				# are values hashes? (has subfields)
 				if (! defined($v)) {
-					$errors->{field}->{$f}->{empty} = undef;
-					$errors->{dump} = $rec_dump if ($rec_dump);
+#					$errors->{field}->{$f}->{empty} = undef;
+#					$errors->{dump} = $rec_dump if ($rec_dump);
 				} elsif (ref($v) ne 'HASH') {
-					$errors->{field}->{$f}->{missing_subfield} = "subfields required for this field";
+					$errors->{field}->{$f}->{missing_subfield} = join(",", @{ $r->{$f} }) . " required";
 					next;
 				} else {
 
@@ -193,8 +193,8 @@
 					if (my @r_sf = sort keys( %$sf_repeatable )) {
 
 						foreach my $sf (@r_sf) {
-							$errors->{field}->{$f}->{subfield}->{repeatable}->{$sf}++;
-							$errors->{field}->{$f}->{dump}->{$f} =
+							$errors->{field}->{$f}->{subfield}->{extra_repeatable}->{$sf}++;
+							$errors->{field}->{$f}->{dump} =
 								join('', _pack_subfields_hash( $h, 1 ) );
 						}
 
@@ -203,7 +203,7 @@
 					if ( defined( $self->{must_exist_sf}->{$f} ) ) {
 						foreach my $sf (sort keys %{ $self->{must_exist_sf}->{$f} }) {
 #warn "====> $f $sf must exist\n";
-							$errors->{field}->{$f}->{subfield}->{$sf} = "missing"
+							$errors->{field}->{$f}->{subfield}->{missing}->{$sf}++
 								unless defined( $subfields->{$sf} );
 						}
 					}
@@ -261,6 +261,80 @@
 	return $self->{errors};
 }
 
+=head2 report
+
+Produce nice humanly readable report of errors
+
+  print $validate->report;
+
+=cut
+
+sub report {
+	my $self = shift;
+
+	my $log = $self->_get_logger();
+
+	sub unroll {
+		my ($tree, $accumulated) = @_;
+
+		$log->debug("# ",
+			( $tree			? "tree: $tree "					: '' ),
+			( $accumulated	? "accumulated: $accumulated "		: '' ),
+		);
+
+		my $results;
+
+		if (ref($tree) ne 'HASH') {
+			return ("$accumulated\t($tree)", undef);
+		}
+
+		my $dump;
+
+		foreach my $k (sort keys %{ $tree }) {
+
+			if ($k eq 'dump') {
+				$dump = $tree->{dump};
+				warn "## dump: $dump\n";
+				next;
+			}
+
+			$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);
+		}
+	}
+
+	my $out = '';
+	my $e = $self->{errors} || return;
+
+	foreach my $mfn (sort keys %$e) {
+		my ($r, $d) = unroll( $e->{$mfn} );
+		$out .= "MFN $mfn\n", dump($r), "\t$d\n\n";
+	}
+
+	return $out;
+}
+
 =head1 AUTHOR
 
 Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>