File Coverage

blib/lib/Package/Strictures.pm

Criterion	Covered	Total	%
statement	49	62	79.0
branch	10	18	55.5
condition	2	3	66.6
subroutine	10	10	100.0
pod			n/a
total	71	93	76.3

use 5.006;    #6 = pragmas, our, 5 = qr, 4 = __PACAKGE__,for my
use strict;
use warnings;

package Package::Strictures;

our $VERSION = '1.000001';

# ABSTRACT: Facilitate toggling validation code at users request, without extra performance penalties.

our $AUTHORITY = 'cpan:KENTNL'; # AUTHORITY

use Package::Strictures::Registry;
use Carp ();























































sub import {
  my ( $self, %params ) = @_;
  if ( not %params ) {
    Carp::carp( __PACKAGE__ . ' called with no parameters, skipping magic' );
    return;
  }
  if ( ( not exists $params{-for} ) && ( not exists $params{-from} ) ) {
    Carp::croak( 'no -for or -from parameter to ' . __PACKAGE__ );
  }
  if ( exists $params{-for} ) {
    $self->_setup_for( $params{-for} );
    return;
  }
  if ( exists $params{-from} ) {
    $self->_setup_from( $params{-from} );
    return;
  }
  Carp::croak('Ugh!?');
}

sub _setup_for {
  my ( $self, $params ) = @_;
  my $reftype = ref $params;
  if ( $reftype ne 'HASH' ) {
    Carp::croak("-for presently only takes HASH, got `$reftype`");
  }
  for my $package ( keys %{$params} ) {
    $self->_setup_for_package( $params->{$package}, $package );
  }
  return;
}

sub _setup_from {
  my ( $self, $from ) = @_;
  my $reftype = ref $from;
  if ($reftype) {
    Carp::croak("-from can only take a scalar, not a ref, got `$reftype`");
  }
  ## no critic (RegularExpressions::RequireDotMatchAnything RegularExpressions::RequireLineBoundaryMatching)
  if ( $from =~ /[.]ini$/x ) {
    $self->_setup_from_ini($from);
    return;
  }
  Carp::croak('Only know how to load setup from .ini files at present');
  return;
}

sub _setup_from_ini {
  my ( $self, $from ) = @_;
  require Config::INI::Reader;
  my ($conf) = Config::INI::Reader->read_file($from);
  if ( exists $conf->{'_'} ) {
    Carp::carp("Strictures not addressed at a package found in `$from`");
  }
  $self->_setup_for($conf);
  return;
}

sub _setup_for_package {
  my ( undef, $params, $package ) = @_;
  my $reftype = ref $params;
  if ( $reftype ne 'HASH' ) {
    my $mesg = q[];
    $mesg .= q[-for => { Some::Name => X } presently only takes HASH,];
    $mesg .= q[got `%s` on package `%s` ];
    Carp::croak( sprintf $mesg, $reftype, $package );
  }
  for my $value ( keys %{$params} ) {
    Package::Strictures::Registry->set_value( $package, $value, $params->{$value} );
  }
  return;
}

1;

__END__