272 |
sub report { |
sub report { |
273 |
my $self = shift; |
my $self = shift; |
274 |
|
|
275 |
|
my $log = $self->_get_logger(); |
276 |
|
|
277 |
sub unroll { |
sub unroll { |
278 |
my ($rest,$o, $dump) = @_; |
my ($tree, $accumulated) = @_; |
279 |
|
|
280 |
#warn "# rest: $rest o: $o\n"; |
$log->debug("# ", |
281 |
|
( $tree ? "tree: $tree " : '' ), |
282 |
|
( $accumulated ? "accumulated: $accumulated " : '' ), |
283 |
|
); |
284 |
|
|
285 |
return unless ($rest); |
my $results; |
286 |
|
|
287 |
if (ref($rest) ne 'HASH') { |
if (ref($tree) ne 'HASH') { |
288 |
$o .= "($rest)"; |
return ("$accumulated\t($tree)", undef); |
|
return ($o,$dump); |
|
289 |
} |
} |
290 |
|
|
291 |
foreach my $k (sort keys %{ $rest }) { |
my $dump; |
292 |
|
|
293 |
|
foreach my $k (sort keys %{ $tree }) { |
294 |
|
|
295 |
if ($k eq 'dump') { |
if ($k eq 'dump') { |
296 |
$dump = $rest->{dump}; |
$dump = $tree->{dump}; |
297 |
warn "## dump: $dump\n"; |
warn "## dump: $dump\n"; |
298 |
next; |
next; |
299 |
} |
} |
|
my $u; |
|
|
($u, $dump) = unroll($rest->{$k}, $o, $dump); |
|
|
$o .= "$k $u"; |
|
300 |
|
|
301 |
|
$log->debug("current: $k"); |
302 |
|
|
303 |
|
my ($new_results, $new_dump) = unroll($tree->{$k}, |
304 |
|
$accumulated ? "$accumulated\t$k" : $k |
305 |
|
); |
306 |
|
|
307 |
|
$log->debug( |
308 |
|
( $new_results ? "new_results: " . dump($new_results) ." " : '' ), |
309 |
|
); |
310 |
|
|
311 |
|
push @$results, $new_results if ($new_results); |
312 |
|
$dump = $new_dump if ($new_dump); |
313 |
|
|
314 |
|
} |
315 |
|
|
316 |
|
$log->debug( |
317 |
|
( $results ? "results: " . dump($results) ." " : '' ), |
318 |
|
); |
319 |
|
|
320 |
|
if ($#$results == 0) { |
321 |
|
return ($results->[0], $dump); |
322 |
|
} else { |
323 |
|
return ($results, $dump); |
324 |
} |
} |
|
return ($o,$dump); |
|
325 |
} |
} |
326 |
|
|
327 |
my $out = ''; |
my $out = ''; |
328 |
|
my $e = $self->{errors} || return; |
329 |
|
|
330 |
foreach my $mfn (sort keys %{ $self->{errors} }) { |
foreach my $mfn (sort keys %$e) { |
331 |
my ($msg,$dump) = unroll( $self->{errors}->{$mfn}, '', '' ); |
my ($r, $d) = unroll( $e->{$mfn} ); |
332 |
$out .= "MFN $mfn\n$msg\t$dump\n\n"; |
$out .= "MFN $mfn\n", dump($r), "\t$d\n\n"; |
333 |
} |
} |
334 |
|
|
335 |
return $out; |
return $out; |