Changeset 2267 for trunk/LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Objects.pm

Timestamp:

06/19/19 20:02:16 (5 years ago)

Author:

nanardon

Message:

Add a way to dump object and all related objects

File:

• trunk/LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Objects.pm (modified) (3 diffs)

trunk/LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Objects.pm

@@ -839 +839 @@
     my ($self, $config, $base) = @_;
 
+    $config->{level} ||= 0;
     my $otype = $self->type;
     $base ||= $self->base;
     my $dump;
     if (ref $self) {
-        $dump .= sprintf "# base %s: object %s/%s\n",
+        $dump .= sprintf "%s# base %s: object %s/%s\n",
+            ' ' x $config->{level},
             $base->label, $self->type, $self->id;
     }
-    $dump .= sprintf "# %s\n", scalar(localtime);
+    $dump .= sprintf(
+        "%s# %s\n", 
+        ' ' x $config->{level},
+        scalar(localtime)
+    );
 
     foreach my $attr (sort { $a cmp $b } $base->list_canonical_fields($otype,
@@ -866 +872 @@
                     $_ ||= '';
                     s/\r?\n/\\n/g;
-                    $dump .= sprintf("%s%s:%s\n", 
+                    $dump .= sprintf("%s%s%s%s:%s\n",
+                        ' ' x $config->{level},
                         $oattr->ro ? '# (ro) ' : '',
+                        $config->{level} ? $self->type . '[' . $self->id . '].' : '',
                         $attr, $_ ? " $_" : '');
                 }
@@ -883 +891 @@
         }
     }
+
+    if (ref $self && $config->{recur}) {
+          my %subobj = $self->ListChildObjects;
+          foreach my $otype (keys %subobj) {
+              foreach my $oname (sort @{ $subobj{$otype} }) {
+                  my $obj = $self->base->get_object($otype, $oname) or next;
+                  $dump .= "\n";
+                  $dump .= $obj->dump({ %{$config || {}}, recur => $config->{recur}, level => $config->{level} + 2 });
+              }
+          }
+    }
+
     return $dump;
 }