File Coverage

blib/lib/Module/Hash.pm

Criterion	Covered	Total	%
statement	35	45	77.7
branch	5	10	50.0
condition			n/a
subroutine	13	21	61.9
pod	5	5	100.0
total	58	81	71.6

package Module::Hash;

use 5.006;
use strict;

BEGIN {
	$Module::Hash::AUTHORITY = 'cpan:TOBYINK';
	$Module::Hash::VERSION   = '0.002';
}

use base qw( Tie::Hash );
use Carp qw( croak );
use Module::Runtime qw( use_package_optimistically use_module );

# Tied interface
#

sub TIEHASH
{
	my $class = shift;
	return $class->new(@_);
}

sub STORE
{
	croak "Attempt to modify read-only hash, caught";
}

sub FETCH
{
	my ($self, $key) = @_;
	return $self->use($key);
}

sub FIRSTKEY
{
	return;
}

sub NEXTKEY
{
	return;
}

sub EXISTS
{
	my ($self, $key) = @_;
	defined $self->use($key);
}

sub DELETE
{
	croak "Attempt to modify read-only hash, caught";
}

sub CLEAR
{
	croak "Attempt to modify read-only hash, caught";
}

sub SCALAR
{
	return !!1;
}

# Object-oriented interface
#

sub new
{
	my $class = shift;
	my %args  = ref $_[0] eq 'HASH' ? %{$_[0]} : @_;

	# Defaults
	$args{optimistic} = 1 unless exists $args{optimistic};

	bless \%args, $class;
}

sub optimistic { $_[0]{optimistic} };
sub prefix     { $_[0]{prefix} };
sub has_prefix { exists $_[0]{prefix} };

sub use
{
	my ($self, $module) = @_;

	my @mv = grep /\w/, split /\s/, $module;
	croak "No module name given" unless @mv;

	$mv[0] = join(q[::], $self->prefix, $mv[0]) if $self->has_prefix;

	$self->optimistic ? &use_package_optimistically(@mv) : &use_module(@mv);
	return $mv[0];
}

# Import-oriented interface
#

sub import
{
	my $class = shift;
	tie %$_, $class for @_;
}

1
__END__