File Coverage

blib/lib/Ref/Store/Feature/KeyTyped.pm

Criterion	Covered	Total	%
statement	41	43	95.3
branch	3	6	50.0
condition	1	3	33.3
subroutine	10	10	100.0
pod	0	1	0.0
total	55	63	87.3

package Ref::Store::Feature::KeyTyped;
use strict;
use warnings;
our $AUTOLOAD;
use Log::Fu;
use Carp qw(confess);
use Data::Dumper;
use Ref::Store::Common;

$SIG{__DIE__} = \&confess;
BEGIN {
	foreach my $fname (qw(
		store
		fetch
		purgeby
		unlink
		lexists
	)) {
		my $wrapname = $fname . "_kt";
		{
			no strict 'refs';
			*{$wrapname} = sub {
				my @args = @_;
				my $self = $args[0];
				my ($ktarg) = splice(@args, 2, 1);
				my $pfix = $self->get_kt_prefix($ktarg, "$fname: Can't find prefix ($ktarg)!");
				my $orig = $args[1];
				die "Must have defined key!" unless defined $orig;
				if(!ref $orig) {
					$orig = $pfix . HR_PREFIX_DELIM . $orig;
					$args[1] = $orig;
				} else {
					log_warn("Using keytypes with object key has no effect");
				}
				shift @args;
				return $self->$fname(@args);
			};
		}
	}
}

sub get_kt_prefix {
	my ($self,$kt,$do_die) = @_;
	my $ret = $self->keytypes->{$kt};
	if((!$ret) && $do_die) {
		die $do_die;
	}
	return $ret;
}
1;