File Coverage

blib/lib/Hub/Knots/TiedObject.pm

Criterion	Covered	Total	%
statement	29	37	78.3
branch	2	2	100.0
condition	0	2	0.0
subroutine	9	13	69.2
pod			n/a
total	40	54	74.0

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

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

sub _key {
  my $index = shift;
  local $1;
  return $index =~ /^\*(.*)/ ? ('private',$1) : ('public',$index);
}

# ------------------------------------------------------------------------------
# TIEHASH - Tie interface method
# TIEHASH 'Hub::Knots::TiedObject', $PACKAGE
# ------------------------------------------------------------------------------

sub TIEHASH {
  my $self = shift;
  my $pkg_name = shift;
  my %data = ();
  my $obj = bless {
    'public' => \%data,
    'private' => {
      'tied' => tie(%data, $pkg_name),
      'public' => \%data,
    },
  }, $self;
  return $obj;
}

# ------------------------------------------------------------------------------
# FETCH - Return a value
# ------------------------------------------------------------------------------

sub FETCH {
  my $self = shift;
  my $index = shift;
  my ($namespace,$key) = _key($index);
  return $self->{$namespace}->{$key};
}

# ------------------------------------------------------------------------------
# STORE - Store a value
# ------------------------------------------------------------------------------

sub STORE {
  my $self = shift;
  my $index = shift;
  my $value = shift;
  my ($namespace,$key) = _key($index);
  $self->{$namespace}->{$key} = $value;
}

# ------------------------------------------------------------------------------
# DELETE - Remove a value
# ------------------------------------------------------------------------------

sub DELETE {
  my $self = shift;
  my $index = shift;
  my ($namespace,$key) = _key($index);
  delete $self->{$namespace}->{$key};
}#DELETE

# ------------------------------------------------------------------------------
# CLEAR - Remove all public values
# ------------------------------------------------------------------------------

sub CLEAR {
  $_[0]->{'private'}{'tied'}->CLEAR(@_);
}

# ------------------------------------------------------------------------------
# EXISTS - Boolean test for value
# ------------------------------------------------------------------------------

sub EXISTS {
  my $self = shift;
  my $index = shift;
  my ($namespace,$key) = _key($index);
  exists $self->{$namespace}->{$key};
}

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

sub FIRSTKEY {
  $_[0]->{'private'}{'tied'}->FIRSTKEY(@_);
}

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

sub NEXTKEY {
  $_[0]->{'private'}{'tied'}->NEXTKEY(@_);
}

# ------------------------------------------------------------------------------
# SCALAR - Scalar representation
# ------------------------------------------------------------------------------

sub SCALAR {
  $_[0]->{'private'}{'tied'}->SCALAR(@_);
}

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

sub UNTIE {
  my $self = shift;
  my $count = shift || 0;
}

# ------------------------------------------------------------------------------
1;

__END__