Contenido Project
version 7
SVN-репозиторий
Line # Revision Author
1 191 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 use Contenido::Globals;
11 use Data::Dumper;
12
13
14 sub logon {
15 my $self = shift;
16 my %opts = @_;
17
18 return if !($opts{login} || $opts{email}) && !$opts{passwd};
19
20 my $res;
21 my @plugins = split (/[\ |\t]+/, $state->{plugins});
22 if ( grep { $_ eq 'users' } @plugins ) {
23 #### ����������� ����� ������ users
24 #########################################
25 $res = $keeper->{users}->login (
26 $opts{login} ? (login => $opts{login}) : (),
27 $opts{email} ? (email => lc($opts{email})) : (),
28 passwd => $opts{passwd},
29 );
30 return unless $res;
31 } else {
32 #### ����������� ���� ��������
33
34
35
36 }
37 if ( ref $res ) {
38 my %data = (
39 id => $res->id,
40 name => $res->name,
41 email => $res->email,
42 login => $res->login,
43 status => $res->status,
44 ltime => time,
45 );
46 $self->store_value ( %data );
47 }
48 return $self->get_session();
49 }
50
51
52 sub logoff {
53 my $self = shift;
54 my $sid = _get_session_id ();
55 my $session = _get_session_object ( $sid );
56 return unless ref $session;
57
58 my $session_id = $session->{_session_id};
59 if (!$sid || $sid ne $session_id) {
60 warn "LOGOFF: New or deprecated session. Old sid = '$sid', new sid = '$session_id'" if $DEBUG;
61 _store_session_id ($session_id)
62 } else {
63 foreach my $key ( keys %$session ) {
64 next if $key eq '_session_id';
65 next if $key eq '_timestamp';
66 delete $session->{$key};
67 }
68 }
69 untie %$session;
70 return 1;
71 }
72
73
74 sub get_value {
75
76 my ($self, $name) = @_;
77 my $sid = _get_session_id ();
78 my $session = _get_session_object ( $sid );
79 return unless ref $session;
80
81 my $session_id = $session->{_session_id};
82 my $value = $session->{$name};
83 if (!$sid || $sid ne $session_id) {
84 warn "GET_VALUE: New or deprecated session. Old sid = '$sid', new sid = '$session_id'" if $DEBUG;
85 _store_session_id ($session_id);
86 }
87 untie %$session;
88 return $value;
89 }
90
91
92 sub store_value {
93
94 my ($self, %opts) = @_;
95 my $sid = _get_session_id ();
96 my $session = _get_session_object ( $sid );
97 return unless ref $session;
98
99 foreach my $key ( keys %opts ) {
100 $session->{$key} = $opts{$key};
101 }
102
103 my $session_id = $session->{_session_id};
104 if (!$sid || $sid ne $session_id) {
105 warn "STORE_VALUE: New or deprecated session. Old sid = '$sid', new sid = '$session_id'" if $DEBUG;
106 _store_session_id ($session_id);
107 }
108 untie %$session;
109 return 1;
110 }
111
112
113 sub delete_key {
114
115 my ($self, $key) = @_;
116 return unless $key;
117
118 my $sid = _get_session_id ();
119 my $session = _get_session_object ( $sid );
120 return unless ref $session;
121
122 my $session_id = $session->{_session_id};
123 if (!$sid || $sid ne $session_id) {
124 warn "DELETE_VALUE: New or deprecated session. Old sid = '$sid', new sid = '$session_id'" if $DEBUG;
125 _store_session_id ($session_id);
126 } else {
127 delete $session->{$key} if exists $session->{$key};
128 }
129 untie %$session;
130 return 1;
131 }
132
133
134 sub get_session {
135
136 my $self = shift;
137
138 my $sid = _get_session_id () || '';
139 my $session = _get_session_object ($sid);
140 return unless ref $session;
141
142 my $session_id = $session->{_session_id};
143 my %ret = %$session;
144 if (!$sid || $sid ne $session_id) {
145 warn "\nGET_SESSION: New or deprecated session. Old sid = '$sid', new sid = '$session_id'\n" if $DEBUG;
146 _store_session_id ($session_id);
147 }
148 untie %$session;
149
150 return \%ret;
151 }
152
153
154 ## ���������� �������
155 ######################################################################################
156 sub _store_session_id {
157
158 my $sid = shift;
159 return unless $sid;
160 my $cookie = Apache::Cookie->new ($request->r(),
161 -domain => $state->{session}->domain,
162 -name => $state->{session}->cookie,
163 -expires=> $state->{session}->expires,
164 -value => $sid,
165 -path => '/',
166 );
167 $cookie->bake();
168
169 }
170
171
172 sub _get_session_id {
173
174 my %cookies = Apache::Cookie->fetch;
175 warn Dumper(\%cookies) if $DEBUG;
176 my $cookie = $cookies{$state->{session}->cookie};
177
178 # ����������� SID �� ����
179 my $sid = $cookie->value() || '' if $cookie;
180 warn "\nSession_id = $sid\n" if $DEBUG;
181
182 return $sid;
183 }
184
185
186 sub _get_session_object {
187
188 my $sid = shift;
189
190 my %session;
191 my $now = time;
192 if ( $state->{session}->storage eq 'POSTGRES' ) {
193 eval {
194 tie %session, 'Apache::Session::Postgres', $sid, {
195 Handle => $keeper->SQL,
196 };
197 };
198 } else {
199 eval {
200 tie %session, 'Apache::Session::File', $sid, {
201 Directory => $state->session->session_dir,
202 };
203 };
204 }
205 if ($@) {
206 warn "Session data is not accessible: $@";
207 undef $sid;
208 } elsif ( $state->{session}->lifetime ) {
209 unless ( exists $session{_timestamp} ) {
210 $session{_timestamp} = $now;
211 } elsif ( ($now - $session{_timestamp}) > $state->{session}->lifetime ) {
212 undef $sid;
213 } elsif ( ($now - $session{_timestamp}) > $state->{session}->checkout ) {
214 $session{_timestamp} = $now;
215 }
216 }
217 unless ( $sid ) {
218 if ( $state->{session}->storage eq 'POSTGRES' ) {
219 eval {
220 tie %session, 'Apache::Session::Postgres', undef, {
221 Handle => $keeper->SQL,
222 };
223 };
224 } else {
225 eval {
226 tie %session, 'Apache::Session::File', undef, {
227 Directory => $state->session->session_dir,
228 };
229 };
230 }
231 $session{_timestamp} = $now;
232 }
233
234 return \%session;
235 }
236
237
238 sub _drop_session_object {
239
240 my (%session) = @_;
241
242 untie %session;
243
244 }
245
246 1;

Небольшая справка по веткам

cnddist – контейнер, в котором хранятся все дистрибутивы всех библиотек и программных пакетов, которые использовались при построении различных версий Contenido. Если какой-то библиотеки в данном хранилище нет, инсталлятор сделает попытку "подтянуть" ее с веба (например, с CPAN). Если библиотека слишком старая, есть очень большая вероятность, что ее там уже нет. Поэтому мы храним весь хлам от всех сборок. Если какой-то дистрибутив вдруг отсутствует в cnddist - напишите нам, мы положим его туда.

koi8 – отмирающая ветка, чей код, выдача и все внутренние библиотеки заточены на кодировку KOI8-R. Вносятся только те дополнения, которые касаются внешнего вида и функционала админки, баги ядра, обязательные обновления портов и мелочи, которые легко скопипастить. В дальнейшем планируется полная остановка поддержки по данной ветке.

utf8 – актуальная ветка, заточенная под UTF-8.

Внутри каждой ветки: core – исходники ядра; install – скрипт установки инсталляции; plugins – плагины; samples – "готовые к употреблению" проекты, которые можно поставить, запустить и посмотреть, как они работают.
© 2003 – 2009 «Рамблер»
© 2010 – 2025 «Андрей (Handy) Хитров»