File Coverage

blib/lib/Hub/Knots/Object.pm

Criterion	Covered	Total	%
statement	6	61	9.8
branch	0	8	0.0
condition	0	8	0.0
subroutine	2	14	14.2
pod			n/a
total	8	91	8.7

package Hub::Knots::Object;
use strict;
use Hub qw/:lib/;
our $VERSION = '4.00043';
our @EXPORT = qw//;
our @EXPORT_OK = qw//;

# ------------------------------------------------------------------------------
# _access - Direct access to members
# ------------------------------------------------------------------------------

sub _access {
  my $self = shift;
  my $index = shift;
  return $self->{$index};
}#_access

# ------------------------------------------------------------------------------
# _keyname - Determine which key (public or private) to use
# ------------------------------------------------------------------------------

sub _keyname {
  my $self = shift;
  my $index = shift;
  my $datakey = defined $index &&
    $$index =~ s/^(internal|public|private):// ? $1 : ();
  my $called_from = caller(1);
  $datakey ||= $self->{'internal'}{'impl'}->isa($called_from) ? 'private' : 'public';
  return $datakey;
}#_keyname

# ------------------------------------------------------------------------------
# TIEHASH - Tie interface method
# ------------------------------------------------------------------------------

sub TIEHASH {
  my $self = shift;
  my $impl = shift;
  my $obj = bless {
    'internal'  => { impl => $impl }, # neither public or private
    'public'    => {},
    'private'   => {},
  }, $self;
  return $obj;
}#TIEHASH

# ------------------------------------------------------------------------------
# FETCH - Tie interface method
# ------------------------------------------------------------------------------

sub FETCH {
  my $self = shift;
  my $index = shift;
  my $datakey = $self->_keyname( \$index );
  return $index ? $self->{$datakey}->{$index} : $self->{$datakey};
}#FETCH

# ------------------------------------------------------------------------------
# STORE - Tie interface method
# ------------------------------------------------------------------------------

sub STORE {
  my $self = shift;
  my $index = shift;
  my $value = shift;
  my $datakey = $self->_keyname( \$index );
  $index ? $self->{$datakey}->{$index} = $value : $self->{$datakey} = $value;
}#STORE

# ------------------------------------------------------------------------------
# DELETE - Tie interface method
# ------------------------------------------------------------------------------

sub DELETE {
  my $self = shift;
  my $index = shift;
  my $datakey = $self->_keyname( \$index );
  delete $self->{$datakey}->{$index};
}#DELETE

# ------------------------------------------------------------------------------
# CLEAR - Tie interface method
# ------------------------------------------------------------------------------

sub CLEAR {
  my $self = shift;
  my $datakey = $self->_keyname();
  my @reset = keys %{$self->{$datakey}};
  map { delete $self->{$datakey}->{$_} } keys %{$self->{$datakey}};
}#CLEAR

# ------------------------------------------------------------------------------
# EXISTS - Tie interface method
# ------------------------------------------------------------------------------

sub EXISTS {
  my $self = shift;
  my $index = shift;
  my $datakey = $self->_keyname( \$index );
  exists $self->{$datakey}->{$index};
}#EXISTS

# ------------------------------------------------------------------------------
# FIRSTKEY - Tie interface method
# ------------------------------------------------------------------------------

sub FIRSTKEY {
  my $self = shift;
  my $datakey = $self->_keyname();
  my @reset = keys %{$self->{$datakey}};
  each %{$self->{$datakey}};
}#FIRSTKEY

# ------------------------------------------------------------------------------
# NEXTKEY - Tie interface method
# ------------------------------------------------------------------------------

sub NEXTKEY {
  my $self = shift;
  my $lastindex = shift;
  my $datakey = $self->_keyname();
  each %{$self->{$datakey}};
}#NEXTKEY

# ------------------------------------------------------------------------------
# SCALAR - Tie interface method
# ------------------------------------------------------------------------------

sub SCALAR {
  my $self = shift;
  my $datakey = $self->_keyname();
  scalar %{$self->{$datakey}};
}#SCALAR

# ------------------------------------------------------------------------------
# UNTIE - Tie interface method
# ------------------------------------------------------------------------------

sub UNTIE {
  my $self = shift;
  my $count = shift || 0;
  my $datakey = $self->_keyname();
}#UNTIE

1;

__END__