Revision 315 (by ahitrov, 2013/04/24 19:21:22) |
Very strange bug thus not resolved. Store during login returns somewhere not in context
|
package users::Keeper;
use strict;
use warnings 'all';
use base qw(Contenido::Keeper);
use Digest::MD5;
use Contenido::Globals;
use Data::Dumper;
# ----------------------------------------------------------------------------
# Функции:
# ----------------------------------------------------------------------------
# check_login: Наличие пользователя в системе
#
# login => login пользователя
# email => email пользователя
# ----------------------------------------------------------------------------
sub check_login {
my $self = shift;
my %opts = @_;
return if !$opts{login} && !$opts{email};
my $class = $self->state->profile_document_class;
my $res = $keeper->get_documents (
class => $class,
$opts{login} ? (login => $opts{login}) : (),
$opts{email} ? (email => lc($opts{email})) : (),
count => 1,
);
return int($res);
}
# ----------------------------------------------------------------------------
# login: Авторизация пользователя
#
# login => login пользователя
# email => e-mail пользователя
# phone => телефон пользователя
# passwd => пароль пользователя
# ----------------------------------------------------------------------------
sub login {
my $self = shift;
my (%opts) = @_;
return if !($opts{login} || $opts{email} || $opts{phone}) && !$opts{passwd};
my $password = delete $opts{passwd};
my $passmd5 = Digest::MD5::md5_hex( $password );
my $class = $self->state->profile_document_class;
my $profile = $self->get_profile( %opts, status => [qw(1 2 3 4 5)] );
return unless ref $profile;
my $result;
warn "Password = $password; Pass MD5 = $passmd5; user MD5 = ".$profile->passwd."\n" if $DEBUG;
if ($profile->passwd eq $passmd5 ) {
my ($prop) = grep { $_->{attr} eq 'lastlogin' } $profile->structure;
if ( ref $prop ) {
my $now = Contenido::DateTime->new;
$profile->lastlogin( $now->ymd('-').' '.$now->hms );
# $profile->store;
}
warn "\nLogin successful\n" if $DEBUG;
return $profile;
} else {
warn "\nLogin [UN]successful\n" if $DEBUG;
return undef;
}
}
# ----------------------------------------------------------------------------
# confirm: Подтверждение аутентификации
#
# login => login пользователя
# email => e-mail пользователя
# md5 => MD5 пароля пользователя
# ----------------------------------------------------------------------------
sub confirm {
my $self = shift;
my %opts = @_;
return if !($opts{login} || $opts{email}) && !$opts{md5};
my $class = $self->state->profile_document_class;
my $res = $keeper->get_documents (
class => $class,
$opts{login} ? (login => $opts{login}) : (),
$opts{email} ? (email => lc($opts{email})) : (),
return_mode => 'array_ref',
);
$res = ref $res eq 'ARRAY' && scalar @$res ? $res->[0] : undef;
return unless ref $res;
warn "MD5 = ".$opts{md5}."; user MD5 = ".$res->passwd."\n" if $DEBUG;
if ($res->passwd eq $opts{md5} ) {
my $now = localtime;
$res->lastlogin( $now );
$res->passwd(undef);
$res->status(1);
$res->store;
return $res;
}else{
return;
}
}
# ----------------------------------------------------------------------------
# get_profile: Вытащить профиль пользователя
#
# id => по ID
# login => по login
# email => по e-mail
# nickname=> по никнейму
# status => фильтр по статусу
# При включенных credentials:
# phone => по телефону
# vkontakte => по логину ВК
# facebook => по логину Facebook
# google => по логину Google
# mailru => по логину Mail.ru
# ----------------------------------------------------------------------------
sub get_profile {
my $self = shift;
my (%opts) = @_;
my $profile;
if ( $self->state->use_credentials && !$opts{login} && !$opts{id} ) {
$profile = $self->get_profile_by_credential ( %opts );
} else {
return if !$opts{login} && !$opts{id} && !$opts{email} && !$opts{nickname};
my $class = $self->state->profile_document_class;
($profile) = $keeper->get_documents (
class => $class,
%opts,
limit => 1,
);
}
return $profile;
}
sub get_profile_by_credential {
my $self = shift;
my (%opts) = @_;
my $credential;
if ( $opts{email} && $self->_email_format($opts{email}) ) {
($credential) = $keeper->get_documents (
class => 'users::Email',
name => $self->_email_reduction( delete $opts{email} ),
limit => 1,
);
} elsif ( $opts{phone} && $self->_phone_reduction($opts{phone}) ) {
($credential) = $keeper->get_documents (
class => 'users::Phone',
name => $self->_phone_reduction( delete $opts{phone} ),
limit => 1,
);
} elsif ( $opts{vkontake} ) {
($credential) = $keeper->get_documents (
class => 'users::OA::VK',
ext_id => delete $opts{vkontakte},
limit => 1,
);
} elsif ( $opts{facebook} ) {
($credential) = $keeper->get_documents (
class => 'users::OA::FaceBook',
ext_id => delete $opts{facebook},
limit => 1,
);
} elsif ( $opts{mailru} ) {
($credential) = $keeper->get_documents (
class => 'users::OA::Mailru',
ext_id => delete $opts{mailru},
limit => 1,
);
} elsif ( $opts{google} ) {
($credential) = $keeper->get_documents (
class => 'users::OA::Google',
ext_id => delete $opts{google},
limit => 1,
);
}
return unless ref $credential;
my $class = $self->state->profile_document_class;
my $profile = $keeper->get_document_by_id ( $credential->uid,
class => $class,
%opts,
);
return $profile;
}
###### Additional subs
###################################################
sub _email_format {
my $self = shift;
my $email = shift;
for ( $email ) {
s/^\s+//;
s/\s+$//;
}
if ( $email =~ /^[\-\.\w\d]+\@[a-z\d\-\.]+\.[a-z\d]+$/i ) {
return $email;
}
return undef;
}
sub _email_reduction {
my $self = shift;
my $email = shift;
for ( $email ) {
s/^\s+//;
s/\s+$//;
}
if ( $email =~ /^[\-\.\w\d]+\@[a-z\d\-\.]+\.[a-z\d]+$/i ) {
return lc( $email );
}
return undef;
}
sub _phone_format {
my $self = shift;
my $phone = shift;
if ( $phone ) {
for ( $phone ) {
s/-//g;
s/\[/\(/g;
s/\]/\)/g;
s/^\s+//;
s/\s+$//;
}
if ( $phone =~ /^\+?(\d)+[\(\ ]+(\d+)[\)\ ]+([\d+\ ])$/ ) {
my $cc = $1;
my $code = $2;
my $number = $3; $number =~ s/\D//g;
$phone = $cc.'('.$code.')'.$phone;
} elsif ( $phone =~ /^[\(]+(\d+)[\)\ ]+([\d+\ ])$/ ) {
my $cc = '7';
my $code = $1;
my $number = $2; $number =~ s/\D//g;
$phone = $cc.'('.$code.')'.$phone;
} else {
$phone =~ s/\D//g;
}
return $phone;
}
}
sub _phone_reduction {
my $self = shift;
my $phone = shift;
if ( $phone ) {
$phone =~ s/\D//g;
return $phone || undef;
}
}
1;