Revision c569daa1
Von Moritz Bunkus vor fast 8 Jahren hinzugefügt
| SL/LXDebug.pm | ||
|---|---|---|
| 157 | 157 |
$self->message(WARN, $message); |
| 158 | 158 |
} |
| 159 | 159 |
|
| 160 |
sub dump {
|
|
| 161 |
my ($self, $level, $name, $variable, %options) = @_; |
|
| 162 |
|
|
| 163 |
my %dumped; |
|
| 160 |
sub clone_for_dump {
|
|
| 161 |
my ($src, $dumped) = @_; |
|
| 164 | 162 |
|
| 165 |
my $clone_for_dump; |
|
| 166 |
$clone_for_dump = sub {
|
|
| 167 |
my ($src) = @_; |
|
| 163 |
return undef if !defined($src); |
|
| 168 | 164 |
|
| 169 |
return undef if !defined($src); |
|
| 165 |
$dumped ||= {};
|
|
| 166 |
my $addr = refaddr($src); |
|
| 170 | 167 |
|
| 171 |
my $addr = refaddr($src);
|
|
| 168 |
return $dumped->{$addr} if $dumped->{$addr // ''};
|
|
| 172 | 169 |
|
| 173 |
return $dumped{$addr} if $dumped{$addr // ''};
|
|
| 174 | 170 |
|
| 171 |
if (blessed($src) && $src->can('as_debug_info')) {
|
|
| 172 |
$dumped->{$addr} = $src->as_debug_info;
|
|
| 175 | 173 |
|
| 176 |
if (blessed($src) && $src->can('as_debug_info')) {
|
|
| 177 |
$dumped{$addr} = $src->as_debug_info;
|
|
| 174 |
} elsif (ref($src) eq 'ARRAY') {
|
|
| 175 |
$dumped->{$addr} = [];
|
|
| 178 | 176 |
|
| 179 |
} elsif (ref($src) eq 'ARRAY') {
|
|
| 180 |
$dumped{$addr} = [];
|
|
| 177 |
foreach my $entry (@{ $src }) {
|
|
| 178 |
my $exists = !!$dumped->{refaddr($entry) // ''};
|
|
| 179 |
push @{ $dumped->{$addr} }, clone_for_dump($entry, $dumped);
|
|
| 181 | 180 |
|
| 182 |
foreach my $entry (@{ $src }) {
|
|
| 183 |
my $exists = !!$dumped{refaddr($entry) // ''};
|
|
| 184 |
push @{ $dumped{$addr} }, $clone_for_dump->($entry);
|
|
| 181 |
weaken($dumped->{$addr}->[-1]) if $exists;
|
|
| 185 | 182 |
|
| 186 |
weaken($dumped{$addr}->[-1]) if $exists;
|
|
| 187 |
|
|
| 188 |
} |
|
| 183 |
} |
|
| 189 | 184 |
|
| 190 |
} elsif (ref($src) =~ m{^(?:HASH|Form|SL::.+)$}) {
|
|
| 191 |
$dumped{$addr} = {};
|
|
| 185 |
} elsif (ref($src) =~ m{^(?:HASH|Form|SL::.+)$}) {
|
|
| 186 |
$dumped->{$addr} = {};
|
|
| 192 | 187 |
|
| 193 |
foreach my $key (keys %{ $src }) {
|
|
| 194 |
my $exists = !!$dumped{refaddr($src->{$key}) // ''};
|
|
| 195 |
$dumped{$addr}->{$key} = $clone_for_dump->($src->{$key});
|
|
| 188 |
foreach my $key (keys %{ $src }) {
|
|
| 189 |
my $exists = !!$dumped->{refaddr($src->{$key}) // ''};
|
|
| 190 |
$dumped->{$addr}->{$key} = clone_for_dump($src->{$key}, $dumped);
|
|
| 196 | 191 |
|
| 197 |
weaken($dumped{$addr}->{$key}) if $exists;
|
|
| 198 |
} |
|
| 192 |
weaken($dumped->{$addr}->{$key}) if $exists;
|
|
| 199 | 193 |
} |
| 194 |
} |
|
| 195 |
|
|
| 196 |
return $dumped->{$addr} // "$src";
|
|
| 197 |
} |
|
| 200 | 198 |
|
| 201 |
return $dumped{$addr} // "$src";
|
|
| 202 |
};
|
|
| 199 |
sub dump {
|
|
| 200 |
my ($self, $level, $name, $variable, %options) = @_;
|
|
| 203 | 201 |
|
| 204 |
$variable = $clone_for_dump->($variable);
|
|
| 202 |
$variable = clone_for_dump($variable);
|
|
| 205 | 203 |
my $dumper = Data::Dumper->new([$variable]); |
| 206 | 204 |
$dumper->Sortkeys(1); |
| 207 | 205 |
$dumper->Indent(2); |
Auch abrufbar als: Unified diff
LXDebug: clone_for_dump als eigenständige Funktion zur Wiederverwendung