--- trunk/lib/WebPAC/Validate.pm 2006/09/07 15:57:48 653 +++ trunk/lib/WebPAC/Validate.pm 2006/09/11 11:57:18 664 @@ -18,11 +18,11 @@ =head1 VERSION -Version 0.06 +Version 0.07 =cut -our $VERSION = '0.06'; +our $VERSION = '0.07'; =head1 SYNOPSIS @@ -145,7 +145,7 @@ $fields->{$f}++; if ( ! defined($r->{$f}) ) { - $errors->{field}->{ $f }->{extra} = "not expected"; + $errors->{field}->{ $f }->{unexpected} = "this field is not expected"; next; } @@ -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 { @@ -185,7 +185,7 @@ $sf_repeatable->{$sf}++; }; if (! first { $_ eq $sf } @{ $r->{$f} }) { - $errors->{field}->{ $f }->{subfield}->{$sf} = "found extra subfield $sf which shouldn't exist"; + $errors->{field}->{ $f }->{subfield}->{extra}->{$sf}++; } } @@ -193,8 +193,8 @@ if (my @r_sf = sort keys( %$sf_repeatable )) { foreach my $sf (@r_sf) { - $errors->{field}->{$f}->{subfield}->{$sf} = "repeatable"; - $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,55 @@ 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<< >>