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   15 use Moo;
  4         12  
  4         16  
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   13 _introspector_driver => sub { $_[0]->name },
28             }
29 55     55   6338 },
30             init_arg => 'connected_options',
31             );
32              
33             has _unconnected_options => (
34             is => 'ro',
35             builder => sub {
36             +{
37 3     3   18 _introspector_driver => sub { $_[0]->name },
38             }
39 53     53   975 },
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         7 $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   92 my ($self, $dbh, $dsn) = @_;
63              
64 49         69 my $connected_strategy = $self->_connected_determination_strategy;
65              
66 49 100       113 return $self->$connected_strategy($dbh, $dsn) if $dbh;
67              
68 20         21 my $unconnected_strategy = $self->_unconnected_determination_strategy;
69 20         37 $self->$unconnected_strategy($dsn)
70             }
71              
72             sub _get_when_unconnected {
73 19     19   39 my ($self, $args) = @_;
74              
75 19         22 my $drivers_by_name = $args->{drivers_by_name};
76 19         17 my $key = $args->{key};
77              
78 19 100       41 if (exists $self->_unconnected_options->{$key}) {
  11 100       28  
79 8         37 my $option = $self->_unconnected_options->{$key};
80              
81 8 100 66     52 return $option->($self, $args->{dbh})
82             if ref $option && ref $option eq 'CODE';
83 2         5 return $option;
84             }
85             elsif (@{$self->_parents}) {
86 8         7 my @p = @{$self->_parents};
  8         15  
87 8         14 for my $parent (@p) {
88 8         8 my $driver = $drivers_by_name->{$parent};
89 8 50       13 die "no such driver <$parent>" unless $driver;
90 8         25 my $ret = $driver->_get_when_unconnected($args);
91 8 100       27 return $ret if defined $ret
92             }
93             }
94             return undef
95 9         15 }
96              
97             sub _get_when_connected {
98 24     24   67 my ($self, $args) = @_;
99              
100 24         27 my $drivers_by_name = $args->{drivers_by_name};
101 24         45 my $key = $args->{key};
102              
103 24 100       56 if (exists $self->_connected_options->{$key}) {
  16 100       49  
104 8         19 my $option = $self->_connected_options->{$key};
105              
106 8 50 33     71 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         10 my @p = @{$self->_parents};
  12         24  
112 12         19 for my $parent (@p) {
113 12         35 my $driver = $drivers_by_name->{$parent};
114 12 50       24 die "no such driver <$parent>" unless $driver;
115 12         57 my $ret = $driver->_get_when_connected($args);
116 12 100       50 return $ret if $ret
117             }
118             }
119             return undef
120 12         18 }
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;