File Coverage

blib/lib/DeltaX/Session.pm
Criterion Covered Total %
statement 43 174 24.7
branch 8 92 8.7
condition 1 8 12.5
subroutine 7 18 38.8
pod 5 5 100.0
total 64 297 21.5


line stmt bran cond sub pod time code
1             #-----------------------------------------------------------------
2             package DeltaX::Session;
3             #-----------------------------------------------------------------
4             # $Id: Session.pm,v 1.1 2003/03/17 13:01:36 spicak Exp $
5             #
6             # (c) DELTA E.S., 2002 - 2003
7             # This package is free software; you can use it under "Artistic License" from
8             # Perl.
9             #-----------------------------------------------------------------
10              
11             $DeltaX::Session::VERSION = '1.0';
12              
13 1     1   775 use strict;
  1         2  
  1         38  
14 1     1   5 use Exporter;
  1         2  
  1         32  
15 1     1   5 use Carp;
  1         2  
  1         64  
16 1     1   6 use Fcntl qw(O_RDWR LOCK_EX LOCK_UN);
  1         2  
  1         49  
17              
18 1     1   5 use vars qw(@ISA @EXPORT @EXPORT_OK $gs);
  1         1  
  1         2162  
19             @ISA = qw(Exporter);
20             @EXPORT = qw();
21             @EXPORT_OK = qw();
22              
23             #-----------------------------------------------------------------
24             sub new {
25             #-----------------------------------------------------------------
26             # CONSTRUCTOR
27             #
28 1     1 1 86 my $pkg = shift;
29 1         2 my $self = {};
30 1         3 bless ($self, $pkg);
31              
32 1 50       5 croak ("new() called with odd number of parameters - should be of the form field => value")
33             if (@_ % 2);
34              
35             # default values
36 1         9 $self->{db} = undef;
37 1         3 $self->{table_name} = 'sessions';
38 1         3 $self->{shm_key} = undef;
39 1         3 $self->{shm_segment} = 10000;
40 1         3 $self->{shm_max} = 1000000;
41 1         3 $self->{shm_timeout} = 300;
42 1         2 $self->{file} = undef;
43 1         4 $self->{db_file} = 'GDBM_File';
44              
45 1         5 for (my $x = 0; $x <= $#_; $x += 2) {
46 1 50       7 croak ("Unkown parameter $_[$x] in new()")
47             unless exists $self->{lc($_[$x])};
48 1         6 $self->{lc($_[$x])} = $_[$x+1];
49             }
50              
51             # one of db and file must be set
52 1 50 33     8 if (!defined $self->{db} and !defined $self->{file}) {
53 0         0 croak ("At least one from 'db' and 'file' parameters must be set!");
54             }
55              
56 1 50       3 if ($self->{db}) {
57 0         0 require DeltaX::Database;
58 0         0 import DeltaX::Database;
59             }
60 1 50       4 if ($self->{file}) {
61 1         2 my $tmp = $self->{db_file};
62 1         72 eval "require $tmp";
63 1         55 eval "import $tmp";
64             }
65 1 50       5 if ($self->{shm_key}) {
66 0         0 require IPC::SharedCache;
67 0         0 import IPC::SharedCache;
68             }
69              
70 1 50       5 $self->_init_db() if $self->{db};
71 1 50       8 $self->_init_file() if $self->{file};
72 0 0       0 $self->_init_shm() if $self->{shm_key};
73              
74 0         0 return $self;
75             }
76             # END OF new()
77              
78              
79             #-----------------------------------------------------------------
80             sub _init_db {
81             #-----------------------------------------------------------------
82             #
83 0     0   0 my $self = shift;
84 0         0 my $db = $self->{db};
85 0         0 my $tab = $self->{table_name};
86 0         0 my $result;
87              
88 0         0 $result = 1;
89 0 0       0 $result = $db->open_statement('DeltaX_Session_INS',
90             "INSERT INTO $tab VALUES(?, ?, ".$db->date2db('PREPARED','??').")")
91             if (! $db->exists_statement('DeltaX_Session_INS'));
92 0 0       0 croak ("Cannot initialize statement DeltaX_Session_INS") unless $result > 0;
93              
94 0         0 $result = 1;
95 0 0       0 $result = $db->open_statement('DeltaX_Session_UPD',
96             "UPDATE $tab SET sdata = ? WHERE sid = ?")
97             if (! $db->exists_statement('DeltaX_Session_UPD'));
98 0 0       0 croak ("Cannot initialize statement DeltaX_Session_UPD") unless $result > 0;
99              
100 0         0 $result = 1;
101 0 0       0 $result = $db->open_statement('DeltaX_Session_DEL',
102             "DELETE FROM $tab WHERE sid = ?")
103             if (! $db->exists_statement('DeltaX_Session_DEL'));
104 0 0       0 croak ("Cannot initialize statement DeltaX_Session_DEL") unless $result > 0;
105              
106 0         0 $result = 1;
107 0 0       0 $result = $db->open_statement('DeltaX_Session_TCH',
108             "UPDATE $tab SET ts = ".$db->date2db('PREPARED','??')." WHERE sid = ?")
109             if (! $db->exists_statement('DeltaX_Session_TCH'));
110 0 0       0 croak ("Cannot initialize statement DeltaX_Session_TCH") unless $result > 0;
111              
112 0         0 $result = 1;
113 0 0       0 $result = $db->open_statement('DeltaX_Session_SEL',
114             "SELECT * FROM $tab WHERE sid = ?")
115             if (! $db->exists_statement('DeltaX_Session_SEL'));
116 0 0       0 croak ("Cannot initialize statement DeltaX_Session_SEL") unless $result > 0;
117              
118             }
119             # END OF _init_db()
120              
121             #-----------------------------------------------------------------
122             sub _destroy_db {
123             #-----------------------------------------------------------------
124             #
125 0     0   0 my $self = shift;
126 0         0 my $db = $self->{db};
127              
128 0         0 $db->close_statement('DeltaX_Session_INS');
129 0         0 $db->close_statement('DeltaX_Session_UPD');
130 0         0 $db->close_statement('DeltaX_Session_DEL');
131 0         0 $db->close_statement('DeltaX_Session_TCH');
132 0         0 $db->close_statement('DeltaX_Session_SEL');
133              
134             }
135             # END OF _destroy_db()
136              
137             #-----------------------------------------------------------------
138             sub _init_file {
139             #-----------------------------------------------------------------
140             #
141 1     1   3 my $self = shift;
142              
143 1         3 $self->{dbf} = {};
144 1 0       2 if (! tie %{$self->{dbf}}, $self->{db_file}, $self->{file}, O_RDWR, 0600) {
  1         304  
145 0           croak ("Cannot open file!");
146             }
147              
148             }
149             # END OF _init_file()
150              
151             #-----------------------------------------------------------------
152             sub _init_shm {
153             #-----------------------------------------------------------------
154             #
155 0     0     my $self = shift;
156              
157 0           $self->{cache} = {};
158 0 0         if (! tie %{$self->{cache}}, 'IPC::SharedCache', ipc_key => $self->{shm_key},
  0            
159             load_callback => \&_shm_load,
160             validate_callback => \&_shm_validate,
161             ipc_segment_size => $self->{shm_segment},
162             max_size => $self->{shm_max}) {
163 0           croak ("Cannot connect to shared memory!");
164             }
165              
166             }
167             # END OF _init_shm()
168              
169             #-----------------------------------------------------------------
170             sub _shm_load {
171             #-----------------------------------------------------------------
172             #
173 0     0     my $key = shift;
174              
175 0           my %rec;
176              
177             my %data;
178 0 0         if ($gs->{db}) { %data = $gs->_get_db($key); }
  0            
179 0 0         if ($gs->{file}) { %data = $gs->_get_file($key); }
  0            
180              
181 0           my @tmp = keys %data;
182 0 0         return undef unless $#tmp > -1;
183              
184 0           $rec{contnt} = \%data;
185 0           $rec{ltime} = time();
186 0           return \%rec;
187             }
188             # END OF _shm_load()
189              
190             #-----------------------------------------------------------------
191             sub _shm_validate {
192             #-----------------------------------------------------------------
193             #
194 0     0     my ($key, $record) = @_;
195              
196 0           my $ltime = $record->{ltime};
197 0 0         if ( (time() - $ltime) > $gs->{shm_timeout}) {
198 0           return 0;
199             }
200 0           return 1;
201             }
202             # END OF _shm_validate()
203              
204             #-----------------------------------------------------------------
205             sub put {
206             #-----------------------------------------------------------------
207             #
208 0     0 1   my $self = shift;
209              
210 0           my $sid = shift;
211 0 0         return -1 unless defined $sid;
212 0 0         return -2 if $self->exist($sid,1);
213              
214 0 0         return -3 if (@_ % 2);
215              
216 0           my @data;
217 0           for (my $x = 0; $x <= $#_; $x += 2) {
218 0           push @data, $_[$x].'='.$_[$x+1];
219             }
220 0           my $data = join('^^',@data);
221              
222 0 0         if ($self->{file}) {
223 0           $self->{dbf}->{$sid} = time().'^^'.$data;
224             }
225 0 0         if ($self->{db}) {
226 0           my $result = $self->{db}->perform_statement('DeltaX_Session_INS',
227             $sid, $data, $self->{db}->date2db('PREPARED'));
228 0 0         return -5 unless $result > 0;
229             }
230              
231 0           return 1;
232             }
233             # END OF put()
234              
235              
236             #-----------------------------------------------------------------
237             sub exist {
238             #-----------------------------------------------------------------
239             #
240 0     0 1   my $self = shift;
241              
242 0           my $sid = shift;
243 0 0         return 0 unless defined $sid;
244              
245 0   0       my $from_put = shift || 0;
246              
247 0 0 0       if ($self->{shm_key} and !$from_put) {
248 0           $gs = $self;
249 0           return defined $self->{cache}->{$sid};
250             }
251 0 0         if ($self->{file}) {
252 0           return exists $self->{dbf}->{$sid};
253             }
254 0 0         if ($self->{db}) {
255 0           my ($result) = $self->{db}->perform_statement('DeltaX_Session_SEL', $sid);
256 0 0         return 1 if $result > 0;
257 0           return 0;
258             }
259             }
260             # END OF exist()
261              
262             #-----------------------------------------------------------------
263             sub get {
264             #-----------------------------------------------------------------
265             #
266 0     0 1   my $self = shift;
267              
268 0           my $sid = shift;
269 0 0         return undef unless defined $sid;
270              
271 0 0         if ($self->{shm_key}) {
272 0           $gs = $self;
273 0           my $tmp = $self->{cache}->{$sid};
274 0           $tmp->{ltime} = time();
275 0           $self->{cache}->{$sid} = $tmp;
276 0           return %{$tmp->{contnt}};
  0            
277             }
278 0 0         if ($self->{db}) {
279 0           return $self->_get_db($sid);
280             }
281 0 0         if ($self->{file}) {
282 0           return $self->_get_file($sid);
283             }
284              
285 0           return undef;
286              
287             }
288             # END OF get()
289              
290             #-----------------------------------------------------------------
291             sub _get_db {
292             #-----------------------------------------------------------------
293             #
294 0     0     my $self = shift;
295 0           my $sid = shift;
296              
297 0           my ($result,undef,$data,$ts) =
298             $self->{db}->perform_statement('DeltaX_Session_SEL', $sid);
299 0 0         return undef unless $result > 0;
300 0           $result = $self->{db}->perform_statement('DeltaX_Session_TCH',
301             $self->{db}->date2db('PREPARED'), $sid);
302             #return undef unless $result > 0;
303 0           my @tmp = split(/\^/,$data);
304 0           my %tmp;
305 0           foreach my $tmp (@tmp) {
306 0           my ($key,$val) = split(/=/,$tmp);
307 0 0         $tmp{$key} = $val if $key;
308             }
309            
310 0           return %tmp;
311             }
312             # END OF _get_db()
313              
314             #-----------------------------------------------------------------
315             sub _get_file {
316             #-----------------------------------------------------------------
317             #
318 0     0     my $self = shift;
319 0           my $sid = shift;
320              
321 0 0         return undef unless exists $self->{dbf}->{$sid};
322 0           my $data = $self->{dbf}->{$sid};
323 0           my @tmp = split(/\^\^/, $data);
324 0           my $ts = shift @tmp;
325 0           my %tmp;
326 0           foreach my $tmp (@tmp) {
327 0           my ($key,$val) = split(/=/,$tmp);
328 0           $tmp{$key} = $val;
329             }
330 0           $data = time().'^^'.join('^^',@tmp);
331 0           $self->{dbf}->{$sid} = $data;
332            
333 0           return %tmp;
334             }
335             # END OF _get_file()
336              
337             #-----------------------------------------------------------------
338             sub free {
339             #-----------------------------------------------------------------
340             #
341 0     0 1   my $self = shift;
342              
343 0 0         if ($self->{file}) { untie %{$self->{dbf}}; }
  0            
  0            
344 0 0         if ($self->{shm_key}) { untie %{$self->{cache}}; }
  0            
  0            
345 0 0         if ($self->{db}) { $self->_destroy_db(); }
  0            
346              
347             }
348             # END OF free()
349              
350             1;
351              
352             =head1 NAME
353              
354             DeltaX::Session - Perl module for session management
355              
356             _____
357             / \ _____ ______ ______ ___________
358             / \ / \\__ \ / ___// ___// __ \_ __ \
359             / Y \/ __ \_\___ \ \___ \\ ___/| | \/
360             \____|__ (____ /____ >____ >\___ >__|
361             \/ \/ \/ \/ \/ project
362              
363              
364             =head1 SYNOPSIS
365              
366             use DeltaX::Database;
367             use DeltaX::Session;
368              
369             my $db = new DeltaX::Database(...);
370             my $sess = new DeltaX::Session(db=>$db, table_name=>'my_sessions');
371              
372             my $sid = '12345'; # Session ID
373             $sess->put($sid, key1=>'data1', key2=>'data2');
374              
375             if (!$sess->exist($sid)) {
376             # some error
377             }
378            
379             my %data = $sess->get($sid);
380              
381             =head1 DESCRIPTION
382              
383             This module is prepared for session management (especially for masser
384             applications). It can store session information in database table (preffered),
385             shared memory or file (both in practise untested).
386             Session is identified by SID - Session IDentification - some unique identifier
387             composed from a-z, A-Z and 0-9 characters (for example md5_hex from Digest::MD5
388             is good for creating it).
389             If you use database table, you must create table with this structure:
390              
391             create table (
392             sid varchar(32) not null, -- according to SID you will use
393             sdata varchar(2000), -- as data you will store
394             ts timestamp -- date & time
395             primary key (sid)
396             );
397              
398             If you use shared memory, you must have IPC::SharedCache installed. WARNING: Not
399             fully implemented.
400              
401             If you use file, you must have module for selected storage type installed
402             (default is GDBM_File).
403              
404             There are no functions which allow you to modify or delete SID (because of
405             performance issues).
406              
407             =head1 FUNCTIONS
408              
409             =head2 new()
410              
411             Constructor. It uses parameters in key => value form:
412              
413             =over
414              
415             =item db
416              
417             Reference to initialized DeltaX::Database. If set, session data will be stored
418             in this database.
419              
420             =item table_name
421              
422             If you are using database storage, this is a table name which will hold data
423             (default is 'sessions').
424              
425             =item shm_key
426              
427             Shared memory key (up to 4 characters - see IPC::SharedCache). If set, session
428             data will be stored in shared memory with this key.
429              
430             =item shm_segment
431              
432             Shared memory segment size (only valid if shm_key set) - see IPC::SharedCache
433             for explanation. Default is 10000 bytes.
434              
435             =item shm_max
436              
437             Maximum shared memory size (only valid if shm_key set) - see IPC::SharedCache
438             for explanation. Default is 1000000 bytes.
439              
440             =item shm_timeout
441              
442             Timeout in seconds, after which will be record in cache invalidated (see
443             IPC::SharedCache, validate_callback). Default is 300 seconds.
444              
445             =item file
446              
447             Filename of file in which session data will be stored.
448              
449             =item db_file
450              
451             Database file type to store session data, default is GDBM_File. Appropriate
452             module must be installed.
453              
454             =back
455              
456             =head2 put()
457              
458             This function allows you to put some data linked to given SID. The first
459             parameter is SID, other parameters are in key => value form. Returned values:
460              
461             =over
462              
463             =item -1 - no SID given
464              
465             =item -2 - SID already exists
466              
467             =item -3 - parameters are not in key => value form
468              
469             =item -5 - database error while inserting new data
470              
471             =item 1 - ok
472              
473             =back
474              
475             =head2 exist()
476              
477             Tests if given SID exists in storage, only one required parameter is SID.
478             Returns true if SID exists, otherwise returns false (0).
479              
480             =head2 get()
481              
482             Returns hash with values assigned to given SID (first and required parameter).
483             Returns undef in case of error.
484              
485             =head2 free()
486              
487             Frees resources used by module (especially closes opened statements if using
488             database).
489              
490             =cut