File Coverage

blib/lib/Prancer/Session/Store/Database/Driver/Pg.pm
Criterion Covered Total %
statement 21 100 21.0
branch 0 20 0.0
condition 0 3 0.0
subroutine 7 19 36.8
pod 4 4 100.0
total 32 146 21.9


line stmt bran cond sub pod time code
1             package Prancer::Session::Store::Database::Driver::Pg;
2              
3 4     4   2560 use strict;
  4         6  
  4         111  
4 4     4   11 use warnings FATAL => 'all';
  4         4  
  4         97  
5              
6 4     4   13 use Prancer::Session::Store::Database::Driver;
  4         4  
  4         65  
7 4     4   9 use parent qw(Prancer::Session::Store::Database::Driver);
  4         9  
  4         10  
8              
9 4     4   175 use Carp;
  4         4  
  4         158  
10 4     4   21 use Try::Tiny;
  4         3  
  4         151  
11 4     4   9 use Prancer qw(logger);
  4         4  
  4         3195  
12              
13             sub new {
14 0     0 1       my $class = shift;
15              
16                 try {
17 0     0             require DBD::Pg;
18                 } catch {
19 0 0   0             my $error = (defined($_) ? $_ : "unknown");
20 0                   logger->fatal("could not initialize session handler: could not load DBD::Pg: ${error}");
21 0                   croak;
22 0               };
23              
24 0               my $self = bless($class->SUPER::new(@_), $class);
25 0               my $database = $self->{'_database'};
26 0               my $username = $self->{'_username'};
27 0               my $password = $self->{'_password'};
28 0               my $hostname = $self->{'_hostname'};
29 0               my $port = $self->{'_port'};
30 0               my $charset = $self->{'_charset'};
31 0               my $table = $self->{'_table'};
32              
33 0               my $dsn = "dbi:Pg:dbname=${database}";
34 0 0             $dsn .= ";host=${hostname}" if defined($hostname);
35 0 0             $dsn .= ";port=${port}" if defined($port);
36              
37 0               my $params = {
38                     'AutoCommit' => 0,
39                     'RaiseError' => 1,
40                     'PrintError' => 0,
41                 };
42 0 0 0           if ($charset && $charset =~ /^utf8$/xi) {
43 0                   $params->{'pg_enable_utf8'} = 1;
44                 }
45              
46 0               $self->{'_dsn'} = [$dsn, $username, $password, $params];
47 0               logger->debug("session handler database connection dsn: ${dsn}");
48              
49 0               return $self;
50             }
51              
52             sub fetch {
53 0     0 1       my ($self, $session_id) = @_;
54 0               my $dbh = $self->handle();
55              
56 0               my $result = undef;
57                 try {
58 0     0             my $now = time();
59 0                   my $table = $self->{'_table'};
60              
61 0                   my $sth = $dbh->prepare_cached(qq|
62             SELECT data
63             FROM ${table}
64             WHERE id = ?
65             AND timeout >= ?
66             |);
67 0                   $sth->execute($session_id, ($now - $self->{'_timeout'}));
68 0                   my ($data) = $sth->fetchrow_array();
69 0                   $sth->finish();
70              
71             # deserialize the data if there is any
72 0 0                 $result = ($data ? $self->{'_deserializer'}->($data) : ());
73              
74 0                   $dbh->commit();
75                 } catch {
76 0 0   0             my $error = (defined($_) ? $_ : "unknown");
77 0                   logger->error("error fetching from session: ${error}");
78              
79 0                   $dbh->rollback();
80 0               };
81              
82 0               return $result;
83             }
84              
85             sub store {
86 0     0 1       my ($self, $session_id, $data) = @_;
87 0               my $dbh = $self->handle();
88              
89                 try {
90 0     0             my $now = time();
91 0                   my $table = $self->{'_table'};
92              
93 0                   my $insert_sth = $dbh->prepare_cached(qq|
94             INSERT INTO ${table} (id, data)
95             SELECT :id, :data
96             WHERE NOT EXISTS (
97             SELECT 1
98             FROM ${table}
99             WHERE id = :id
100             AND timeout >= :timeout
101             )
102             |);
103 0                   $insert_sth->bind_param(':id', $session_id);
104 0                   $insert_sth->bind_param(':data', $self->{'_serializer'}->($data));
105 0                   $insert_sth->bind_param(':timeout', ($now - $self->{'_timeout'}));
106 0                   $insert_sth->execute();
107 0                   $insert_sth->finish();
108              
109 0                   my $update_sth = $dbh->prepare_cached(qq|
110             UPDATE ${table}
111             SET data = :data
112             WHERE id = :id
113             AND timeout >= :timeout
114             |);
115 0                   $update_sth->bind_param(':id', $session_id);
116 0                   $update_sth->bind_param(':data', $self->{'_serializer'}->($data));
117 0                   $update_sth->bind_param(':timeout', ($now - $self->{'_timeout'}));
118 0                   $update_sth->execute();
119 0                   $update_sth->finish();
120              
121             # 10% of the time we will also purge old sessions
122 0 0                 if ($self->{'_autopurge'}) {
123 0                       my $chance = rand();
124 0 0                     if ($chance <= 0.1) {
125 0                           my $delete_sth = $dbh->prepare_cached("DELETE FROM ${table} WHERE timeout < ?");
126 0                           $delete_sth->execute($now - $self->{'_timeout'});
127 0                           $delete_sth->finish();
128                         }
129                     }
130              
131 0                   $dbh->commit();
132                 } catch {
133 0 0   0             my $error = (defined($_) ? $_ : "unknown");
134 0                   logger->error("error fetching from session: ${error}");
135              
136 0                   $dbh->rollback();
137 0               };
138              
139 0               return;
140             }
141              
142             sub remove {
143 0     0 1       my ($self, $session_id) = @_;
144 0               my $dbh = $self->handle();
145              
146                 try {
147 0     0             my $table = $self->{'_table'};
148 0                   my $sth = $dbh->prepare_cached("DELETE FROM ${table} WHERE id = ?");
149 0                   $sth->execute($session_id);
150 0                   $sth->finish();
151              
152 0                   $dbh->commit();
153                 } catch {
154 0 0   0             my $error = (defined($_) ? $_ : "unknown");
155 0                   logger->error("error fetching from session: ${error}");
156              
157 0                   $dbh->rollback();
158 0               };
159              
160 0               return;
161             }
162              
163             1;
164