File Coverage

blib/lib/DWH_File/Registry/URI.pm

Criterion	Covered	Total	%
statement	38	39	97.4
branch	4	4	100.0
condition	1	3	33.3
subroutine	10	11	90.9
pod	0	6	0.0
total	53	63	84.1

package DWH_File::Registry::URI;

use warnings;
use strict;
use vars qw( @ISA $VERSION %registrands );
use DWH_File::Registry;

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

BEGIN { %registrands = () }

sub new {
    my ( $this, $kernel, $property ) = @_;
    my $class = ref $this || $this;
    my $self = $class->SUPER::new( $kernel, $property );
    $self->{ tags } = {};
    $self->register( $kernel );
    return $self;
}

sub retrieve {
    my ( $self, $tag ) = @_;
    if ( exists $self->{ $tag } ) { return $self->{ $tag } }
    else {
	my $uri = $self->fetch( $tag );
	my $registrand = $registrands{ $uri };
	$self->{ tags }{ $uri } = $tag;
	$self->{ $tag } = $registrand;
	return $registrand;
    }
}

sub register {
    my ( $self, $registrand ) = @_;
    $registrands{ $registrand->uri } = $registrand;
}

sub tag {
    my ( $self, $registrand ) = @_;
    my $uri = $registrand->uri;
    if ( exists $self->{ tags }{ $uri } ) { return $self->{ tags }{ $uri } }
    else {
	my $tag = $self->get_key( $uri );
	$self->{ tags }{ $uri } = $tag;
	$self->{ $tag } = $registrand;
	return $tag;
    }
}

sub release {
    my ( $self, $registrand ) = @_;
    #for my $registry ( @instances ) { $registry->sign_out( $registrand ) }
}

sub sign_out {
    my ( $self, $registrand ) = @_;
    #delete $self->{ tags }{ $registrand->uri };
}

1;

__END__