File Coverage

blib/lib/PHP/Session/DB.pm
Criterion Covered Total %
statement 4 6 66.6
branch n/a
condition n/a
subroutine 2 2 100.0
pod n/a
total 6 8 75.0


line stmt bran cond sub pod time code
1             package PHP::Session::DB;
2              
3 1     1   6660 use strict;
  1         2  
  1         36  
4 1     1   1540 use DBI;
  0            
  0            
5             use URI::Escape;
6             use vars qw($VERSION);
7             $VERSION = 0.2;
8              
9             use vars qw(%SerialImpl);
10             %SerialImpl = (
11             php => 'PHP::Session::Serializer::PHP',
12             );
13              
14             use UNIVERSAL::require;
15              
16             sub _croak { require Carp; Carp::croak(@_) }
17             sub _carp { require Carp; Carp::carp(@_) }
18              
19             sub new {
20             my($class, $sid, $opt) = @_;
21             my %default = (
22             serialize_handler => 'php',
23             create => 0,
24             auto_save => 0,
25             DBTABLE => 'sessions',
26             DBHOST => 'localhost',
27             DBTYPE => 'mysql',
28             DBPORT => 3306,
29             );
30             $opt ||= {};
31             my $self = bless {
32             %default,
33             _dbh => undef,
34             %$opt,
35             _sid => $sid,
36             _data => {},
37             _changed => 0,
38             }, $class;
39             $self->_db_connection;
40             $self->_validate_sid;
41             $self->_parse_session;
42             return $self;
43             }
44              
45             # accessors, public methods
46              
47             sub id { shift->{_sid} }
48              
49             sub get {
50             my($self, $key) = @_;
51             return $self->{_data}->{$key};
52             }
53              
54             sub set {
55             my($self, $key, $value) = @_;
56             $self->{_changed}++;
57             $self->{_data}->{$key} = $value;
58             }
59              
60             sub unregister {
61             my($self, $key) = @_;
62             delete $self->{_data}->{$key};
63             }
64              
65             sub unset {
66             my $self = shift;
67             $self->{_data} = {};
68             }
69              
70             sub is_registered {
71             my($self, $key) = @_;
72             return exists $self->{_data}->{$key};
73             }
74              
75             sub decode {
76             my($self, $data) = @_;
77             $self->serializer->decode($data);
78             }
79              
80             sub encode {
81             my($self, $data) = @_;
82             $self->serializer->encode($data);
83             }
84              
85             sub save {
86             my $self = shift;
87             if($self->{create}) {
88             # First check if the session exists
89             my $sth = $self->{_dbh}->prepare("SELECT SESSKEY FROM ".$self->{DBTABLE}." WHERE SESSKEY = '".$self->id."'");
90             $sth->execute;
91             my($sesskey) = $sth->fetchrow_array;
92             if($sesskey eq $self->id) {
93             _croak("There is a session with id ".$self->id." already");
94             } else {
95             $self->{_dbh}->do("INSERT INTO ".$self->{DBTABLE}." (SESSKEY,DATA) VALUES ('".$self->id."','".$self->encode($self->{_data})."')");
96             }
97             } else {
98             $self->{_dbh}->do("UPDATE ".$self->{DBTABLE}." SET DATA = '".$self->encode($self->{_data})."' WHERE SESSKEY = '".$self->id."'");
99             }
100             $self->{_changed} = 0; # init
101             }
102              
103             sub destroy {
104             my $self = shift;
105             unlink $self->_file_path;
106             }
107              
108             sub DESTROY {
109             my $self = shift;
110             if ($self->{_changed}) {
111             if ($self->{auto_save}) {
112             $self->save;
113             } else {
114             _carp("PHP::Session::DB: some keys are changed but not saved.") if $^W;
115             }
116             }
117             }
118              
119             # private methods
120              
121             sub _db_connection {
122             my $self = shift;
123              
124             if(!exists $self->{DBNAME} || !exists $self->{DBTABLE} || !exists $self->{DBHOST} || !exists $self->{DBTYPE} || !exists $self->{DBUSER} || !exists $self->{DBPASSWD} || !exists $self->{DBPORT}) {
125             _croak("There's a missing database argument");
126             } elsif($self->{DBNAME} eq '' || $self->{DBTABLE} eq '' || $self->{DBHOST} eq '' || $self->{DBTYPE} eq '' || $self->{DBUSER} eq '' || $self->{DBPASSWD} eq '') {
127             _croak("There's a missing database argument");
128             }
129              
130             # Make database connection
131             # DBType must be a valid DBI database driver
132             my $dsn = "DBI:".$self->{DBTYPE}.":database=".$self->{DBNAME}.";host=".$self->{DBHOST}.";port=".$self->{DBPORT};
133             my $dbh = DBI->connect($dsn, $self->{DBUSER}, $self->{DBPASSWD});
134             _croak("Can't open database connection") unless $dbh;
135              
136             $self->{_dbh} = $dbh;
137             }
138              
139             sub _validate_sid {
140             my $self = shift;
141             my($id) = $self->id =~ /^([0-9a-zA-Z]*)$/; # untaint
142             defined $id or _croak("Invalid session id: ", $self->id);
143             $self->{_sid} = $id;
144             }
145              
146             sub _parse_session {
147             my $self = shift;
148             my $cont = $self->_slurp_content;
149             if (!$cont && !$self->{create}) {
150             _croak("Unknown session id");
151             }
152             $self->{_data} = $self->decode($cont);
153             }
154              
155             sub serializer {
156             my $self = shift;
157             my $impl = $SerialImpl{$self->{serialize_handler}};
158             $impl->require;
159             return $impl->new;
160             }
161              
162             sub _file_path {
163             my $self = shift;
164             #return File::Spec->catfile($self->{save_path}, 'sess_' . $self->id);
165             }
166              
167             sub _slurp_content {
168             my $self = shift;
169             my $data = '';
170             if(!$self->{create}) {
171             my $sth = $self->{_dbh}->prepare("SELECT DATA FROM ".$self->{DBTABLE}." WHERE SESSKEY = '".$self->id."'");
172             $sth->execute;
173             $data = $sth->fetchrow_array;
174             $data = uri_unescape($data);
175             local $/ = undef;
176             }
177             return $data;
178             }
179              
180             1;
181             __END__