File Coverage

blib/lib/LWP/ConnCache/Resolving.pm

Criterion	Covered	Total	%
statement	12	40	30.0
branch	0	10	0.0
condition	0	9	0.0
subroutine	4	9	44.4
pod	3	3	100.0
total	19	71	26.7

package LWP::ConnCache::Resolving;

use strict;
use warnings;

use Carp;

use base 'LWP::ConnCache';

our $VERSION = '0.02';

sub new {
	my $class = shift;
	my $self = LWP::ConnCache->new(@_);

	bless $self, $class;
	$self->_initialize(@_);
	return $self;
}

sub _initialize
{
	my $self = shift;

	my %params = @_;

	$self->{resolver} = $params{resolver};

	unless ($self->{resolver} && ref($self->{resolver}) eq 'CODE')
	{
		croak "You must specify a resolver. Otherwise, just use LWP::ConnCache.";
	}

	# do_res_cache will default to yes - disable it if your resolution is very fast
	$self->{do_res_cache} = defined($params{do_res_cache}) ? $params{do_res_cache} : 1;
	$self->{res_cache} = {};
}

sub deposit {
	my($self, $type, $key, $conn) = @_;
	return ($self->SUPER::deposit($type, $self->_get_resolved_key($key), $conn));
}

sub withdraw {
	my($self, $type, $key) = @_;
	return ($self->SUPER::withdraw($type, $self->_get_resolved_key($key)));
}

sub _get_resolved_key
{
	my $self = shift;
	my $key = shift;

	my $newkey;

	if ($self->{do_res_cache})
	{
		$newkey = $self->{res_cache}->{$key};
		return $newkey if $newkey;
	}

	eval
	{
		$newkey = &{$self->{resolver}}($key);
	};

	if ($self->{do_res_cache})
	{
		$self->{res_cache}->{$key} = $newkey || $key;
	}

	return $newkey || $key;
}


1;
__END__