File Coverage

lib/Package/Strictures.pm
Criterion Covered Total %
statement 53 66 80.3
branch 10 18 55.5
condition 2 3 66.6
subroutine 11 11 100.0
pod n/a
total 76 98 77.5


line stmt bran cond sub pod time code
1 3     3   71427 use 5.008; # 8 = utf8, 6 = pragmas, our, 5 = qr, 4 = __PACAKGE__,for my
  3         14  
  3         122  
2 3     3   16 use strict;
  3         7  
  3         94  
3 3     3   27 use warnings;
  3         5  
  3         93  
4 3     3   3039 use utf8;
  3         35  
  3         21  
5              
6             package Package::Strictures;
7             $Package::Strictures::VERSION = '1.000000';
8             # ABSTRACT: Facilitate toggling validation code at users request, without extra performance penalties.
9              
10             our $AUTHORITY = 'cpan:KENTNL'; # AUTHORITY
11              
12 3     3   2014 use Package::Strictures::Registry;
  3         7  
  3         84  
13 3     3   19 use Carp ();
  3         5  
  3         2597  
14              
15              
16              
17              
18              
19              
20              
21              
22              
23              
24              
25              
26              
27              
28              
29              
30              
31              
32              
33              
34              
35              
36              
37              
38              
39              
40              
41              
42              
43              
44              
45              
46              
47              
48              
49              
50              
51              
52              
53              
54              
55              
56              
57              
58              
59              
60              
61              
62              
63              
64              
65              
66              
67              
68              
69             sub import {
70 2     2   30 my ( $self, %params ) = @_;
71 2 50       17 if ( not %params ) {
72 0         0 Carp::carp( __PACKAGE__ . ' called with no parameters, skipping magic' );
73 0         0 return;
74             }
75 2 50 66     14 if ( ( not exists $params{-for} ) && ( not exists $params{-from} ) ) {
76 0         0 Carp::croak( 'no -for or -from parameter to ' . __PACKAGE__ );
77             }
78 2 100       10 if ( exists $params{-for} ) {
79 1         5 $self->_setup_for( $params{-for} );
80 1         26 return;
81             }
82 1 50       4 if ( exists $params{-from} ) {
83 1         6 $self->_setup_from( $params{-from} );
84 1         167 return;
85             }
86 0         0 Carp::croak('Ugh!?');
87             }
88              
89             sub _setup_for {
90 2     2   4 my ( $self, $params ) = @_;
91 2         7 my $reftype = ref $params;
92 2 50       8 if ( $reftype ne 'HASH' ) {
93 0         0 Carp::croak("-for presently only takes HASH, got `$reftype`");
94             }
95 2         5 for my $package ( keys %{$params} ) {
  2         11  
96 2         11 $self->_setup_for_package( $params->{$package}, $package );
97             }
98 2         6 return;
99             }
100              
101             sub _setup_from {
102 1     1   2 my ( $self, $from ) = @_;
103 1         2 my $reftype = ref $from;
104 1 50       4 if ($reftype) {
105 0         0 Carp::croak("-from can only take a scalar, not a ref, got `$reftype`");
106             }
107             ## no critic (RegularExpressions::RequireDotMatchAnything RegularExpressions::RequireLineBoundaryMatching)
108 1 50       7 if ( $from =~ /[.]ini$/x ) {
109 1         4 $self->_setup_from_ini($from);
110 1         3 return;
111             }
112 0         0 Carp::croak('Only know how to load setup from .ini files at present');
113 0         0 return;
114             }
115              
116             sub _setup_from_ini {
117 1     1   3 my ( $self, $from ) = @_;
118 1         1017 require Config::INI::Reader;
119 1         75117 my ($conf) = Config::INI::Reader->read_file($from);
120 1 50       682 if ( exists $conf->{'_'} ) {
121 0         0 Carp::carp("Strictures not addressed at a package found in `$from`");
122             }
123 1         10 $self->_setup_for($conf);
124 1         4 return;
125             }
126              
127             sub _setup_for_package {
128 2     2   7 my ( undef, $params, $package ) = @_;
129 2         5 my $reftype = ref $params;
130 2 50       7 if ( $reftype ne 'HASH' ) {
131 0         0 my $mesg = q[];
132 0         0 $mesg .= q[-for => { Some::Name => X } presently only takes HASH,];
133 0         0 $mesg .= q[got `%s` on package `%s` ];
134 0         0 Carp::croak( sprintf $mesg, $reftype, $package );
135             }
136 2         4 for my $value ( keys %{$params} ) {
  2         8  
137 2         16 Package::Strictures::Registry->set_value( $package, $value, $params->{$value} );
138             }
139 2         7 return;
140             }
141              
142             1;
143              
144             __END__