File Coverage

blib/lib/Package/Strictures/Registry.pm
Criterion Covered Total %
statement 40 42 95.2
branch 6 10 60.0
condition n/a
subroutine 14 14 100.0
pod 4 4 100.0
total 64 70 91.4


line stmt bran cond sub pod time code
1 6     6   685 use 5.006; # 6 = pragmas, our, 5 = list undef.
  6         15  
2 6     6   26 use strict;
  6         9  
  6         135  
3 6     6   24 use warnings;
  6         8  
  6         527  
4              
5             package Package::Strictures::Registry;
6              
7             our $VERSION = '1.000001';
8              
9             # ABSTRACT: Data Storage name-space for stricture parameters.
10              
11             our $AUTHORITY = 'cpan:KENTNL'; # AUTHORITY
12              
13 6     6   25 use Carp ();
  6         8  
  6         2929  
14              
15             my $_registry_store = {};
16              
17             sub _has_package {
18 7     7   12 my ( undef, $package ) = @_;
19 7         32 return exists $_registry_store->{$package};
20             }
21              
22             sub _set_package {
23 2     2   3 my ( undef, $package, $value ) = @_;
24 2         4 return $_registry_store->{$package} = $value;
25             }
26              
27             sub _get_package {
28 8     8   11 my ( undef, $package ) = @_;
29 8         36 return $_registry_store->{$package};
30             }
31              
32             my $_advertisements = {};
33              
34             sub _has_advert {
35 3     3   6 my ( undef, $package ) = @_;
36 3         12 return exists $_advertisements->{$package};
37             }
38              
39             sub _set_advert {
40 3     3   6 my ( undef, $package, $value ) = @_;
41 3         9 return $_advertisements->{$package} = $value;
42             }
43              
44             sub _get_advert {
45 6     6   10 my ( undef, $package ) = @_;
46 6         14 return $_advertisements->{$package};
47             }
48              
49              
50              
51              
52              
53              
54              
55              
56              
57              
58              
59              
60              
61              
62             sub advertise_value {
63 3     3 1 5 my ( $self, $package, $name ) = @_;
64 3 50       7 if ( not $self->_has_advert($package) ) {
65 3         10 $self->_set_advert( $package, {} );
66             }
67 3 50       8 if ( not exists $self->_get_advert($package)->{$name} ) {
68 3         9 $self->_get_advert($package)->{$name} = \$name;
69             }
70             else {
71 0         0 Carp::croak("` $package :: $name` is already advertised!");
72             }
73 3         8 return;
74             }
75              
76              
77              
78              
79              
80              
81              
82              
83              
84              
85              
86             sub has_value {
87 5     5 1 8 my ( $self, $package, $name ) = @_;
88 5 100       14 return unless ( $self->_has_package($package) );
89 4         11 return exists $self->_get_package($package)->{$name};
90             }
91              
92              
93              
94              
95              
96              
97              
98              
99              
100              
101              
102              
103             sub get_value {
104 2     2 1 4 my ( $self, $package, $name ) = @_;
105 2 50       5 if ( not $self->has_value( $package, $name ) ) {
106 0         0 Carp::croak("Error: package `$package` is not in the registry");
107             }
108 2         5 return $self->_get_package($package)->{$name};
109             }
110              
111              
112              
113              
114              
115              
116              
117              
118              
119              
120              
121             sub set_value {
122 2     2 1 5 my ( $self, $package, $name, $value ) = @_;
123 2 50       6 if ( not $self->_has_package($package) ) {
124 2         6 $self->_set_package( $package, {} );
125             }
126 2         7 $self->_get_package($package)->{$name} = $value;
127 2         6 return;
128             }
129              
130             1;
131              
132             __END__