package session::Keeper;
use strict;
use warnings 'all';
use base qw(Contenido::Keeper);
use Apache::Cookie;
use Apache::Session::File;
use Apache::Session::Postgres;
use Contenido::Globals;
use Data::Dumper;
sub logon {
my $self = shift;
my %opts = @_;
return if !($opts{login} || $opts{email}) && !$opts{passwd};
my $res;
my @plugins = split (/[\ |\t]+/, $state->{plugins});
if ( grep { $_ eq 'users' } @plugins ) {
#### ����������� ����� ������ users
#########################################
$res = $keeper->{users}->login (
$opts{login} ? (login => $opts{login}) : (),
$opts{email} ? (email => lc($opts{email})) : (),
passwd => $opts{passwd},
);
return unless $res;
} else {
#### ����������� ���� ��������
}
if ( ref $res ) {
my %data = (
id => $res->id,
name => $res->name,
email => $res->email,
login => $res->login,
status => $res->status,
ltime => time,
);
my ($type_prop) = grep { $_->{attr} eq 'type' } $res->structure;
$data{type} = $res->type if $type_prop;
$self->store_value ( %data );
}
return $self->get_session();
}
sub logoff {
my $self = shift;
my (%opts) = @_;
my $sid = _get_session_id ();
my $session = _get_session_object ( $sid );
return unless ref $session;
my $session_id = $session->{_session_id};
if (!$sid || $sid ne $session_id) {
warn "LOGOFF: New or deprecated session. Old sid = '$sid', new sid = '$session_id'" if $DEBUG;
_store_session_id ($session_id, %opts)
} else {
if ( exists $opts{clear} ) {
my @clear = qw( id email login name nick type status ltime );
push @clear, @{ $opts{clear} } if exists $opts{clear} && ref $opts{clear} eq 'ARRAY' && @{ $opts{clear} };
foreach my $key ( @clear ) {
delete $session->{$key};
}
} else {
foreach my $key ( keys %$session ) {
next if $key eq '_session_id';
next if $key eq '_timestamp';
delete $session->{$key};
}
}
}
untie %$session;
return 1;
}
sub autologon {
my $self = shift;
my %opts = @_;
my $profile = delete $opts{profile};
if ( ref $profile ) {
my %data = (
id => $profile->id,
name => $profile->name,
email => $profile->email,
login => $profile->login,
status => $profile->status,
ltime => time,
);
my ($type_prop) = grep { $_->{attr} eq 'type' } $profile->structure;
$data{type} = $profile->type if $type_prop;
my ($ava_prop) = grep { $_->{attr} eq 'avatar' } $profile->structure;
if ( $ava_prop ) {
my $avatar = $profile->get_image('avatar');
$data{avatar} = $avatar->{mini}{filename} if ref $avatar && exists $avatar->{filename};
}
$self->store_value ( %data );
return $self->get_session();
}
return undef;
}
sub get_value {
my ($self, $name, %opts) = @_;
my $sid = delete $opts{_session_id} || _get_session_id ();
my $session = _get_session_object ( $sid );
return unless ref $session;
my $session_id = $session->{_session_id};
my $value = $session->{$name};
if (!$sid || $sid ne $session_id) {
warn "GET_VALUE: New or deprecated session. Old sid = '$sid', new sid = '$session_id'" if $DEBUG;
_store_session_id ($session_id, %opts);
}
untie %$session;
return $value;
}
sub store_value {
my ($self, %opts) = @_;
my $domain = delete $opts{domain};
my $sid = delete $opts{_session_id} || _get_session_id ();
my $session = _get_session_object ( $sid );
return unless ref $session;
foreach my $key ( keys %opts ) {
$session->{$key} = $opts{$key};
}
my $session_id = $session->{_session_id};
if (!$sid || $sid ne $session_id) {
warn "STORE_VALUE: New or deprecated session. Old sid = '$sid', new sid = '$session_id'" if $DEBUG;
_store_session_id ($session_id, domain => $domain);
}
untie %$session;
return 1;
}
sub delete_key {
my ($self, $key, %opts) = @_;
return unless $key;
my $sid = delete $opts{_session_id} || _get_session_id ();
my $session = _get_session_object ( $sid );
return unless ref $session;
my $session_id = $session->{_session_id};
if (!$sid || $sid ne $session_id) {
warn "DELETE_VALUE: New or deprecated session. Old sid = '$sid', new sid = '$session_id'" if $DEBUG;
_store_session_id ($session_id, %opts);
} else {
delete $session->{$key} if exists $session->{$key};
}
untie %$session;
return 1;
}
sub get_session {
my $self = shift;
my (%opts) = @_;
my $sid = _get_session_id () || '';
my $session = _get_session_object ($sid);
return unless ref $session;
my $session_id = $session->{_session_id};
my %ret = %$session;
if (!$sid || $sid ne $session_id) {
warn "\nGET_SESSION: New or deprecated session. Old sid = '$sid', new sid = '$session_id'\n" if $DEBUG;
_store_session_id ($session_id, %opts);
}
untie %$session;
my $session_object = session::Session->new( %ret );
return $session_object;
}
## ���������� �������
######################################################################################
sub _store_session_id {
my $sid = shift;
my (%opts) = @_;
return unless $sid;
my $cookie = Apache::Cookie->new ($request->r(),
-domain => $opts{domain} || $state->{session}->domain,
-name => $state->{session}->cookie,
-expires=> $state->{session}->expires,
-value => $sid,
-path => '/',
);
$cookie->bake();
}
sub _get_session_id {
my $keyname = shift || $state->{session}->cookie;
my %cookies = Apache::Cookie->fetch;
warn Dumper(\%cookies) if $DEBUG;
my $cookie = $cookies{$keyname};
# ����������� SID �� ����
my $sid = $cookie->value() || '' if $cookie;
warn "\nSession_id = $sid\n" if $DEBUG;
return $sid;
}
sub _get_session_object {
my $sid = shift;
my %session;
my $now = time;
if ( $state->{session}->storage eq 'POSTGRES' ) {
eval {
tie %session, 'Apache::Session::Postgres', $sid, {
Handle => $keeper->SQL,
};
};
} elsif ( $state->{session}->storage eq 'MEMCACHED' ) {
eval {
tie %session, 'Apache::Session::Memcached', $sid, {
Handler => $keeper->{session}->MEMD,
Expiration => $state->{session}->{lifetime},
};
};
} else {
eval {
tie %session, 'Apache::Session::File', $sid, {
Directory => $state->{session}->session_dir,
};
};
}
if ($@) {
warn "Session data is not accessible: $@";
undef $sid;
} else {
$sid = $session{_session_id};
if ( $state->{session}->lifetime ) {
unless ( exists $session{_timestamp} ) {
$session{_timestamp} = $now;
} elsif ( ($now - $session{_timestamp}) > $state->{session}->lifetime ) {
undef $sid;
} elsif ( ($now - $session{_timestamp}) > $state->{session}->checkout ) {
$session{_timestamp} = $now;
}
}
}
unless ( $sid ) {
if ( $state->{session}->storage eq 'POSTGRES' ) {
eval {
tie %session, 'Apache::Session::Postgres', undef, {
Handle => $keeper->SQL,
};
};
} elsif ( $state->{session}->storage eq 'MEMCACHED' ) {
eval {
tie %session, 'Apache::Session::Memcached', undef, {
Handler => $keeper->{session}->MEMD,
Expiration => $state->{session}->{lifetime},
};
};
} else {
eval {
tie %session, 'Apache::Session::File', undef, {
Directory => $state->{session}->session_dir,
};
};
}
$session{_timestamp} = $now;
}
return \%session;
}
sub _drop_session_object {
my (%session) = @_;
untie %session;
}
sub _get_hash_from_profile {
my $profile = shift;
return unless ref $profile;
my %data = (
id => $profile->id,
name => $profile->name,
email => $profile->email,
login => $profile->login,
status => $profile->status,
ltime => time,
);
my ($type_prop) = grep { $_->{attr} eq 'type' } $profile->structure;
$data{type} = $profile->type if $type_prop;
my ($ava_prop) = grep { $_->{attr} eq 'avatar' } $profile->structure;
if ( $ava_prop ) {
my $avatar = $profile->get_image('avatar');
$data{avatar} = $avatar->{mini}{filename} if ref $avatar && exists $avatar->{filename};
}
return %data;
}
1;