File Coverage

blib/lib/Prancer/Plugin/Database/Driver.pm
Criterion Covered Total %
statement 48 76 63.1
branch 6 24 25.0
condition 6 16 37.5
subroutine 10 16 62.5
pod 0 2 0.0
total 70 134 52.2


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