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 ae1471b..b417e99 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
 
@@ -117,7 +117,7 @@ sub new {
 
 Validate record and return errors
 
-  my @errors = $validate->validate_errors( $rec );
+  my @errors = $validate->validate_errors( $rec, $rec_dump );
 
 =cut
 
@@ -127,6 +127,7 @@ sub validate_errors {
        my $log = $self->_get_logger();
 
        my $rec = shift || $log->logdie("validate_errors need record");
+       my $rec_dump = shift;
 
        $log->logdie("rec isn't HASH") unless (ref($rec) eq 'HASH');
        $log->logdie("can't find validation rules") unless (my $r = $self->{rules});
@@ -144,7 +145,7 @@ sub validate_errors {
                $fields->{$f}++;
 
                if ( ! defined($r->{$f}) ) {
-                       $errors->{field}->{ $f }->{extra} = "not expected";
+                       $errors->{field}->{ $f }->{unexpected} = "this field is not expected";
                        next;
                }
 
@@ -159,10 +160,10 @@ sub validate_errors {
                        if (ref($r->{$f}) eq 'ARRAY') {
                                # are values hashes? (has subfields)
                                if (! defined($v)) {
-                                       $errors->{field}->{$f}->{empty} = undef;
-                                       $errors->{dump}->{record}++;
+#                                      $errors->{field}->{$f}->{empty} = undef;
+#                                      $errors->{dump} = $rec_dump if ($rec_dump);
                                } elsif (ref($v) ne 'HASH') {
-                                       $errors->{field}->{$f}->{missing_subfield} = "value without subfields: $v";
+                                       $errors->{field}->{$f}->{missing_subfield} = join(",", @{ $r->{$f} }) . " required";
                                        next;
                                } else {
 
@@ -184,7 +185,7 @@ sub validate_errors {
                                                                $sf_repeatable->{$sf}++;
                                                        };
                                                        if (! first { $_ eq $sf } @{ $r->{$f} }) {
-                                                               $errors->{field}->{ $f }->{subfield}->{$sf} = "unknown";
+                                                               $errors->{field}->{ $f }->{subfield}->{extra}->{$sf}++;
                                                        }
                                                }
 
@@ -192,8 +193,8 @@ sub validate_errors {
                                        if (my @r_sf = sort keys( %$sf_repeatable )) {
 
                                                foreach my $sf (@r_sf) {
-                                                       $errors->{field}->{$f}->{subfield}->{$sf} = "repeatable";
-                                                       $errors->{dump}->{field}->{$f} =
+                                                       $errors->{field}->{$f}->{subfield}->{extra_repeatable}->{$sf}++;
+                                                       $errors->{field}->{$f}->{dump} =
                                                                join('', _pack_subfields_hash( $h, 1 ) );
                                                }
 
@@ -202,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} );
                                                }
                                        }
@@ -210,7 +211,7 @@ sub validate_errors {
                                }
                        } elsif (ref($v) eq 'HASH') {
                                $errors->{field}->{$f}->{unexpected_subfields}++;
-                               $errors->{dump}->{field}->{$f} =
+                               $errors->{field}->{$f}->{dump} =
                                        join('', _pack_subfields_hash( $v, 1 ) );
                        }
                }
@@ -219,13 +220,13 @@ sub validate_errors {
        foreach my $must (sort keys %{ $self->{must_exist} }) {
                next if ($fields->{$must});
                $errors->{field}->{$must}->{missing}++;
-               $errors->{dump}->{record}++;
+               $errors->{dump} = $rec_dump if ($rec_dump);
        }
 
        if ($errors) {
                $log->debug("errors: ", sub { dump( $errors ) } );
 
-               my $mfn = $rec->{'000'}->[0];
+               my $mfn = $rec->{'000'}->[0] || $log->logconfess("record ", dump( $rec ), " doesn't have MFN");
                $self->{errors}->{$mfn} = $errors;
        }
 
@@ -234,6 +235,106 @@ sub validate_errors {
        return $errors;
 }
 
+=head2 reset_errors
+
+Clean all accumulated errors for this input
+
+  $validate->reset_errors;
+
+=cut
+
+sub reset_errors {
+       my $self = shift;
+       delete ($self->{errors});
+}
+
+=head2 all_errors
+
+Return hash with all errors
+
+  print dump( $validate->all_errors );
+
+=cut
+
+sub all_errors {
+       my $self = shift;
+       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> >>