File Coverage

lib/CHI/Config.pm

Criterion	Covered	Total	%
statement	71	86	82.5
branch	14	28	50.0
condition	2	6	33.3
subroutine	16	18	88.8
pod	0	2	0.0
total	103	140	73.5

use 5.006;
use strict;
use warnings;

package CHI::Config;

our $VERSION = '0.001001'; # TRIAL

# ABSTRACT: Define CHI configuration outside your code

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

use Carp qw( croak );
use Moo qw( has around );

has '_constructor_caller' => (
  is       => 'ro',
  required => 1,
);

has '_config_paths' => (
  init_arg => 'config_paths',
  is       => 'ro',
  lazy     => 1,
  builder  => '_build_config_paths',
);

has '_config_files' => (
  init_arg => 'config_files',
  is       => 'ro',
  lazy     => 1,
  builder  => '_build_config_files',
);

has '_config' => (
  init_arg => undef,
  is       => 'ro',
  lazy     => 1,
  builder  => '_build_config',
);

has '_defaults' => (
  init_arg => 'defaults',
  is       => ro =>,
  lazy     => 1,
  builder  => '_build_defaults',
);

has '_drivers' => (
  is       => 'ro',
  init_arg => undef,
  lazy     => 1,
  builder  => '_build_drivers',
  handles  => {
    '_add_driver' => 'add_driver',
    '_get_driver' => 'get_driver',
    'get_cache'   => 'get_cache',
  },
);

sub BUILDARGS {
  my ( undef, @args ) = @_;
  my (@caller) = caller 1;    # +1 for Moo
  if ( 1 == @args and ref $args[0] ) {
    $args[0]->{_constructor_caller} = $caller[1];
    return $args[0];
  }
  return { @args, _constructor_caller => $caller[1] };
}

sub BUILD {
  my ($self) = @_;
  ## no critic (Variables::ProhibitPackageVars)
  local $Carp::CarpLevel = $Carp::CarpLevel + 1;
  $self->_load_config;
  $self->_load_defaults;
  return;
}

sub _build_config_paths {
  require File::HomeDir;
  my (@scan_paths) = (
    ( exists $ENV{CHI_CONFIG_DIR} ? $ENV{CHI_CONFIG_DIR} . '/config' : () ),    # From ENV
    './chi_config',                                                             # ./
    File::HomeDir->my_home . '/.chi/config',                                    # ~/.chi/
    '/etc/chi/config',                                                          # /etc/chi/
  );
  return \@scan_paths;
}

sub _build_config_files { return [] }

sub _build_config {
  my ($self) = @_;
  require Config::Any;
  my %extras = ( use_ext => 1 );
  return Config::Any->load_files( { files => $self->_config_files, %extras } ) if @{ $self->_config_files };
  return Config::Any->load_stems( { stems => $self->_config_paths, %extras } );
}

sub _build_defaults {
  return [];
}

sub _build_drivers {
  require CHI::Config::DriverPool;
  return CHI::Config::DriverPool->new();
}

sub _load_version {
  my ( undef, %entry ) = @_;

  my $spec      = '0.1.0';
  my $entry_msg = "$entry{file} ( entry #$entry{entry_no} )";

  if ( $entry{spec} and $entry{spec} ne $spec ) {
    croak "Spec version required by $entry_msg is ==$entry{spec}, this is $spec";
  }
  if ( $entry{min} ) {
    require version;
    my $min = version->parse( $entry{min} );
    if ( $min > $VERSION ) {
      croak "Minimum version required by $entry_msg is $min, we have $VERSION";
    }
  }
  if ( $entry{max} ) {
    require version;
    my $max = version->parse( $entry{max} );
    if ( $max < $VERSION ) {
      croak "Maximum version required by $entry_msg is $max, we have $VERSION";
    }
  }
  return;
}

sub _load_entry {
  my ( $self, %entry ) = @_;
  my $context = sprintf q[%s ( entry #%s )], $entry{file}, $entry{entry_no};
  my $name = ( $entry{name} ? q[ named ] . $entry{name} : q[ ] );
  croak "No type specified for entry$name in $context" unless defined $entry{type};
  return $self->_load_version(%entry) if 'version' eq $entry{type};
  return $self->_add_driver(%entry)   if 'driver' eq $entry{type};
  croak "Unknown type $entry{type} in $context";
}

sub _load_array {
  my ( $self, $array, $file ) = @_;
  if ( not 'ARRAY' eq ref $array ) {
    return croak "Payload in $file should be an ARRAY of HASH";
  }
  my $entry_no = 1;
  for my $entry ( @{$array} ) {
    if ( not 'HASH' eq ref $entry ) {
      return croak "Entry $entry_no in $file is not a HASH";
    }
    $self->_load_entry(
      %{$entry},
      file     => $file,        #
      entry_no => $entry_no,    #
    );
    $entry_no++;
  }
  return;
}

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

  # Load from config first.
  for my $result ( @{ $self->_config } ) {
    for my $file ( keys %{$result} ) {
      $self->_load_array( $result->{$file}, $file );
    }
  }
  return;
}

sub _load_defaults {
  my ( $self, ) = @_;
  return $self->_load_array( $self->_defaults, $self->_constructor_caller );
}

no Moo;

1;

__END__