Deep.pm.patch

   1 --- DBM-Deep-0.983/lib/DBM/Deep.pm      2006-04-10 21:59:17.000000000 -0500
   2 +++ DBM-Deep-0.983_copy/lib/DBM/Deep.pm 2006-06-15 10:15:07.569349000 -0500
   3 @@ -149,7 +149,9 @@
   4                 tie %$self, $class, %$args;
   5         }
   6
   7 -       return bless $self, $class;
   8 +    bless $self, $class;
   9 +    $self->_set_ref($self);
  10 +    return $self;
  11  }
  12
  13  sub _init {
  14 @@ -604,6 +606,8 @@
  15                                 root => $root,
  16                         };
  17              %$value = %x;
  18 +            bless $value, 'DBM::Deep::Hash';
  19 +            $value->_set_ref($value);
  20                 }
  21                 elsif ($r eq 'ARRAY') {
  22              my @x = @$value;
  23 @@ -613,6 +617,8 @@
  24                                 root => $root,
  25                         };
  26              @$value = @x;
  27 +            bless $value, 'DBM::Deep::Array';
  28 +            $value->_set_ref($value);
  29                 }
  30
  31                 return $result;
  32 @@ -663,7 +669,8 @@
  33          # If value is a hash or array, return new DBM::Deep object with correct offset
  34          ##
  35          if (($signature eq TYPE_HASH) || ($signature eq TYPE_ARRAY)) {
  36 -            my $obj = DBM::Deep->new(
  37 +            my $obj = $self->_get_ref($subloc);
  38 +            $obj ||= DBM::Deep->new(
  39                  type => $signature,
  40                  base_offset => $subloc,
  41                  root => $self->_root
  42 @@ -1221,6 +1228,20 @@
  43         return $self->{base_offset};
  44  }
  45
  46 +sub _set_ref {
  47 +    my $self = $_[0]->_get_self;
  48 +    my $base_offset = $self->_base_offset;
  49 +    my $refs = $self->_root->{refs};
  50 +    $refs->{$base_offset} = $_[1];
  51 +    Scalar::Util::weaken $refs->{$base_offset};
  52 +}
  53 +
  54 +sub _get_ref {
  55 +    my $self = $_[0]->_get_self;
  56 +    my $refs = $self->_root->{refs};
  57 +    return $refs->{ $_[1] };
  58 +}
  59 +
  60  sub error {
  61         ##
  62         # Get last error string, or undef if no error
  63 @@ -1585,6 +1606,7 @@
  64          filter_fetch_value => undef,
  65          autobless => undef,
  66          locked => 0,
  67 +        refs => {},
  68          %$args,
  69      }, $class;
  70
  71