Line # Revision Author
1 194 ahitrov package session::Keeper;
2
3 use strict;
4 use warnings 'all';
5 use base qw(Contenido::Keeper);
6
7 use Apache::Cookie;
8 use Apache::Session::File;
9 use Apache::Session::Postgres;
10 253 ahitrov use Apache::Session::Memcached;
11 194 ahitrov use Contenido::Globals;
12 use Data::Dumper;
13
14
15 sub logon {
16 my $self = shift;
17 my %opts = @_;
18
19 return if !($opts{login} || $opts{email}) && !$opts{passwd};
20
21 my $res;
22 my @plugins = split (/[\ |\t]+/, $state->{plugins});
23 if ( grep { $_ eq 'users' } @plugins ) {
24 #### ����������� ����� ������ users
25 #########################################
26 $res = $keeper->{users}->login (
27 $opts{login} ? (login => $opts{login}) : (),
28 $opts{email} ? (email => lc($opts{email})) : (),
29 passwd => $opts{passwd},
30 );
31 return unless $res;
32 } else {
33 #### ����������� ���� ��������
34
35
36
37 }
38 if ( ref $res ) {
39 my %data = (
40 id => $res->id,
41 name => $res->name,
42 email => $res->email,
43 login => $res->login,
44 status => $res->status,
45 ltime => time,
46 );
47 255 ahitrov my ($type_prop) = grep { $_->{attr} eq 'type' } $res->structure;
48 $data{type} = $res->type if $type_prop;
49 194 ahitrov $self->store_value ( %data );
50 }
51 return $self->get_session();
52 }
53
54
55 sub logoff {
56 my $self = shift;
57 281 ahitrov my (%opts) = @_;
58 243 ahitrov
59 194 ahitrov my $sid = _get_session_id ();
60 my $session = _get_session_object ( $sid );
61 return unless ref $session;
62
63 my $session_id = $session->{_session_id};
64 if (!$sid || $sid ne $session_id) {
65 warn "LOGOFF: New or deprecated session. Old sid = '$sid', new sid = '$session_id'" if $DEBUG;
66 281 ahitrov _store_session_id ($session_id, %opts)
67 194 ahitrov } else {
68 243 ahitrov if ( exists $opts{clear} ) {
69 my @clear = qw( id email login name nick type status ltime );
70 push @clear, @{ $opts{clear} } if exists $opts{clear} && ref $opts{clear} eq 'ARRAY' && @{ $opts{clear} };
71 foreach my $key ( @clear ) {
72 delete $session->{$key};
73 }
74 } else {
75 foreach my $key ( keys %$session ) {
76 next if $key eq '_session_id';
77 next if $key eq '_timestamp';
78 delete $session->{$key};
79 }
80 }
81 194 ahitrov }
82 untie %$session;
83 return 1;
84 }
85
86
87 255 ahitrov sub autologon {
88 my $self = shift;
89 my %opts = @_;
90
91 my $profile = delete $opts{profile};
92 if ( ref $profile ) {
93 my %data = (
94 id => $profile->id,
95 name => $profile->name,
96 email => $profile->email,
97 login => $profile->login,
98 status => $profile->status,
99 ltime => time,
100 );
101 my ($type_prop) = grep { $_->{attr} eq 'type' } $profile->structure;
102 $data{type} = $profile->type if $type_prop;
103 my ($ava_prop) = grep { $_->{attr} eq 'avatar' } $profile->structure;
104 if ( $ava_prop ) {
105 my $avatar = $profile->get_image('avatar');
106 $data{avatar} = $avatar->{mini}{filename} if ref $avatar && exists $avatar->{filename};
107 }
108 $self->store_value ( %data );
109 return $self->get_session();
110 }
111 return undef;
112 }
113
114
115 194 ahitrov sub get_value {
116
117 264 ahitrov my ($self, $name, %opts) = @_;
118 my $sid = delete $opts{_session_id} || _get_session_id ();
119 194 ahitrov my $session = _get_session_object ( $sid );
120 return unless ref $session;
121
122 my $session_id = $session->{_session_id};
123 my $value = $session->{$name};
124 if (!$sid || $sid ne $session_id) {
125 warn "GET_VALUE: New or deprecated session. Old sid = '$sid', new sid = '$session_id'" if $DEBUG;
126 281 ahitrov _store_session_id ($session_id, %opts);
127 194 ahitrov }
128 untie %$session;
129 return $value;
130 }
131
132
133 sub store_value {
134
135 my ($self, %opts) = @_;
136 281 ahitrov my $domain = delete $opts{domain};
137 264 ahitrov my $sid = delete $opts{_session_id} || _get_session_id ();
138 194 ahitrov my $session = _get_session_object ( $sid );
139 return unless ref $session;
140
141 foreach my $key ( keys %opts ) {
142 $session->{$key} = $opts{$key};
143 }
144
145 my $session_id = $session->{_session_id};
146 if (!$sid || $sid ne $session_id) {
147 warn "STORE_VALUE: New or deprecated session. Old sid = '$sid', new sid = '$session_id'" if $DEBUG;
148 281 ahitrov _store_session_id ($session_id, domain => $domain);
149 194 ahitrov }
150 untie %$session;
151 return 1;
152 }
153
154
155 sub delete_key {
156
157 264 ahitrov my ($self, $key, %opts) = @_;
158 194 ahitrov return unless $key;
159
160 264 ahitrov my $sid = delete $opts{_session_id} || _get_session_id ();
161 194 ahitrov my $session = _get_session_object ( $sid );
162 return unless ref $session;
163
164 my $session_id = $session->{_session_id};
165 if (!$sid || $sid ne $session_id) {
166 warn "DELETE_VALUE: New or deprecated session. Old sid = '$sid', new sid = '$session_id'" if $DEBUG;
167 281 ahitrov _store_session_id ($session_id, %opts);
168 194 ahitrov } else {
169 delete $session->{$key} if exists $session->{$key};
170 }
171 untie %$session;
172 return 1;
173 }
174
175
176 sub get_session {
177
178 my $self = shift;
179 281 ahitrov my (%opts) = @_;
180 194 ahitrov
181 my $sid = _get_session_id () || '';
182 my $session = _get_session_object ($sid);
183 return unless ref $session;
184
185 my $session_id = $session->{_session_id};
186 my %ret = %$session;
187 if (!$sid || $sid ne $session_id) {
188 warn "\nGET_SESSION: New or deprecated session. Old sid = '$sid', new sid = '$session_id'\n" if $DEBUG;
189 281 ahitrov _store_session_id ($session_id, %opts);
190 194 ahitrov }
191 untie %$session;
192
193 281 ahitrov my $session_object = session::Session->new( %ret );
194 return $session_object;
195 194 ahitrov }
196
197
198 ## ���������� �������
199 ######################################################################################
200 sub _store_session_id {
201
202 my $sid = shift;
203 281 ahitrov my (%opts) = @_;
204 194 ahitrov return unless $sid;
205 my $cookie = Apache::Cookie->new ($request->r(),
206 281 ahitrov -domain => $opts{domain} || $state->{session}->domain,
207 194 ahitrov -name => $state->{session}->cookie,
208 -expires=> $state->{session}->expires,
209 -value => $sid,
210 -path => '/',
211 );
212 $cookie->bake();
213
214 }
215
216
217 sub _get_session_id {
218
219 281 ahitrov my $keyname = shift || $state->{session}->cookie;
220
221 194 ahitrov my %cookies = Apache::Cookie->fetch;
222 warn Dumper(\%cookies) if $DEBUG;
223 281 ahitrov my $cookie = $cookies{$keyname};
224 194 ahitrov
225 # ����������� SID �� ����
226 my $sid = $cookie->value() || '' if $cookie;
227 warn "\nSession_id = $sid\n" if $DEBUG;
228
229 return $sid;
230 }
231
232
233 sub _get_session_object {
234
235 my $sid = shift;
236
237 my %session;
238 my $now = time;
239 if ( $state->{session}->storage eq 'POSTGRES' ) {
240 eval {
241 tie %session, 'Apache::Session::Postgres', $sid, {
242 Handle => $keeper->SQL,
243 };
244 };
245 253 ahitrov } elsif ( $state->{session}->storage eq 'MEMCACHED' ) {
246 eval {
247 tie %session, 'Apache::Session::Memcached', $sid, {
248 Handler => $keeper->{session}->MEMD,
249 Expiration => $state->{session}->{lifetime},
250 };
251 };
252 194 ahitrov } else {
253 eval {
254 tie %session, 'Apache::Session::File', $sid, {
255 253 ahitrov Directory => $state->{session}->session_dir,
256 194 ahitrov };
257 };
258 }
259 if ($@) {
260 warn "Session data is not accessible: $@";
261 undef $sid;
262 264 ahitrov } else {
263 $sid = $session{_session_id};
264 if ( $state->{session}->lifetime ) {
265 unless ( exists $session{_timestamp} ) {
266 $session{_timestamp} = $now;
267 } elsif ( ($now - $session{_timestamp}) > $state->{session}->lifetime ) {
268 undef $sid;
269 } elsif ( ($now - $session{_timestamp}) > $state->{session}->checkout ) {
270 $session{_timestamp} = $now;
271 }
272 194 ahitrov }
273 }
274 unless ( $sid ) {
275 if ( $state->{session}->storage eq 'POSTGRES' ) {
276 eval {
277 tie %session, 'Apache::Session::Postgres', undef, {
278 Handle => $keeper->SQL,
279 };
280 };
281 253 ahitrov } elsif ( $state->{session}->storage eq 'MEMCACHED' ) {
282 eval {
283 tie %session, 'Apache::Session::Memcached', undef, {
284 Handler => $keeper->{session}->MEMD,
285 Expiration => $state->{session}->{lifetime},
286 };
287 };
288 194 ahitrov } else {
289 eval {
290 tie %session, 'Apache::Session::File', undef, {
291 255 ahitrov Directory => $state->{session}->session_dir,
292 194 ahitrov };
293 };
294 }
295 $session{_timestamp} = $now;
296 }
297
298 return \%session;
299 }
300
301
302 sub _drop_session_object {
303
304 my (%session) = @_;
305
306 untie %session;
307
308 }
309
310 281 ahitrov sub _get_hash_from_profile {
311 my $profile = shift;
312 return unless ref $profile;
313
314 my %data = (
315 id => $profile->id,
316 name => $profile->name,
317 email => $profile->email,
318 login => $profile->login,
319 status => $profile->status,
320 ltime => time,
321 );
322 my ($type_prop) = grep { $_->{attr} eq 'type' } $profile->structure;
323 $data{type} = $profile->type if $type_prop;
324 my ($ava_prop) = grep { $_->{attr} eq 'avatar' } $profile->structure;
325 if ( $ava_prop ) {
326 my $avatar = $profile->get_image('avatar');
327 $data{avatar} = $avatar->{mini}{filename} if ref $avatar && exists $avatar->{filename};
328 }
329
330 return %data;
331 }
332
333 194 ahitrov 1;