moved qdb here because matt is lazy
[public/www-new.git] / pub / qdb / src / modules / Chirpy / UI / WebApp / Session.pm
1 ###############################################################################\r
2 # Chirpy! 0.3, a quote management system                                      #\r
3 # Copyright (C) 2005-2007 Tim De Pauw <ceetee@users.sourceforge.net>          #\r
4 ###############################################################################\r
5 # This program is free software; you can redistribute it and/or modify it     #\r
6 # under the terms of the GNU General Public License as published by the Free  #\r
7 # Software Foundation; either version 2 of the License, or (at your option)   #\r
8 # any later version.                                                          #\r
9 #                                                                             #\r
10 # This program is distributed in the hope that it will be useful, but WITHOUT #\r
11 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or       #\r
12 # FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for   #\r
13 # more details.                                                               #\r
14 #                                                                             #\r
15 # You should have received a copy of the GNU General Public License along     #\r
16 # with this program; if not, write to the Free Software Foundation, Inc., 51  #\r
17 # Franklin St, Fifth Floor, Boston, MA  02110-1301  USA                       #\r
18 ###############################################################################\r
19 \r
20 ###############################################################################\r
21 # $Id:: Session.pm 298 2007-02-06 17:08:08Z ceetee                          $ #\r
22 ###############################################################################\r
23 \r
24 =head1 NAME\r
25 \r
26 Chirpy::UI::WebApp::Session - Basic CGI session class\r
27 \r
28 =head1 AUTHOR\r
29 \r
30 Tim De Pauw E<lt>ceetee@users.sourceforge.netE<gt>\r
31 \r
32 =head1 SEE ALSO\r
33 \r
34 L<Chirpy::UI::WebApp::Session::DataManager>, L<Chirpy>,\r
35 L<http://chirpy.sourceforge.net/>\r
36 \r
37 =head1 COPYRIGHT\r
38 \r
39 Copyright 2005-2007 Tim De Pauw. All rights reserved.\r
40 \r
41 This program is free software; you can redistribute it and/or modify it under\r
42 the terms of the GNU General Public License as published by the Free Software\r
43 Foundation; either version 2 of the License, or (at your option) any later\r
44 version.\r
45 \r
46 This program is distributed in the hope that it will be useful, but WITHOUT ANY\r
47 WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A\r
48 PARTICULAR PURPOSE.  See the GNU General Public License for more details.\r
49 \r
50 =cut\r
51 \r
52 package Chirpy::UI::WebApp::Session;\r
53 \r
54 use strict;\r
55 use warnings;\r
56 \r
57 use vars qw($VERSION $NAME);\r
58 \r
59 $VERSION = '0.3';\r
60 $NAME = 'sid';\r
61 \r
62 use Chirpy 0.3;\r
63 \r
64 sub new {\r
65         my ($class, $parent, $create) = @_;\r
66         \r
67         $create = 0 unless (defined $create);\r
68         \r
69         my $dm = $parent->parent()->_data_manager();\r
70         my $class_name = 'Chirpy::UI::WebApp::Session::DataManager';\r
71         Chirpy::die('Data manager must implement ' . $class_name)\r
72                 unless (UNIVERSAL::isa($dm, $class_name));\r
73 \r
74         $dm->remove_expired_sessions_if_necessary();\r
75 \r
76         my $self = {\r
77                 'dm' => $dm,\r
78                 'data' => undef,\r
79                 'ro' => 0\r
80         };\r
81         bless $self, $class;\r
82 \r
83         my $time = time();\r
84         my $expire = $parent->param('session_expiry');\r
85         $expire = ($expire ? &_parse_time($expire) : 3 * 24 * 60 * 60);\r
86         \r
87         my $cgi = $parent->{'cgi'};\r
88         my $ip = $cgi->remote_addr();\r
89         if ($create) {\r
90                 my $sid = &_generate_id();\r
91                 $self->{'data'} = {\r
92                         '_SESSION_ID' => $sid,\r
93                         '_SESSION_CTIME' => $time,\r
94                         '_SESSION_ATIME' => $time,\r
95                         '_SESSION_ETIME' => $expire,\r
96                         '_SESSION_REMOTE_ADDR' => $ip\r
97                 };\r
98                 $dm->add_session($sid, $self->data());\r
99                 return $self;\r
100         }\r
101         else {\r
102                 my $sid = $cgi->cookie(-name => $NAME);\r
103                 if (&_valid_id($sid)) {\r
104                         my @result = $dm->get_sessions($sid);\r
105                         $self->{'data'} = $result[0] if (@result);\r
106                         if ($self->id()) {\r
107                                 my $exp = $self->expire();\r
108                                 if ($exp && $self->atime() + $exp < $time) {\r
109                                         $self->delete();\r
110                                 }\r
111                                 elsif ($self->remote_addr() eq $ip) {\r
112                                         return $self;\r
113                                 }\r
114                         }\r
115                 }\r
116         }\r
117         return undef;\r
118 }\r
119 \r
120 sub DESTROY {\r
121         my $self = shift;\r
122         unless ($self->read_only()) {\r
123                 $self->atime(time);\r
124                 $self->update();\r
125         }\r
126 }\r
127 \r
128 sub param {\r
129         my ($self, %params) = @_;\r
130         my $name;\r
131         Chirpy::die('Parameter name required') unless ($name = $params{'-name'});\r
132         if (exists $params{'-value'}) {\r
133                 $self->{'data'}->{$name} = $params{'-value'};\r
134         }\r
135         return $self->{'data'}->{$name};\r
136 }\r
137 \r
138 sub delete {\r
139         my $self = shift;\r
140         my $id = $self->id();\r
141         $self->{'dm'}->remove_sessions($self->id());\r
142         $self->{'data'} = {};\r
143 }\r
144 \r
145 sub data {\r
146         my $self = shift;\r
147         return $self->{'data'};\r
148 }\r
149 \r
150 sub id {\r
151         my $self = shift;\r
152         return $self->param(-name => '_SESSION_ID');\r
153 }\r
154 \r
155 sub ctime {\r
156         my $self = shift;\r
157         return $self->param(-name => '_SESSION_CTIME');\r
158 }\r
159 \r
160 sub atime {\r
161         my ($self, $value) = @_;\r
162         return (defined $value\r
163                 ? $self->param(-name => '_SESSION_ATIME', -value => $value)\r
164                 : $self->param(-name => '_SESSION_ATIME'));\r
165 }\r
166 \r
167 sub expire {\r
168         my ($self, $value) = @_;\r
169         return (defined $value\r
170                 ? $self->param(-name => '_SESSION_ETIME', -value => $value)\r
171                 : $self->param(-name => '_SESSION_ETIME'));\r
172 }\r
173 \r
174 sub remote_addr {\r
175         my $self = shift;\r
176         return $self->param(-name => '_SESSION_REMOTE_ADDR');\r
177 }\r
178 \r
179 sub update {\r
180         my $self = shift;\r
181         $self->{'dm'}->modify_session($self->id(), $self->data());\r
182 }\r
183 \r
184 sub read_only {\r
185         my ($self, $value) = @_;\r
186         if (defined $value) {\r
187                 $self->{'ro'} = $value;\r
188         }\r
189         return $self->{'ro'};\r
190 }\r
191 \r
192 sub _generate_id {\r
193         require Digest::MD5;\r
194         return Digest::MD5::md5_hex(time() . $$ . rand 9999);\r
195 }\r
196 \r
197 sub _valid_id {\r
198         my $id = shift;\r
199         return (defined $id && $id =~ /^[0-9a-f]{32}$/);\r
200 }\r
201 \r
202 sub _parse_time {\r
203     my $time = shift;\r
204     return $time if ($time =~ /^\d+$/);\r
205         if ($time =~ /^([+-]?\d+)([smhdMy])$/) {\r
206                 my ($number, $unit) = ($1, $2);\r
207                 if ($unit eq 'y') {\r
208                         return $number * 365 * 24 * 60 * 60;\r
209                 }\r
210                 elsif ($unit eq 'M') {\r
211                         return $number * 30 * 24 * 60 * 60;\r
212                 }\r
213                 elsif ($unit eq 'd') {\r
214                         return $number * 24 * 60 * 60;\r
215                 }\r
216                 elsif ($unit eq 'h') {\r
217                         return $number * 60 * 60;\r
218                 }\r
219                 elsif ($unit eq 'm') {\r
220                         return $number * 60;\r
221                 }\r
222                 else {\r
223                         return $number;\r
224                 }\r
225         }\r
226         return 0;\r
227 }\r
228 \r
229 1;\r
230 \r
231 ###############################################################################