view release on metacpan or  search on metacpan

lib/Tie/InsideOut.pm  view on Meta::CPAN

package Tie::InsideOut;

use 5.006001;
use strict;
use warnings;

use Carp qw( croak );
use Scalar::Util qw( refaddr );

our $VERSION = '0.11';

our @ISA = qw( );

my %NameSpaces;               # default namespace for each hash
my %Keys;                     # tracks defined keys and namespaces

=begin internal

The %Keys hash is structured as follows:

  $Keys{$id}->{$key}->{$namespace}        = $hash_ref

C<$id> refers to the unique object identifier (returned by the L</_get_id> method).

C<$key> refers to the name of the hash key, qhich corresponds to the name of a hash
variable in the C<$namespace>.

C<$namespace> refers to the namespace that the value is in. Encapsulation means
that child classes can use the same key names without conflict.

C<$hash_ref> is a reference to the hash variable that contains the value. Which is
accessible:

  $Keys{$id}->{$key}->{$namespace}->{$id} = $value

We maintain a structure that incidcates where all of the keys are so that we can
clean up the data when the object is destroyed.  It also allows us to serialize
and deserialize data.

=end internal

=cut

sub TIEHASH {
  my $class  = shift || __PACKAGE__;

  my $scalar;
  my $self  = \$scalar;
  bless $self, $class;

  my $id    = $self->_get_id;
  {
    my $caller = shift || (caller)[0];
    no strict 'refs';
    $NameSpaces{$id} = $caller;
  }
  $self->CLEAR;

  return $self;
}

BEGIN {
  *new = \&TIEHASH;
}

sub DESTROY {
  my $self = shift;
  my $id   = $self->_get_id;

  $self->CLEAR;

  delete $Keys{$id};
  delete $NameSpaces{$id};
}

sub CLEAR {
  my $self = shift;
  my $id   = $self->_get_id;

  foreach my $key (keys %{$Keys{$id}}) {
    foreach my $namespace (keys %{$Keys{$id}->{$key}}) {
      delete $Keys{$id}->{$key}->{$namespace}->{$id};
      delete $Keys{$id}->{$key}->{$namespace};
    }
    delete $Keys{$id}->{$key};
  }
  $Keys{$id} = { };
}

sub SCALAR {
  my $self = shift;
  my $id   = $self->_get_id;
  return scalar (%{$Keys{$id}});
}

sub FETCH {
  my $self = shift;
  my $key  = shift;

  my ($id, $hash_ref) = $self->_validate_key($key);
  $hash_ref->{$id};
}

sub EXISTS {
  my $self = shift;
  my $key  = shift;

  my ($id, $hash_ref) = $self->_validate_key($key);
  exists $hash_ref->{$id};
}

# Being able to iterate over the keys is useful, but limited. After version
# 0.04, encapsulation is enforced.