File Coverage

blib/lib/Tie/Discovery.pm

Criterion	Covered	Total	%
statement	34	36	94.4
branch	4	6	66.6
condition			n/a
subroutine	12	13	92.3
pod	2	2	100.0
total	52	57	91.2

package Tie::Discovery;

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

$VERSION = '1.11';
@ISA = 'Tie::StdHash';

use Carp;
use Tie::Hash;
use constant SELF  => 0;
use constant KEY   => 1;
use constant VALUE => 2;

sub TIEHASH {
    return bless { debug => 0 }, shift;
}

sub STORE {
    carp "Please don't do this. Use \$obj->store or \$obj->register instead.";
    store(@_);
}

sub store { # ($$$)
    $_[SELF]{ $_[KEY] } = $_[VALUE];
}

sub register { # ($$\&)
    UNIVERSAL::isa($_[VALUE] => 'CODE')
        or croak "Second argument to register() should be coderef";
    $_[SELF]{ $_[KEY] } = $_[VALUE];
}

sub FETCH {
    my $value = $_[SELF]{ $_[KEY] };
    while (UNIVERSAL::isa($value, 'CODE')) {
        print STDERR "(Discovering $_[KEY]... " if $_[SELF]{debug} > 0;
        $value = $_[SELF]{ $_[KEY] } = $value->(@_);
        print STDERR ")" if $_[SELF]->{debug} > 0;
    }
    return $value;
}

1;
__END__