File Coverage

blib/lib/Prancer/Database/Driver.pm
Criterion Covered Total %
statement 15 77 19.5
branch 0 24 0.0
condition 0 16 0.0
subroutine 5 16 31.2
pod 0 2 0.0
total 20 135 14.8


line stmt bran cond sub pod time code
1             package Prancer::Database::Driver;
2              
3 4     4   2270 use strict;
  4         4  
  4         116  
4 4     4   8 use warnings FATAL => 'all';
  4         5  
  4         117  
5              
6 4     4   8 use Carp;
  4         3  
  4         160  
7 4     4   9 use Try::Tiny;
  4         4  
  4         191  
8 4     4   69 use Prancer qw(logger);
  4         8  
  4         2693  
9              
10             sub new {
11 0     0 0       my ($class, $config, $connection) = @_;
12              
13                 try {
14 0     0             require DBI;
15                 } catch {
16 0 0   0             my $error = (defined($_) ? $_ : "unknown");
17 0                   logger->fatal("could not initialize database connection '${connection}': could not load DBI: ${error}");
18 0                   croak;
19 0               };
20              
21             # this is the only required field
22 0 0             unless ($config->{'database'}) {
23 0                   logger->fatal("could not initialize database connection '${connection}': no database name configured");
24 0                   croak;
25                 }
26              
27 0               my $self = bless({}, $class);
28 0               $self->{'_connection'} = $connection;
29 0               $self->{'_database'} = $config->{'database'};
30 0               $self->{'_username'} = $config->{'username'};
31 0               $self->{'_password'} = $config->{'password'};
32 0               $self->{'_hostname'} = $config->{'hostname'};
33 0               $self->{'_port'} = $config->{'port'};
34 0               $self->{'_autocommit'} = $config->{'autocommit'};
35 0               $self->{'_charset'} = $config->{'charset'};
36 0   0           $self->{'_check_threshold'} = $config->{'connection_check_threshold'} || 30;
37              
38             # store a pool of database connection handles
39 0               $self->{'_handles'} = {};
40              
41 0               return $self;
42             }
43              
44             sub handle {
45 0     0 0       my $self = shift;
46              
47             # to be fork safe and thread safe, use a combination of the PID and TID (if running
48             # with use threads) to make sure no two processes/threads share a handle.
49             # implementation based on DBIx::Connector by David E. Wheeler
50 0               my $pid_tid = $$;
51 0 0             $pid_tid .= '_' . threads->tid if $INC{'threads.pm'};
52              
53             # see if we have a matching handle
54 0   0           my $handle = $self->{'_handles'}->{$pid_tid} || undef;
55              
56 0 0             if ($handle->{'dbh'}) {
57 0 0 0               if ($handle->{'dbh'}{'Active'} && $self->{'_check_threshold'} &&
      0        
58                         (time - $handle->{'last_connection_check'} < $self->{'_check_threshold'})) {
59              
60             # the handle has been checked recently so just return it
61 0                       return $handle->{'dbh'};
62                     } else {
63 0 0                     if (_check_connection($handle->{'dbh'})) {
64 0                           $handle->{last_connection_check} = time;
65 0                           return $handle->{'dbh'};
66                         } else {
67             # er need to reconnect
68 0                           logger->debug("database connection to '${\$self->{'_connection'}}' went away -- reconnecting");
  0            
69              
70             # try to disconnect but don't care if it fails
71 0 0                         if ($handle->{'dbh'}) {
72 0     0                         try { $handle->{'dbh'}->disconnect() } catch {};
  0            
  0            
73                             }
74              
75             # try to connect again and save the new handle
76 0                           $handle->{'dbh'} = $self->_get_connection();
77 0                           return $handle->{'dbh'};
78                         }
79                     }
80                 } else {
81 0                   $handle->{'dbh'} = $self->_get_connection();
82 0 0                 if ($handle->{'dbh'}) {
83 0                       $handle->{'last_connection_check'} = time;
84 0                       $self->{'_handles'}->{$pid_tid} = $handle;
85 0                       return $handle->{'dbh'};
86                     }
87                 }
88              
89 0               return;
90             }
91              
92             sub _get_connection {
93 0     0         my $self = shift;
94              
95 0               my $dbh = undef;
96                 try {
97 0   0 0             $dbh = DBI->connect(@{$self->{'_dsn'}}) || croak "${\$DBI::errstr}\n";
98                 } catch {
99 0 0   0             my $error = (defined($_) ? $_ : "unknown");
100 0                   logger->fatal("could not initialize database connection '${\$self->{'_connection'}}': ${error}");
  0            
101 0               };
102              
103 0               return $dbh;
104             }
105              
106             # Check the connection is alive
107             sub _check_connection {
108 0     0         my $dbh = shift;
109 0 0             return unless $dbh;
110              
111 0 0 0           if ($dbh->{Active} && (my $result = $dbh->ping())) {
112 0 0                 if (int($result)) {
113             # DB driver itself claims all is OK, trust it:
114 0                       return 1;
115                     } else {
116             # it was "0 but true", meaning the DBD doesn't implement ping and
117             # instead we got the default DBI ping implementation. implement
118             # our own basic check, by performing a real simple query.
119                         return try {
120 0     0                     return $dbh->do('SELECT 1');
121                         } catch {
122 0     0                     return 0;
123 0                       };
124                     }
125                 }
126              
127 0               return 0;
128             }
129              
130             1;
131