--- trunk/lib/WebPAC/Validate.pm 2006/09/07 15:00:27 651 +++ trunk/lib/WebPAC/Validate.pm 2006/09/07 15:01:45 652 @@ -8,7 +8,7 @@ use base 'WebPAC::Common'; use File::Slurp; use List::Util qw/first/; -use Data::Dumper; +use Data::Dump qw/dump/; use WebPAC::Normalize qw/_pack_subfields_hash/; use Storable qw/dclone/; @@ -18,11 +18,11 @@ =head1 VERSION -Version 0.04 +Version 0.06 =cut -our $VERSION = '0.04'; +our $VERSION = '0.06'; =head1 SYNOPSIS @@ -104,7 +104,7 @@ } - $log->debug("current validation rules: ", Dumper($v)); + $log->debug("current validation rules: ", dump($v)); $self->{rules} = $v; @@ -131,9 +131,9 @@ $log->logdie("rec isn't HASH") unless (ref($rec) eq 'HASH'); $log->logdie("can't find validation rules") unless (my $r = $self->{rules}); - my @errors; + my $errors; - $log->debug("rec = ", sub { Dumper($rec) }, "keys = ", keys %{ $rec }); + $log->debug("rec = ", sub { dump($rec) }, "keys = ", keys %{ $rec }); my $fields; @@ -144,13 +144,13 @@ $fields->{$f}++; if ( ! defined($r->{$f}) ) { - push @errors, "field '$f' shouldn't exists"; + $errors->{field}->{ $f }->{extra} = "not expected"; next; } if (ref($rec->{$f}) ne 'ARRAY') { - push @errors, "field '$f' isn't repetable, probably bug in parsing input data"; + $errors->{field}->{ $f }->{not_repeatable} = "probably bug in parsing input data"; next; } @@ -158,8 +158,11 @@ # can we have subfields? if (ref($r->{$f}) eq 'ARRAY') { # are values hashes? (has subfields) - if (ref($v) ne 'HASH') { - push @errors, "$f has value without subfields: $v"; + if (! defined($v)) { + $errors->{field}->{$f}->{empty} = undef; + $errors->{dump}->{record}++; + } elsif (ref($v) ne 'HASH') { + $errors->{field}->{$f}->{missing_subfield} = "value without subfields: $v"; next; } else { @@ -181,50 +184,54 @@ $sf_repeatable->{$sf}++; }; if (! first { $_ eq $sf } @{ $r->{$f} }) { - push @errors, "$f has unknown subfield: $sf"; + $errors->{field}->{ $f }->{subfield}->{$sf} = "unknown"; } } } if (my @r_sf = sort keys( %$sf_repeatable )) { - my $plural = $#r_sf > 0 ? 1 : 0; - push @errors, "$f subfield" . - ( $plural ? 's ' : ' ' ) . - join(', ', @r_sf) . - ( $plural ? ' are ' : ' is ' ) . - 'repeatable in: ' . - join('', _pack_subfields_hash( $h, 1) ); + foreach my $sf (@r_sf) { + $errors->{field}->{$f}->{subfield}->{$sf} = "repeatable"; + $errors->{dump}->{field}->{$f} = + join('', _pack_subfields_hash( $h, 1 ) ); + } + } if ( defined( $self->{must_exist_sf}->{$f} ) ) { foreach my $sf (sort keys %{ $self->{must_exist_sf}->{$f} }) { #warn "====> $f $sf must exist\n"; - push @errors, "$f missing required subfield $sf" - unless ( - defined( $subfields->{$sf} ) - ) + $errors->{field}->{$f}->{subfield}->{$sf} = "missing" + unless defined( $subfields->{$sf} ); } } } } elsif (ref($v) eq 'HASH') { - push @errors, "$f has subfields which is not valid"; + $errors->{field}->{$f}->{unexpected_subfields}++; + $errors->{dump}->{field}->{$f} = + join('', _pack_subfields_hash( $v, 1 ) ); } } } foreach my $must (sort keys %{ $self->{must_exist} }) { next if ($fields->{$must}); - push @errors, - "field $must should exist, but it doesn't"; + $errors->{field}->{$must}->{missing}++; + $errors->{dump}->{record}++; } - #$log->logcluck("return from this function is ARRAY") unless wantarray; + if ($errors) { + $log->debug("errors: ", sub { dump( $errors ) } ); - $log->debug("errors: ", join(", ", @errors)) if (@errors); + my $mfn = $rec->{'000'}->[0]; + $self->{errors}->{$mfn} = $errors; + } + + #$log->logcluck("return from this function is ARRAY") unless wantarray; - return @errors; + return $errors; } =head1 AUTHOR