222 |
} |
} |
223 |
|
|
224 |
if ($errors) { |
if ($errors) { |
225 |
$log->debug("errors: ", sub { dump( $errors ) } ); |
$log->debug("errors: ", $self->report_error( $errors ) ); |
226 |
|
|
227 |
my $mfn = $rec->{'000'}->[0] || $log->logconfess("record ", dump( $rec ), " doesn't have MFN"); |
my $mfn = $rec->{'000'}->[0] || $log->logconfess("record ", dump( $rec ), " doesn't have MFN"); |
228 |
$self->{errors}->{$mfn} = $errors; |
$self->{errors}->{$mfn} = $errors; |
259 |
return $self->{errors}; |
return $self->{errors}; |
260 |
} |
} |
261 |
|
|
262 |
=head2 report |
=head2 report_error |
263 |
|
|
264 |
Produce nice humanly readable report of errors |
Produce nice humanly readable report of single error |
265 |
|
|
266 |
print $validate->report; |
print $validate->report_error( $error_hash ); |
267 |
|
|
268 |
=cut |
=cut |
269 |
|
|
270 |
sub report { |
sub report_error { |
271 |
my $self = shift; |
my $self = shift; |
272 |
|
|
273 |
sub unroll { |
my $h = shift || die "no hash?"; |
274 |
|
|
275 |
|
sub _unroll { |
276 |
my ($self, $tree, $accumulated) = @_; |
my ($self, $tree, $accumulated) = @_; |
277 |
|
|
278 |
my $log = $self->_get_logger(); |
my $log = $self->_get_logger(); |
300 |
|
|
301 |
$log->debug("current: $k"); |
$log->debug("current: $k"); |
302 |
|
|
303 |
my ($new_results, $new_dump) = $self->unroll($tree->{$k}, |
my ($new_results, $new_dump) = $self->_unroll($tree->{$k}, |
304 |
$accumulated ? "$accumulated\t$k" : $k |
$accumulated ? "$accumulated\t$k" : $k |
305 |
); |
); |
306 |
|
|
324 |
} |
} |
325 |
} |
} |
326 |
|
|
|
my $log = $self->_get_logger(); |
|
|
|
|
|
my $out = ''; |
|
|
my $e = $self->{errors} || return; |
|
327 |
|
|
328 |
sub reformat { |
sub _reformat { |
329 |
my $l = shift; |
my $l = shift; |
330 |
$l =~ s/\t/ /g; |
$l =~ s/\t/ /g; |
331 |
$l =~ s/_/ /; |
$l =~ s/_/ /; |
332 |
return $l; |
return $l; |
333 |
} |
} |
334 |
|
|
335 |
foreach my $mfn (sort keys %$e) { |
my $out = ''; |
|
$out .= "MFN $mfn\n"; |
|
336 |
|
|
337 |
for my $f (sort keys %{ $e->{$mfn} }) { |
for my $f (sort keys %{ $h }) { |
338 |
my ($r, $d) = $self->unroll( $e->{$mfn}->{$f} ); |
$out .= "$f: "; |
339 |
my $e = $f . ': '; |
|
340 |
if (ref($r) eq 'ARRAY') { |
my ($r, $d) = $self->_unroll( $h->{$f} ); |
341 |
$e .= join(", ", map { reformat( $_ ) } @$r); |
my $e; |
342 |
} else { |
if (ref($r) eq 'ARRAY') { |
343 |
$e .= reformat( $r ); |
$e .= join(", ", map { _reformat( $_ ) } @$r); |
344 |
} |
} else { |
345 |
$e .= "\n\t$d" if ($d); |
$e .= _reformat( $r ); |
|
$e .= "\n"; |
|
|
$log->debug("MFN $mfn | $e"); |
|
|
$out .= $e; |
|
346 |
} |
} |
347 |
|
$e .= "\n\t$d" if ($d); |
348 |
|
|
349 |
|
$out .= $e . "\n"; |
350 |
|
} |
351 |
|
return $out; |
352 |
|
} |
353 |
|
|
354 |
|
|
355 |
|
=head2 report |
356 |
|
|
357 |
|
Produce nice humanly readable report of errors |
358 |
|
|
359 |
|
print $validate->report; |
360 |
|
|
361 |
|
=cut |
362 |
|
|
363 |
|
sub report { |
364 |
|
my $self = shift; |
365 |
|
my $e = $self->{errors} || return; |
366 |
|
|
367 |
|
my $out; |
368 |
|
foreach my $mfn (sort { $a <=> $b } keys %$e) { |
369 |
|
$out .= "MFN $mfn\n" . $self->report_error( $e->{$mfn} ) . "\n"; |
370 |
} |
} |
371 |
|
|
372 |
return $out; |
return $out; |
373 |
|
|
374 |
} |
} |
375 |
|
|
376 |
=head1 AUTHOR |
=head1 AUTHOR |