File Coverage

blib/lib/ObjectDB/DBHPool/Connection.pm
Criterion Covered Total %
statement 9 59 15.2
branch 0 22 0.0
condition 0 11 0.0
subroutine 3 11 27.2
pod 0 2 0.0
total 12 105 11.4


line stmt bran cond sub pod time code
1             package ObjectDB::DBHPool::Connection;
2              
3 5     5   34 use strict;
  5         10  
  5         136  
4 5     5   25 use warnings;
  5         16  
  5         225  
5              
6             our $VERSION = '3.28';
7              
8             require Carp;
9 5     5   7859 use DBI;
  5         86042  
  5         3062  
10              
11             sub new {
12 0     0 0   my $class = shift;
13 0           my (%params) = @_;
14              
15 0           my $self = {@_};
16 0           bless $self, $class;
17              
18 0           $self->{check_timeout} = $params{check_timeout};
19 0           $self->{dsn} = $params{dsn};
20 0           $self->{username} = $params{username};
21 0           $self->{password} = $params{password};
22 0           $self->{attrs} = $params{attrs};
23 0           $self->{do} = $params{do};
24              
25 0 0         $self->{check_timeout} = 5 unless defined $self->{check_timeout};
26 0   0       $self->{attrs} ||= { RaiseError => 1 };
27              
28 0           return $self;
29             }
30              
31             sub dbh {
32 0     0 0   my $self = shift;
33              
34 0 0         if (!$self->{dbh}) {
    0          
35 0           $self->_connect;
36             }
37             elsif (!$self->_check_connection) {
38 0           $self->_reconnect;
39             }
40              
41 0           return $self->{dbh};
42             }
43              
44             sub _connect {
45 0     0     my $self = shift;
46              
47 0           $self->{dbh} = $self->_get_dbh;
48 0           $self->{last_check} = time;
49              
50 0           return $self->{dbh};
51             }
52              
53             sub _reconnect {
54 0     0     my $self = shift;
55              
56 0           eval { $self->{dbh}->disconnect };
  0            
57              
58 0           return $self->_connect;
59             }
60              
61             sub _check_connection {
62 0     0     my $self = shift;
63              
64 0 0         return 1 unless $self->_is_check_needed;
65              
66 0           $self->{last_check} = time;
67              
68 0           my $dbh = $self->{dbh};
69              
70 0 0 0       return unless $dbh && $dbh->{Active};
71              
72 0 0         return 1 if int $dbh->ping;
73              
74 0           return eval { $dbh->do('select 1'); 1; };
  0            
  0            
75             }
76              
77             sub _is_check_needed {
78 0     0     my $self = shift;
79              
80 0 0 0       return 1 if !$self->{dbh}->{Active} || $self->_is_check_timeout_elapsed;
81              
82 0           return 0;
83             }
84              
85             sub _is_check_timeout_elapsed {
86 0     0     my $self = shift;
87              
88 0 0 0       if ($self->{check_timeout}
89             && time - $self->{last_check} > $self->{check_timeout})
90             {
91 0           return 1;
92             }
93              
94 0           return 0;
95             }
96              
97             sub _get_dbh {
98 0     0     my $self = shift;
99              
100 0           my $dbh = DBI->connect($self->{dsn}, $self->{username}, $self->{password}, $self->{attrs});
101              
102 0 0         Carp::croak("Can't connect $DBI::errstr") unless $dbh;
103              
104 0 0         if ($self->{do}) {
105 0 0         foreach my $do (ref $self->{do} eq 'ARRAY' ? @{ $self->{do} } : ($self->{do})) {
  0            
106 0           $dbh->do($do);
107             }
108             }
109              
110 0           return $dbh;
111             }
112              
113             1;