File Coverage

lib/CHI/Config/DriverPool.pm
Criterion Covered Total %
statement 33 39 84.6
branch 3 4 75.0
condition n/a
subroutine 10 10 100.0
pod 3 3 100.0
total 49 56 87.5


line stmt bran cond sub pod time code
1 3     3   772 use 5.006;
  3         10  
  3         151  
2 3     3   18 use strict;
  3         21  
  3         140  
3 3     3   17 use warnings;
  3         4  
  3         263  
4              
5             package CHI::Config::DriverPool;
6              
7             our $VERSION = '0.001001'; # TRIAL
8              
9             # ABSTRACT: A Collection of Driver definitions
10              
11             our $AUTHORITY = 'cpan:KENTNL'; # AUTHORITY
12              
13 3     3   449 use Moo qw( has );
  3         10891  
  3         23  
14 3     3   2035 use Carp qw( carp croak );
  3         6  
  3         308  
15              
16             ## no critic (ValuesAndExpressions::ProhibitConstantPragma)
17 3     3   18 use constant DEBUGGING => $ENV{CHI_CONFIG_DEBUG};
  3         4  
  3         1410  
18              
19             has '_drivers' => ( is => ro =>, lazy => 1, default => sub { {} } );
20              
21             sub add_driver {
22 8     8 1 3031 my ( $self, %config ) = @_;
23              
24 8         1449 require CHI::Config::Driver;
25              
26 8         200 my $instance = CHI::Config::Driver->new(%config);
27 8         3500 my $name = $instance->name;
28              
29 8 100       224 if ( not exists $self->_drivers->{$name} ) {
30 4         130 $self->_drivers->{$name} = $instance;
31 4         68 return;
32             }
33 4         89 return unless DEBUGGING;
34             ## Shadowing should be default anyway.
35 0         0 my $template = '%s: %s';
36 0         0 my $old = sprintf $template, ' Kept', $self->_drivers->{$name}->source;
37 0         0 my $new = sprintf $template, 'Ignored', $instance->source;
38 0         0 carp "Duplicate Driver definition ignored\n\t$old\n\t$new\n";
39 0         0 return;
40             }
41              
42             sub get_driver {
43 2     2 1 5 my ( $self, $name ) = @_;
44 2 50       57 return $self->_drivers->{$name} if exists $self->_drivers->{$name};
45 0         0 croak "No default for driver <$name> defined and none specified in configuration";
46             }
47              
48             sub get_cache {
49 2     2 1 1091 my ( $self, $name ) = @_;
50 2         10 return $self->get_driver($name)->get_cache;
51             }
52              
53 3     3   20 no Moo;
  3         4  
  3         21  
54              
55             1;
56              
57             __END__