• Keeper.pm

    280 281  
    54 54
    55 55 sub logoff {
    56 56 my $self = shift;
    57 my %opts = @_;
    57 my (%opts) = @_;
    58 58
    59 59 my $sid = _get_session_id ();
    60 60 my $session = _get_session_object ( $sid );
    … …  
    63 63 my $session_id = $session->{_session_id};
    64 64 if (!$sid || $sid ne $session_id) {
    65 65 warn "LOGOFF: New or deprecated session. Old sid = '$sid', new sid = '$session_id'" if $DEBUG;
    66 _store_session_id ($session_id)
    66 _store_session_id ($session_id, %opts)
    67 67 } else {
    68 68 if ( exists $opts{clear} ) {
    69 69 my @clear = qw( id email login name nick type status ltime );
    … …  
    123 123 my $value = $session->{$name};
    124 124 if (!$sid || $sid ne $session_id) {
    125 125 warn "GET_VALUE: New or deprecated session. Old sid = '$sid', new sid = '$session_id'" if $DEBUG;
    126 _store_session_id ($session_id);
    126 _store_session_id ($session_id, %opts);
    127 127 }
    128 128 untie %$session;
    129 129 return $value;
    … …  
    133 133 sub store_value {
    134 134
    135 135 my ($self, %opts) = @_;
    136 my $domain = delete $opts{domain};
    136 137 my $sid = delete $opts{_session_id} || _get_session_id ();
    137 138 my $session = _get_session_object ( $sid );
    138 139 return unless ref $session;
    … …  
    144 145 my $session_id = $session->{_session_id};
    145 146 if (!$sid || $sid ne $session_id) {
    146 147 warn "STORE_VALUE: New or deprecated session. Old sid = '$sid', new sid = '$session_id'" if $DEBUG;
    147 _store_session_id ($session_id);
    148 _store_session_id ($session_id, domain => $domain);
    148 149 }
    149 150 untie %$session;
    150 151 return 1;
    … …  
    163 164 my $session_id = $session->{_session_id};
    164 165 if (!$sid || $sid ne $session_id) {
    165 166 warn "DELETE_VALUE: New or deprecated session. Old sid = '$sid', new sid = '$session_id'" if $DEBUG;
    166 _store_session_id ($session_id);
    167 _store_session_id ($session_id, %opts);
    167 168 } else {
    168 169 delete $session->{$key} if exists $session->{$key};
    169 170 }
    … …  
    175 176 sub get_session {
    176 177
    177 178 my $self = shift;
    179 my (%opts) = @_;
    178 180
    179 181 my $sid = _get_session_id () || '';
    180 182 my $session = _get_session_object ($sid);
    … …  
    184 186 my %ret = %$session;
    185 187 if (!$sid || $sid ne $session_id) {
    186 188 warn "\nGET_SESSION: New or deprecated session. Old sid = '$sid', new sid = '$session_id'\n" if $DEBUG;
    187 _store_session_id ($session_id);
    189 _store_session_id ($session_id, %opts);
    188 190 }
    189 191 untie %$session;
    190 192
    191 return \%ret;
    193 my $session_object = session::Session->new( %ret );
    194 return $session_object;
    192 195 }
    193 196
    194 197
    … …  
    197 200 sub _store_session_id {
    198 201
    199 202 my $sid = shift;
    203 my (%opts) = @_;
    200 204 return unless $sid;
    201 205 my $cookie = Apache::Cookie->new ($request->r(),
    202 -domain => $state->{session}->domain,
    206 -domain => $opts{domain} || $state->{session}->domain,
    203 207 -name => $state->{session}->cookie,
    204 208 -expires=> $state->{session}->expires,
    205 209 -value => $sid,
    … …  
    212 216
    213 217 sub _get_session_id {
    214 218
    219 my $keyname = shift || $state->{session}->cookie;
    220
    215 221 my %cookies = Apache::Cookie->fetch;
    216 222 warn Dumper(\%cookies) if $DEBUG;
    217 my $cookie = $cookies{$state->{session}->cookie};
    223 my $cookie = $cookies{$keyname};
    218 224
    219 225 # ����������� SID �� ����
    220 226 my $sid = $cookie->value() || '' if $cookie;
    … …  
    301 307
    302 308 }
    303 309
    310 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
    304 333 1;