package LIMS::Model::User;
use base 'LIMS::Model::Base';
use strict;
use Data::Dumper;
use LIMS::Local::Utils;
#-------------------------------------------------------------------------------
# uses $id to get user:
sub get_user_profile {
my $self = shift;
my $id = shift;
# load speculative so update_user_details() doesn't crash for 'new user':
my $user = LIMS::DB::User->new(id => $id)->load(speculative => 1);
return $user;
}
#-------------------------------------------------------------------------------
# uses one of unique keys to get user:
sub get_user_details {
my $self = shift;
my $args = shift;
my $col = $args->{col};
my $val = $args->{value};
my %params = (
speculative => 1, # in case $args->{value} incorrect (eg email)
use_key => $col, # need to tell RDBO which key to use
with => 'user_location',
);
#$Rose::DB::Object::Debug = 1;
my $user = LIMS::DB::User->new( $col => $val )->load( %params );
#$Rose::DB::Object::Debug = 0;
return $user;
}
#-------------------------------------------------------------------------------
sub in_local_network {
my ($self, $user_location_id) = @_;
my @args = (
query => [ 'user_locations.id' => $user_location_id ],
with_objects => 'parent_organisation.user_locations',
);
my $i = LIMS::DB::LocalNetworkLocation::Manager
->get_local_network_locations_count(@args); # warn Dumper $i;
return $i; # or could return $o->parent_organisation if region_code needed
}
#-------------------------------------------------------------------------------
sub get_user_by_username {
my $self = shift;
my $username = shift; # scalar or array
if ( ref $username eq 'ARRAY' ) {
return LIMS::DB::User::Manager->get_users(
query => [ username => $username ]
);
}
else {
return LIMS::DB::User->new(username => $username)
->load(speculative => 1, with => 'user_location');
}
}
#-------------------------------------------------------------------------------
sub get_users_for_location {
my ($self, $location) = @_;
my @args = (
query => [
location_name => $location,
],
require_objects => 'user_location',
);
my $o = LIMS::DB::User::Manager->get_users(@args);
return $o;
}
#-------------------------------------------------------------------------------
sub register_login {
my $self = shift;
my $session = shift;
my $session_data = $session->dataref; # DEBUG $session_data;
my $user_agent = $ENV{HTTP_USER_AGENT}; # ensure str <= 255 chars:
$user_agent = substr($user_agent, 0, 255) if (length $user_agent) > 255;
my %data = (
user_id => $session_data->{UserProfile}->{id},
address => $session->remote_addr,
browser => $user_agent,
session_id => $session->id,
); # DEBUG \%data;
LIMS::DB::Login->new(%data)->save;
}
#-------------------------------------------------------------------------------
sub update_password {
my $self = shift;
my $args = shift;
eval {
my $user = LIMS::DB::User->new(id => $args->{id})->load;
$user->password($args->{pwd});
$user->active('yes'); # in case re-activating expired account
$user->save(changes_only => 1);
};
return $@ if $@;
}
#-------------------------------------------------------------------------------
sub update_location {
my $self = shift;
my $data = shift; # warn Dumper $args;
my $user = $data->{user_profile}; # user object loaded in C::User
eval {
$user->user_location_id($data->{location_id});
$user->save(changes_only => 1);
};
return $@ if $@;
}
#-------------------------------------------------------------------------------
sub update_email {
my $self = shift;
my $data = shift; # warn Dumper $args;
my $user = $data->{user_profile}; # user object loaded in C::User
eval {
$user->email($data->{email}); # warn Dumper $user->as_tree;
$user->save(changes_only => 1);
};
return $@ if $@;
}
#-------------------------------------------------------------------------------
sub delete_user {
my $self = shift;
my $user_id = shift;
eval {
LIMS::DB::User->new(id => $user_id)->delete;
};
return $@ if $@;
}
#-------------------------------------------------------------------------------
sub get_all_users {
my $self = shift;
my $args = shift || {}; # warn Dumper $args;
$args->{require_objects} = ['user_location', 'group'];
$args->{sort_by} ||= 'username';
my $data = LIMS::DB::User::Manager->get_users_iterator(%$args); # DEBUG $data;
return $data;
}
#-------------------------------------------------------------------------------
sub update_user {
my $self = shift;
my $data = shift; # $self->debug($data);
my %args = ( class => 'User', data => $data );
return $self->update_object(\%args);
}
#-------------------------------------------------------------------------------
sub update_session_userid {
my $self = shift;
my $args = shift;
LIMS::DB::Session::Manager->update_sessions(
set => { userid => uc $args->{userid} },
where => [ id => $args->{session_id} ],
); # don't care about error return ?
}
#-------------------------------------------------------------------------------
sub update_last_login {
my ($self, $userid) = @_;
# update last_login timestamp:
my $o = LIMS::DB::User->new(username => $userid)->load;
$o->last_login('NOW()');
$o->save(changes_only => 1);
}
#-------------------------------------------------------------------------------
sub delete_user_permissions {
my $self = shift;
my $user_id = shift;
my %args = (
where => [ user_id => $user_id ],
);
eval {
LIMS::DB::UserPermission::Manager->delete_user_permissions(%args);
};
return $@ if $@;
}
#-------------------------------------------------------------------------------
sub delete_user_message {
my $self = shift;
my $msg_id = shift;
eval {
LIMS::DB::UserMessage->new(id => $msg_id)->delete;
};
return $@ if $@;
}
#-------------------------------------------------------------------------------
sub check_user_roles {
my $self = shift;
my $role = shift;
my $str = qq{binary '$role'}; # force case-sensitive so we don't get duplicates
my @args = ( query => [ designation => \$str ] );
my $count = LIMS::DB::User::Manager->get_users_count(@args); # warn $count;
return $count;
}
#-------------------------------------------------------------------------------
sub get_user_function {
my $self = shift;
my $id = shift;
my $function = LIMS::DB::UserFunction->new(id => $id)->load; # DEBUG $function
return $function;
}
#-------------------------------------------------------------------------------
sub get_user_functions {
my $self = shift;
my $args = shift || {};
# get all user_functions rows as arrayref:
my $data = LIMS::DB::UserFunction::Manager->get_user_functions(%$args); # DEBUG $data;
return $data;
}
#-------------------------------------------------------------------------------
sub get_user_group {
my $self = shift;
my $id = shift;
my $group = LIMS::DB::UserGroup->new(id => $id)->load; # DEBUG $group
return $group;
}
#-------------------------------------------------------------------------------
sub get_user_groups {
my $self = shift;
my $args = shift || {};
# get all user_functions rows as arrayref:
my $data = LIMS::DB::UserGroup::Manager->get_user_groups(%$args); # DEBUG $data;
return $data;
}
#-------------------------------------------------------------------------------
sub get_user_group_functions {
my $self = shift;
my $group_id = shift;
my %args = (
query => [ 'group_id' => $group_id ],
require_objects => 'function',
);
# get all user_group_function rows for submitted $group_id:
my $data = LIMS::DB::UserGroupFunction::Manager->get_user_group_functions(%args); # DEBUG $data;
return $data;
}
#-------------------------------------------------------------------------------
sub get_user_location {
my $self = shift;
my $id = shift;
my $location = LIMS::DB::UserLocation->new(id => $id)->load; # DEBUG $function
return $location;
}
#-------------------------------------------------------------------------------
sub get_location_by_name {
my ($self, $location_name) = @_;
my $location = LIMS::DB::UserLocation->new(location_name => $location_name)
->load(speculative => 1); # for Admin/User/new_user
return $location;
}
#-------------------------------------------------------------------------------
sub get_user_locations {
my $self = shift;
my $args = shift || {};
$args->{sort_by} = 'location_name';
$args->{with_objects} = 'parent_code';
# get all user_functions rows as arrayref:
my $data = LIMS::DB::UserLocation::Manager->get_user_locations(%$args); # DEBUG $data;
return $data;
}
#-------------------------------------------------------------------------------
sub any_new_messages {
my ($self, $username) = @_;
my @args = (
query => [
username => $username,
acknowledged => undef,
],
require_objects => [ 'recipient' ],
);
my $i = LIMS::DB::UserMessage::Manager->get_user_messages_count(@args);
return $i;
}
#-------------------------------------------------------------------------------
sub get_user_messages {
my ($self, $user_id) = @_;
my %args = (
query => [ recipient_id => $user_id ],
require_objects => [ qw(recipient sender) ],
sort_by => 'received',
);
my %data = ();
my $inbound = LIMS::DB::UserMessage::Manager->get_user_messages(%args);
$data{inbound} = $inbound;
# change recipient to sender:
$args{query} = [ sender_id => $user_id ];
my $outbound = LIMS::DB::UserMessage::Manager->get_user_messages(%args);
$data{outbound} = $outbound;
return \%data;
}
#-------------------------------------------------------------------------------
sub new_user_message {
my $self = shift;
my $vars = shift;
my $sender_id = $self->user_profile->{id};
my %data = (
recipient_id => $vars->{user_id},
sender_id => $sender_id,
message => $vars->{message},
);
eval {
LIMS::DB::UserMessage->new(%data)->save;
};
return $@ if $@;
}
#-------------------------------------------------------------------------------
sub get_admin_messages {
my ($self, $user_type) = @_;
my @args = (
query => [
user_group => [ $user_type, 'all' ],
valid_until => { ge => LIMS::Local::Utils::today->ymd },
],
sort_by => 'time',
);
my $data = LIMS::DB::AdminMessage::Manager->get_admin_messages(@args); # DEBUG $data;
return $data;
}
#-------------------------------------------------------------------------------
sub acknowledge_messages {
my ($self, $message_id) = @_;
my $now = LIMS::Local::Utils::time_now();
eval {
for my $id (@$message_id) {
my $o = LIMS::DB::UserMessage->new(id => $id)->load();
$o->acknowledged($now);
$o->save(changes_only => 1);
}
};
return $@ if $@;
}
#-------------------------------------------------------------------------------
sub get_user_permissions {
my $self = shift;
my $user_id = shift;
my %args = (
query => [ 'user_id' => $user_id ],
require_objects => 'function',
);
# get user permissions (if any) from user_permission table:
my $user_permissions = LIMS::DB::UserPermission::Manager
->get_user_permissions(%args);
return $user_permissions;
}
#-------------------------------------------------------------------------------
sub display_user_permissions {
my $self = shift;
# get user group functions map:
my $user_group_functions = do {
my @args = ( require_objects => 'function' );
LIMS::DB::UserGroupFunction::Manager->get_user_group_functions(@args);
};
# get lab staff:
my $lab_name = $self->lims_cfg->{settings}->{lab_name_abbreviation};
my $all_users = $self->get_all_users; # iterator
my %lab_staff;
while ( my $user = $all_users->next ) {
next unless $user->user_location->location_name eq $lab_name
&& $user->active eq 'yes';
my $username = $user->username;
my $group_id = $user->group_id;
# try custom settings 1st, else use generic for user group:
my $user_permissions = $self->get_user_permissions($user->id);
if (@$user_permissions) {
map $lab_staff{$username}{$_->function_id}++, @$user_permissions;
}
else {
map $lab_staff{$username}{$_->function_id}++,
grep $_->group_id == $group_id, @$user_group_functions;
}
} # warn Dumper \%lab_staff;
return \%lab_staff;
}
#-------------------------------------------------------------------------------
sub update_user_functions {
my $self = shift;
my $data = shift;
my %args = ( class => 'UserFunction', data => $data );
return $self->update_object(\%args);
}
#-------------------------------------------------------------------------------
sub update_user_groups {
my $self = shift;
my $data = shift; # DEBUG $group;
my %args = ( class => 'UserGroup', data => $data );
return $self->update_object(\%args);
}
#-------------------------------------------------------------------------------
sub update_user_group_functions {
my $self = shift;
my $args = shift; # DEBUG $args;
my $db = $self->lims_db; # ie LIMS::DB->new_or_cached;
my $group_id = $args->{group_id} || die 'No group_id value passed to update_user_group_functions()';
my $function_ids = $args->{function_ids}; # arrayref
# methods in anon sub MUST use same $db as do_transaction():
my $ok = $db->do_transaction( sub {
# first clear existing entries for this group_id:
LIMS::DB::UserGroupFunction::Manager->delete_user_group_functions(
where => [ group_id => $group_id ],
);
foreach my $id (@$function_ids) { # warn $id, "\n";
LIMS::DB::UserGroupFunction->new(
function_id => $id,
group_id => $group_id,
)->save;
}
});
# don't need return value unless error:
return $ok ? 0 : 'update_user_group_functions() error - ' . $db->error;
}
#-------------------------------------------------------------------------------
sub update_user_locations {
my $self = shift;
my $data = shift;
my %args = ( class => 'UserLocation', data => $data );
return $self->update_object(\%args);
}
#-------------------------------------------------------------------------------
sub update_user_permissions {
my $self = shift;
my $args = shift; # DEBUG $args;
my $db = $self->lims_db; # ie LIMS::DB->new_or_cached;
my $user_id = $args->{user_id} || die 'No user_id value passed to update_user_permissions()';
my $function_ids = $args->{function_ids}; # arrayref
# delete existing & update user_permissions in a single transaction:
my $ok = $db->do_transaction( sub {
# first clear existing entries for this group_id:
LIMS::DB::UserPermission::Manager->delete_user_permissions(
where => [ user_id => $user_id ],
);
# insert any new permissions:
foreach my $id ( @{ $function_ids } ) {
LIMS::DB::UserPermission->new(
function_id => $id,
user_id => $user_id,
)->save;
}
});
# don't need return value unless error:
return $ok ? 0 : 'update_user_permissions() error - ' . $db->error;
}
#-------------------------------------------------------------------------------
sub verify_credentials {
my $self = shift;
my ($user_id, $pwd, $vars) = @_; # warn Dumper [$user_id, $pwd, $vars];
my ($first_name, $last_name) = split '\.', $user_id;
my %args = (
last_name => $last_name,
first_name => $first_name,
);
my $user = LIMS::DB::User->new(%args)->load(speculative => 1) || return 0;
return 0 unless $user->active eq 'yes'; # 'active' not unique key so ignored as arg
# if this is 1st login using registration email link, need further checks to
# ensure link not being used again after successful login:
if ( my $int = $vars->{first_login} ) {
# dt->epoch always ends in 00 if hr, mins, sec all 0, so 'first_login'
# var in email link = new user creation date->epoch / 100;
# last_login col updated after successful login so will never match again
my $epoch = $int * 100; # multiply back to epoch value
return 0 unless ( $vars->{uid} == $user->id # users.id matches uid
&& $user->last_login->epoch == $epoch ); # epochs match
}
# delete user from sessions table (if exists) to prevent concurrent logins:
my $o = LIMS::DB::Session->new( userid => $user->username );
if ( $o->load_speculative ) { $o->delete }
my $password = LIMS::Local::Utils::sha1_digest($pwd);
return $user->password eq $password ? $user->username : 0;
}
1;
