File Coverage

blib/lib/DBIx/Introspector/Driver.pm
Criterion Covered Total %
statement 45 54 83.3
branch 19 26 73.0
condition 3 6 50.0
subroutine 9 11 81.8
pod n/a
total 76 97 78.3


line stmt bran cond sub pod time code
1             package
2             DBIx::Introspector::Driver;
3              
4 4     4   18 use Moo;
  4         9  
  4         19  
5              
6             has name => (
7             is => 'ro',
8             required => 1,
9             );
10              
11             has _connected_determination_strategy => (
12             is => 'ro',
13             default => sub { sub { 1 } },
14             init_arg => 'connected_determination_strategy',
15             );
16              
17             has _unconnected_determination_strategy => (
18             is => 'ro',
19             default => sub { sub { 1 } },
20             init_arg => 'unconnected_determination_strategy',
21             );
22              
23             has _connected_options => (
24             is => 'ro',
25             builder => sub {
26             +{
27 3     3   26 _introspector_driver => sub { $_[0]->name },
28             }
29 55     55   8473 },
30             init_arg => 'connected_options',
31             );
32              
33             has _unconnected_options => (
34             is => 'ro',
35             builder => sub {
36             +{
37 3     3   16 _introspector_driver => sub { $_[0]->name },
38             }
39 53     53   1289 },
40             init_arg => 'unconnected_options',
41             );
42              
43             has _parents => (
44             is => 'ro',
45             default => sub { +[] },
46             init_arg => 'parents',
47             );
48              
49             sub _add_connected_option {
50 1     1   2 my ($self, $key, $value) = @_;
51              
52 1         10 $self->_connected_options->{$key} = $value
53             }
54              
55             sub _add_unconnected_option {
56 0     0   0 my ($self, $key, $value) = @_;
57              
58 0         0 $self->_unconnected_options->{$key} = $value
59             }
60              
61             sub _determine {
62 49     49   59 my ($self, $dbh, $dsn) = @_;
63              
64 49         86 my $connected_strategy = $self->_connected_determination_strategy;
65              
66 49 100       115 return $self->$connected_strategy($dbh, $dsn) if $dbh;
67              
68 20         27 my $unconnected_strategy = $self->_unconnected_determination_strategy;
69 20         50 $self->$unconnected_strategy($dsn)
70             }
71              
72             sub _get_when_unconnected {
73 19     19   51 my ($self, $args) = @_;
74              
75 19         24 my $drivers_by_name = $args->{drivers_by_name};
76 19         23 my $key = $args->{key};
77              
78 19 100       54 if (exists $self->_unconnected_options->{$key}) {
  11 100       36  
79 8         15 my $option = $self->_unconnected_options->{$key};
80              
81 8 100 66     66 return $option->($self, $args->{dbh})
82             if ref $option && ref $option eq 'CODE';
83 2         4 return $option;
84             }
85             elsif (@{$self->_parents}) {
86 8         8 my @p = @{$self->_parents};
  8         19  
87 8         19 for my $parent (@p) {
88 8         15 my $driver = $drivers_by_name->{$parent};
89 8 50       17 die "no such driver <$parent>" unless $driver;
90 8         27 my $ret = $driver->_get_when_unconnected($args);
91 8 100       34 return $ret if defined $ret
92             }
93             }
94             return undef
95 9         19 }
96              
97             sub _get_when_connected {
98 24     24   80 my ($self, $args) = @_;
99              
100 24         31 my $drivers_by_name = $args->{drivers_by_name};
101 24         43 my $key = $args->{key};
102              
103 24 100       67 if (exists $self->_connected_options->{$key}) {
  16 100       57  
104 8         22 my $option = $self->_connected_options->{$key};
105              
106 8 50 33     82 return $option->($self, $args->{dbh}, $args->{dsn})
107             if ref $option && ref $option eq 'CODE';
108 0         0 return $option;
109             }
110             elsif (@{$self->_parents}) {
111 12         14 my @p = @{$self->_parents};
  12         29  
112 12         18 for my $parent (@p) {
113 12         18 my $driver = $drivers_by_name->{$parent};
114 12 50       26 die "no such driver <$parent>" unless $driver;
115 12         36 my $ret = $driver->_get_when_connected($args);
116 12 100       58 return $ret if $ret
117             }
118             }
119             return undef
120 12         19 }
121              
122             sub _get_info_from_dbh {
123 0     0     my ($self, $dbh, $info) = @_;
124              
125 0 0         if ($info =~ /[^0-9]/) {
126 0           require DBI::Const::GetInfoType;
127 0           $info = $DBI::Const::GetInfoType::GetInfoType{$info};
128 0 0         die "Info type '$_[1]' not provided by DBI::Const::GetInfoType"
129             unless defined $info;
130             }
131              
132 0           $dbh->get_info($info);
133             }
134              
135             1;