| 20 |
20 |
|
| 21 |
21 |
use Data::Dumper;
|
| 22 |
22 |
use POSIX qw(strftime getpid);
|
|
23 |
use Scalar::Util qw(blessed reftype);
|
| 23 |
24 |
use Time::HiRes qw(gettimeofday tv_interval);
|
| 24 |
25 |
use YAML;
|
| 25 |
26 |
use SL::Request ();
|
| ... | ... | |
| 156 |
157 |
$self->message(WARN, $message);
|
| 157 |
158 |
}
|
| 158 |
159 |
|
|
160 |
sub _clone_for_dump {
|
|
161 |
my ($src) = @_;
|
|
162 |
|
|
163 |
return undef unless defined($src);
|
|
164 |
return $src->as_debug_info if blessed($src) && $src->can('as_debug_info');
|
|
165 |
return [ map { _clone_for_dump($_) } @{ $src } ] if reftype($src) eq 'ARRAY';
|
|
166 |
return { map { ($_ => _clone_for_dump($src->{$_})) } keys %{ $src } } if reftype($src) eq 'HASH';
|
|
167 |
return "$src";
|
|
168 |
}
|
|
169 |
|
| 159 |
170 |
sub dump {
|
| 160 |
171 |
my ($self, $level, $name, $variable, %options) = @_;
|
| 161 |
172 |
|
| 162 |
|
my $password;
|
| 163 |
|
if ($variable && ('Form' eq ref $variable) && defined $variable->{password}) {
|
| 164 |
|
$password = $variable->{password};
|
| 165 |
|
$variable->{password} = 'X' x 8;
|
| 166 |
|
}
|
| 167 |
|
|
|
173 |
$variable = _clone_for_dump($variable);
|
| 168 |
174 |
my $dumper = Data::Dumper->new([$variable]);
|
| 169 |
175 |
$dumper->Sortkeys(1);
|
| 170 |
176 |
$dumper->Indent(2);
|
| ... | ... | |
| 172 |
178 |
my $output = $dumper->Dump();
|
| 173 |
179 |
$self->message($level, "dumping ${name}:\n" . $output);
|
| 174 |
180 |
|
| 175 |
|
$variable->{password} = $password if (defined $password);
|
| 176 |
|
|
| 177 |
|
# Data::Dumper does not reset the iterator belonging to this hash
|
| 178 |
|
# if 'Sortkeys' is true. Therefore clear the iterator manually.
|
| 179 |
|
# See "perldoc -f each".
|
| 180 |
|
if ($variable && (('HASH' eq ref $variable) || ('Form' eq ref $variable))) {
|
| 181 |
|
keys %{ $variable };
|
| 182 |
|
}
|
| 183 |
|
|
| 184 |
181 |
return $output;
|
| 185 |
182 |
}
|
| 186 |
183 |
|
| ... | ... | |
| 218 |
215 |
$self->message($level, $prefix . sprintf('(%d row%s)', scalar @{ $results }, scalar @{ $results } > 1 ? 's' : ''));
|
| 219 |
216 |
}
|
| 220 |
217 |
|
| 221 |
|
sub dump_object {
|
| 222 |
|
my ($self, $level, $text, $object) = @_;
|
| 223 |
|
|
| 224 |
|
my $copy;
|
| 225 |
|
if ($object) {
|
| 226 |
|
$copy->{$_} = $object->$_ for $object->meta->columns;
|
| 227 |
|
}
|
| 228 |
|
|
| 229 |
|
$self->dump($level, $text, $copy);
|
| 230 |
|
}
|
| 231 |
|
|
| 232 |
218 |
sub show_diff {
|
| 233 |
219 |
my ($self, $level, $item1, $item2, %params) = @_;
|
| 234 |
220 |
|
LXDebug::dump: Interna von Rose-DB- und DateTime-Objekten nicht mehr ausgeben
dump arbeitet nun nicht mehr direkt auf dem zu dumpenden Objekt,
sondern auf Kopien, die je nach Typ auf ihre essenziellen
Informationen zusammengeschrumpft werden. Dafür kann ein Objekt eine
Methode »as_debug_info« bereitstellen, die eine solche Essenz
zurückgibt.
Für SL::DB::Object ist eine Implementation beigelegt, die nur die
Spalten mit ihren stringifizierten Werten zurückgibt, nicht aber mehr
die ganzen Interna wie z.B. Meta-Informationen enthält.
Arrays und Hashes (und Objekte, die auf diesen simplen Typen basieren
und keine eigene »as_debug_info« zurückgeben) werden rekursiv geklont.
Alles andere definierte wird stringifiziert.
Dafür wurde die Funktion LXDebug::dump_object entfernt, die etwas
Ähnliches gemacht hat, aber nur für eine einzelne Rose-DB-Instanz.