File Coverage

blib/lib/DWH_File/Tie/Subscripted.pm

Criterion	Covered	Total	%
statement	41	43	95.3
branch	7	8	87.5
condition			n/a
subroutine	12	13	92.3
pod	0	3	0.0
total	60	67	89.5

package DWH_File::Tie::Subscripted;

use warnings;
use strict;
use vars qw( @ISA $VERSION );

use DWH_File::Subscript;
use DWH_File::Value::Factory;
use DWH_File::Tie;

@ISA = qw( DWH_File::Tie );
$VERSION = 0.01;

sub STORE {
    my ( $self, $key, $value_in ) = @_;
    my $subscript = $self->get_subscript( $key );
    my $value = DWH_File::Value::Factory->from_input( $self->{ kernel },
						      $value_in );
    my $node = $self->get_node( $subscript );
    unless ( $node ) {
	$node = $self->node_class->new;
	$self->handle_new_node( $node, $subscript, $value );
    }
    $node->set_value( $value );
    # make lazy
    $self->{ kernel }->store( $subscript, $node );
}

sub FETCH {
    my $subscript = $_[ 0 ]->get_subscript( $_[ 1 ] );
    my $node = $_[ 0 ]->get_node( $subscript ) or return undef;
    return $node->{ value }->actual_value;
}

sub EXISTS {
    my $subscript = $_[ 0 ]->get_subscript( $_[ 1 ] );
    my $node = $_[ 0 ]->get_node( $subscript ) or return 0;
    return 1;
}

sub get_subscript {
    return DWH_File::Subscript->from_input( @_[ 0, 1 ] );
}

sub get_node {
    my ( $self, $subscript ) = @_;
    my $data = $self->{ kernel }->fetch( $subscript );
    if ( $data ) {
	return $self->node_class->from_stored( $self->{ kernel },
					       $data, $subscript );
    }
    else { return undef }
}

sub CLEAR { die "Abstract method called" }

sub vanish {
    my ( $self ) = @_;
    $self->CLEAR;
    $self->{ kernel }->unground( $self );
}

1;

__END__