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


line stmt bran cond sub pod time code
1             package Module::Hash;
2              
3 3     3   67192 use 5.006;
  3         11  
  3         112  
4 3     3   18 use strict;
  3         6  
  3         159  
5              
6             BEGIN {
7 3     3   6 $Module::Hash::AUTHORITY = 'cpan:TOBYINK';
8 3         68 $Module::Hash::VERSION = '0.001';
9             }
10              
11 3     3   27 use base qw( Tie::Hash );
  3         5  
  3         3070  
12 3     3   3097 use Carp qw( croak );
  3         7  
  3         123  
13 3     3   2670 use Module::Runtime qw( use_package_optimistically use_module );
  3         5422  
  3         20  
14              
15             # Tied interface
16             #
17              
18             sub TIEHASH
19             {
20 4     4   18 my $class = shift;
21 4         61 return $class->new(@_);
22             }
23              
24             sub STORE
25             {
26 0     0   0 croak "Attempt to modify read-only hash, caught";
27             }
28              
29             sub FETCH
30             {
31 4     4   30017 my ($self, $key) = @_;
32 4         16 return $self->use($key);
33             }
34              
35             sub FIRSTKEY
36             {
37 0     0   0 return;
38             }
39              
40             sub NEXTKEY
41             {
42 0     0   0 return;
43             }
44              
45             sub EXISTS
46             {
47 0     0   0 my ($self, $key) = @_;
48 0         0 defined $self->use($key);
49             }
50              
51             sub DELETE
52             {
53 0     0   0 croak "Attempt to modify read-only hash, caught";
54             }
55              
56             sub CLEAR
57             {
58 0     0   0 croak "Attempt to modify read-only hash, caught";
59             }
60              
61             sub SCALAR
62             {
63 0     0   0 return !!1;
64             }
65              
66             # Object-oriented interface
67             #
68              
69             sub new
70             {
71 4     4 1 6 my $class = shift;
72 4 50       19 my %args = ref $_[0] eq 'HASH' ? %{$_[0]} : @_;
  0         0  
73            
74             # Defaults
75 4 50       18 $args{optimistic} = 1 unless exists $args{optimistic};
76            
77 4         4364 bless \%args, $class;
78             }
79              
80 4     4 1 31 sub optimistic { $_[0]{optimistic} };
81 0     0 1 0 sub prefix { $_[0]{prefix} };
82 4     4 1 37 sub has_prefix { exists $_[0]{prefix} };
83              
84             sub use
85             {
86 4     4 1 8 my ($self, $module) = @_;
87            
88 4         33 my @mv = grep /\w/, split /\s/, $module;
89 4 50       19 croak "No module name given" unless @mv;
90            
91 4 50       15 $mv[0] = join(q[::], $self->prefix, $mv[0]) if $self->has_prefix;
92            
93 4 50       16 $self->optimistic ? &use_package_optimistically(@mv) : &use_module(@mv);
94 4         51209 return $mv[0];
95             }
96              
97             # Import-oriented interface
98             #
99              
100             sub import
101             {
102 5     5   37 my $class = shift;
103 5         1918 tie %$_, $class for @_;
104             }
105              
106             1
107             __END__