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.

diff --git a/SL/DB/Object.pm b/SL/DB/Object.pm
index 06596dd..c258761 100755 (executable)
--- a/SL/DB/Object.pm
+++ b/SL/DB/Object.pm
@@ -252,6 +252,19 @@ sub presenter {
   }
 }
 
+sub as_debug_info {
+  my ($self) = @_;
+
+  return {
+    map {
+      my $column_name = $_->name;
+      my $value       = $self->$column_name;
+      $value          = !defined($value) ? undef : "${value}";
+      ($_ => $value)
+    } $self->meta->columns
+  };
+}
+
 1;
 
 __END__
@@ -383,6 +396,12 @@ with the same name as the class of the involking object.
 For the full documentation about its capabilites see
 L<SL::DB::Helper::Presenter>
 
+=item C<as_debug_info>
+
+Returns a hash containing solely the essentials for dumping it with
+L<LXDebug/dump>. The returned hash consists of the column names with
+associated column values in stringified form.
+
 =back
 
 =head1 AUTHOR

diff --git a/SL/LXDebug.pm b/SL/LXDebug.pm
index e0b7cca..cedd5ba 100644 (file)
--- a/SL/LXDebug.pm
+++ b/SL/LXDebug.pm
@@ -20,6 +20,7 @@ use constant STDERR_TARGET => 1;
 
 use Data::Dumper;
 use POSIX qw(strftime getpid);
+use Scalar::Util qw(blessed reftype);
 use Time::HiRes qw(gettimeofday tv_interval);
 use YAML;
 use SL::Request ();
@@ -156,15 +157,20 @@ sub warn {
   $self->message(WARN, $message);
 }
 
+sub _clone_for_dump {
+  my ($src) = @_;
+
+  return undef unless defined($src);
+  return $src->as_debug_info                                            if blessed($src) && $src->can('as_debug_info');
+  return [ map { _clone_for_dump($_) } @{ $src } ]                      if reftype($src) eq 'ARRAY';
+  return { map { ($_ => _clone_for_dump($src->{$_})) } keys %{ $src } } if reftype($src) eq 'HASH';
+  return "$src";
+}
+
 sub dump {
   my ($self, $level, $name, $variable, %options) = @_;
 
-  my $password;
-  if ($variable && ('Form' eq ref $variable) && defined $variable->{password}) {
-    $password             = $variable->{password};
-    $variable->{password} = 'X' x 8;
-  }
-
+  $variable  = _clone_for_dump($variable);
   my $dumper = Data::Dumper->new([$variable]);
   $dumper->Sortkeys(1);
   $dumper->Indent(2);
@@ -172,15 +178,6 @@ sub dump {
   my $output = $dumper->Dump();
   $self->message($level, "dumping ${name}:\n" . $output);
 
-  $variable->{password} = $password if (defined $password);
-
-  # Data::Dumper does not reset the iterator belonging to this hash
-  # if 'Sortkeys' is true. Therefore clear the iterator manually.
-  # See "perldoc -f each".
-  if ($variable && (('HASH' eq ref $variable) || ('Form' eq ref $variable))) {
-    keys %{ $variable };
-  }
-
   return $output;
 }
 
@@ -218,17 +215,6 @@ sub dump_sql_result {
   $self->message($level, $prefix . sprintf('(%d row%s)', scalar @{ $results }, scalar @{ $results } > 1 ? 's' : ''));
 }
 
-sub dump_object {
-  my ($self, $level, $text, $object) = @_;
-
-  my $copy;
-  if ($object) {
-    $copy->{$_} = $object->$_ for $object->meta->columns;
-  }
-
-  $self->dump($level, $text, $copy);
-}
-
 sub show_diff {
   my ($self, $level, $item1, $item2, %params) = @_;