From: Moritz Bunkus Date: Tue, 21 Mar 2017 10:21:34 +0000 (+0100) Subject: LXDebug: clone_for_dump als eigenständige Funktion zur Wiederverwendung X-Git-Tag: release-3.5.4~1198 X-Git-Url: http://wagnertech.de/git?a=commitdiff_plain;h=c569daa13212ba1d634879ed512f2b51ce9c1533;p=kivitendo-erp.git LXDebug: clone_for_dump als eigenständige Funktion zur Wiederverwendung --- diff --git a/SL/LXDebug.pm b/SL/LXDebug.pm index 40ec54c8a..707b89230 100644 --- a/SL/LXDebug.pm +++ b/SL/LXDebug.pm @@ -157,51 +157,49 @@ sub warn { $self->message(WARN, $message); } -sub dump { - my ($self, $level, $name, $variable, %options) = @_; - - my %dumped; +sub clone_for_dump { + my ($src, $dumped) = @_; - my $clone_for_dump; - $clone_for_dump = sub { - my ($src) = @_; + return undef if !defined($src); - return undef if !defined($src); + $dumped ||= {}; + my $addr = refaddr($src); - my $addr = refaddr($src); + return $dumped->{$addr} if $dumped->{$addr // ''}; - return $dumped{$addr} if $dumped{$addr // ''}; + if (blessed($src) && $src->can('as_debug_info')) { + $dumped->{$addr} = $src->as_debug_info; - if (blessed($src) && $src->can('as_debug_info')) { - $dumped{$addr} = $src->as_debug_info; + } elsif (ref($src) eq 'ARRAY') { + $dumped->{$addr} = []; - } elsif (ref($src) eq 'ARRAY') { - $dumped{$addr} = []; + foreach my $entry (@{ $src }) { + my $exists = !!$dumped->{refaddr($entry) // ''}; + push @{ $dumped->{$addr} }, clone_for_dump($entry, $dumped); - foreach my $entry (@{ $src }) { - my $exists = !!$dumped{refaddr($entry) // ''}; - push @{ $dumped{$addr} }, $clone_for_dump->($entry); + weaken($dumped->{$addr}->[-1]) if $exists; - weaken($dumped{$addr}->[-1]) if $exists; - - } + } - } elsif (ref($src) =~ m{^(?:HASH|Form|SL::.+)$}) { - $dumped{$addr} = {}; + } elsif (ref($src) =~ m{^(?:HASH|Form|SL::.+)$}) { + $dumped->{$addr} = {}; - foreach my $key (keys %{ $src }) { - my $exists = !!$dumped{refaddr($src->{$key}) // ''}; - $dumped{$addr}->{$key} = $clone_for_dump->($src->{$key}); + foreach my $key (keys %{ $src }) { + my $exists = !!$dumped->{refaddr($src->{$key}) // ''}; + $dumped->{$addr}->{$key} = clone_for_dump($src->{$key}, $dumped); - weaken($dumped{$addr}->{$key}) if $exists; - } + weaken($dumped->{$addr}->{$key}) if $exists; } + } + + return $dumped->{$addr} // "$src"; +} - return $dumped{$addr} // "$src"; - }; +sub dump { + my ($self, $level, $name, $variable, %options) = @_; - $variable = $clone_for_dump->($variable); + $variable = clone_for_dump($variable); my $dumper = Data::Dumper->new([$variable]); $dumper->Sortkeys(1); $dumper->Indent(2);