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;