r928@llin: dpavlin | 2006-09-09 20:24:06 +0200

 a try at implementing of validation reporter

git-svn-id: svn+ssh://mjesec/home/dpavlin/svn/webpac2/trunk@664 07558da8-63fa-0310-ba24-9fe276d99e06

diff --git a/lib/WebPAC/Validate.pm b/lib/WebPAC/Validate.pm
index 8907eed..b3905ff 100644 (file)
--- a/lib/WebPAC/Validate.pm
+++ b/lib/WebPAC/Validate.pm
@@ -18,11 +18,11 @@ WebPAC::Validate - provide simple validation for records
 
 =head1 VERSION
 
-Version 0.06
+Version 0.07
 
 =cut
 
-our $VERSION = '0.06';
+our $VERSION = '0.07';
 
 =head1 SYNOPSIS
 
@@ -203,7 +203,7 @@ sub validate_errors {
                                        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,55 @@ sub all_errors {
        return $self->{errors};
 }
 
+=head2 report
+
+Produce nice humanly readable report of errors
+
+  print $validate->report;
+
+=cut
+
+sub report {
+       my $self = shift;
+
+       sub unroll {
+               my ($rest,$o, $dump) = @_;
+
+#warn "# rest: $rest o: $o\n";
+
+               return unless ($rest);
+
+               if (ref($rest) ne 'HASH') {
+                       $o .= "($rest)";
+                       return ($o,$dump);
+               }
+
+               foreach my $k (sort keys %{ $rest }) {
+
+                       if ($k eq 'dump') {
+                               $dump = $rest->{dump};
+                               warn "## dump: $dump\n";
+                               next;
+                       }
+                       my $u;
+                       ($u, $dump) = unroll($rest->{$k}, $o, $dump);
+                       $o .= "$k $u";
+
+
+               }
+               return ($o,$dump);
+       }
+
+       my $out = '';
+
+       foreach my $mfn (sort keys %{ $self->{errors} }) {
+               my ($msg,$dump) = unroll( $self->{errors}->{$mfn}, '', '' );
+               $out .= "MFN $mfn\n$msg\t$dump\n\n";
+       }
+
+       return $out;
+}
+
 =head1 AUTHOR
 
 Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>

diff --git a/run.pl b/run.pl
index 8878e65..45141ff 100755 (executable)
--- a/run.pl
+++ b/run.pl
@@ -463,10 +463,9 @@ while (my ($database, $db_config) = each %{ $config->{databases} }) {
                                $total_rows++;
                        }
 
-                       if ($validate && defined($validate->all_errors)) {
-                               my $validate_errors = $validate->all_errors;
-
-                               $log->info("validation errors:\n", dump( $validate_errors ) );
+                       if ($validate) {
+                               my $errors = $validate->report;
+                               $log->info("validation errors:\n$errors\n" ) if ($errors);
                        }
 
                        $log->info("statistics of fields usage:\n", $input_db->stats) if ($stats);