| 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; |
Parent Directory
| 
Revision Log
| 
Patch