--- nfo/perl/libs/Data/Mungle/Transform/Deep.pm	2002/12/03 05:34:55	1.3
+++ nfo/perl/libs/Data/Mungle/Transform/Deep.pm	2002/12/05 13:56:49	1.4
@@ -1,8 +1,12 @@
 ##############################################
 #
-#  $Id: Deep.pm,v 1.3 2002/12/03 05:34:55 joko Exp $
+#  $Id: Deep.pm,v 1.4 2002/12/05 13:56:49 joko Exp $
 #
 #  $Log: Deep.pm,v $
+#  Revision 1.4  2002/12/05 13:56:49  joko
+#  - var_deref
+#  + expand - more sophisticated dereferencing with callbacks using Iterate
+#
 #  Revision 1.3  2002/12/03 05:34:55  joko
 #  + bugfix: now utilizing var_utf2iso from Data::Transform::Encode
 #
@@ -27,17 +31,20 @@
 our @ISA = qw( Exporter );
 our @EXPORT_OK = qw(
   &var_NumericalHashToArray
-  &var_deref
   &var_mixin
   &object2hash
   &hash2object
   &refexpr2perlref
+  &expand
 );
+#  &var_deref
 #  &getStructSlotByStringyAddress
 
 use attributes;
 use Data::Dumper;
-use Data::Transform::Encode qw( var_utf2iso );
+use Data::Transform::Encode qw( var_utf2iso var2utf8 scalar2utf8 );
+use libp qw( deep_copy );
+use Iterate;
 
 sub var_NumericalHashToArray {
   my $vref = shift;
@@ -67,15 +74,20 @@
 
 sub var_deref {
   my $obj = shift;
+  my $options = shift;
   my $result;
   if ((ref $obj) eq 'ARRAY') {
     foreach (@{$obj}) {
       my $ref = ref $_;
       if ($ref) {
-        push(@{$result}, var_deref($_));
+        push(@{$result}, var_deref($_, $options));
+        #undef $_;
       } else {
-        push(@{$result}, $_);
+        #push(@{$result}, $_);
+        push(@{$result}, deep_copy($_));
       }
+      #undef $_ if $options->{destroy};
+      #$options->{destroy}->($_) if $options->{destroy};
     }
   # TODO: "} elsif (ref $obj eq 'HASH') { [...] } else { croak 'could not deref blah'; }"  ???
   } else {
@@ -83,16 +95,89 @@
       my $key = $_;
       my $ref = ref $obj->{$_};
       if ($ref) {
-        $result->{$_} = var_deref($obj->{$_});
+        $result->{$_} = var_deref($obj->{$_}, $options);
+        #undef $obj->{$_};
       } else {
-        $result->{$_} = $obj->{$_};
+        #$result->{$_} = $obj->{$_};
+        $result->{$_} = deep_copy($obj->{$_});
       }
+      #undef $obj->{$_} if $options->{destroy};
+      #$options->{destroy}->($obj->{$_}) if $options->{destroy};
     }
   }
+  #undef $obj if $options->{destroy};
+  $options->{cb_destroy}->($obj) if $options->{cb_destroy};
   return $result;
 }
 
 
+sub expand {
+
+  my $obj = shift;
+  my $options = shift;
+  my $result;
+
+  if ((ref $obj) eq 'ARRAY') {
+
+    IterArray @$obj, sub {
+      my $item;
+      # if current item is a reference ...
+      if (ref $_[0]) {
+        # ... expand structure recursively
+        $item = expand($_[0], $options);
+        # destroy item via seperate callback method (a POST) if requested
+        #$options->{cb}->{destroy}->($_[0]) if $options->{destroy};
+
+      # ... assume plain scalar
+      } else {
+        #$item = deep_copy($_[0]);
+        $item = $_[0];
+        # conversions/encodings
+        $item = scalar2utf8($item) if ($item && $options->{utf8});
+      }
+      #push(@{$result}, $item) if $item;   # use item only if not undef  (TODO: make configurable via $options)
+      push(@{$result}, $item);                 # use item in any case
+
+    }
+
+  # TODO: "} elsif (ref $obj eq 'HASH') { [...] } else { croak 'could not deref blah'; }"  ???
+  } else {
+
+    IterHash %$obj, sub {
+      my $item;
+      
+      # if current item is a reference ...
+      if (ref $_[1]) {
+        # ... expand structure recursively
+        $item = expand($_[1], $options);
+        # destroy item via seperate callback method (a POST) if requested
+        #$options->{cb}->{destroy}->($_[1]) if $options->{destroy};
+      
+      # ... assume plain scalar
+      } else {
+        #$item = deep_copy($_[1]);
+        $item = $_[1];
+        # conversions/encodings
+        $item = scalar2utf8($item) if ($item && $options->{utf8});
+      }
+      #$result->{$_[0]} = $item if $item;   # use item only if not undef  (TODO: make configurable via $options)
+      $result->{$_[0]} = $item;               # use item in any case
+    }
+
+  }
+
+  # convert all values to utf8 (inside complex struct)
+    # now done in core-item-callbacks via Greg London's "Iterate" from CPAN
+    # var2utf8($result) if ($options->{utf8});
+
+  # destroy persistent object from memory to be sure to get a fresh one next time
+  #undef $obj if $options->{destroy};
+  #$options->{cb_destroy}->($obj) if $options->{cb_destroy};
+  #$options->{cb}->{destroy}->($obj) if $options->{destroy};
+  
+  return $result;
+}
+
 
 
 my @indexstack;
@@ -143,8 +228,9 @@
 sub object2hash {
   my $object = shift;
   my $options = shift;
-  my $deref = var_deref($object);
-  var2utf8($deref) if ($options->{utf8});
+  #my $deref = var_deref($object);
+  my $deref = expand($object, $options);
+  #var2utf8($deref) if ($options->{utf8});
   return $deref;
 }