File Coverage

blib/lib/DWH_File/Registry.pm

Criterion	Covered	Total	%
statement	35	35	100.0
branch	4	4	100.0
condition	3	5	60.0
subroutine	9	9	100.0
pod	0	6	0.0
total	51	59	86.4

package DWH_File::Registry;

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

@ISA = qw(  );
$VERSION = 0.01;

sub new {
    my ( $this, $kernel, $property ) = @_;
    my $class = ref $this || $this;
    my $id = $kernel->fetch_property( $property . ':id' );
    unless ( defined $id ) {
        $id = $kernel->next_id;
        $kernel->store_property( $property . ':id', $id );
    }
    my $self = { id => $id,
                 id_mill => DWH_File::ID_Mill->new( $kernel,
						    $property . ':id_mill' ),
                 kernel => $kernel,
                };
    $self->{ id_mill }{ current } ||= 0;
    bless $self, $class;
    return $self;
}

sub save {
    $_[ 0 ]->{ id_mill }->save;
}

sub fetch {
    $_[ 0 ]->{ kernel }->fetch( pack "LaS", $_[ 0 ]->{ id }, '>', $_[ 1 ] );
}

sub fetch_key_pack {
    $_[ 0 ]->{ kernel }->fetch( pack "Laa*", $_[ 0 ]->{ id }, '<', $_[ 1 ] );
}

sub store {
    my ( $self, $subscript, $value ) = @_;
    my $id_p = pack "L", $self->{ id };
    $self->{ kernel }->store( "$id_p>$subscript", $value );
    $self->{ kernel }->store( "$id_p<$value", $subscript );
}

sub get_key {
    my ( $self, $value ) = @_;
    my $key_p = $self->fetch_key_pack( $value );
    my $key;
    if ( defined $key_p ) { $key = unpack "S", $key_p }
    else {
        $key = $self->{ id_mill }->next;
        $key_p = pack "S", $key;
	$self->store( $key_p, $value );
    }
    return $key;
}

1;

__END__