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; } #------------------------------------------------------------------------------- sub get_login_count { my ($self, $user_id) = @_; my @args = ( query => [ user_id => $user_id ] ); my $i = LIMS::DB::Login::Manager->get_objects_count(@args); return $i; } #------------------------------------------------------------------------------- # 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 get_users_for_location_id { my ($self, $location_id) = @_; my @args = ( query => [ user_location_id => $location_id, ], sort_by => [ qw(last_name first_name) ], ); 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 = LIMS::Local::Utils::user_agent($ENV{HTTP_USER_AGENT}); my %data = ( user_id => $session_data->{UserProfile}->{id}, address => $session->remote_addr, browser => $user_agent, session_id => $session->id, ); # warn Dumper\%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} = [ qw(user_location group) ]; $args->{sort_by} ||= 'username'; my $o = LIMS::DB::User::Manager->get_objects(%$args); # DEBUG $data; return $o; } #------------------------------------------------------------------------------- sub update_user { my $self = shift; my $data = shift; # warn Dumper $data; # if registration_number supplied: if ( my $reg_num = delete $data->{reg_num} ) { # warn $reg_num; my $user_id = $data->{id}; # warn $user_id; my $o = LIMS::DB::UserRegistration->new(user_id => $user_id); $o->registration_number($reg_num); # warn Dumper $o; $o->insert_or_update(changes_only => 1); } 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_user_registration { my $self = shift; my $id = shift; my $o = LIMS::DB::UserRegistration->new(user_id => $id)->load_speculative; return $o; } #------------------------------------------------------------------------------- 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_active_user_locations { my $self = shift; my @args = ( query => [ active => 'yes', 'users.active' => 'yes' ], distinct => 1, require_objects => 'users', ); my $o = LIMS::DB::UserLocation::Manager->get_objects(@args); my %h = map { $_->location_name => $_->id } @$o; # warn Dumper \%h; return \%h; } #------------------------------------------------------------------------------- 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 = do { local $LIMS::Local::QueryLog::SKIP_LOG_QUERY = 1; 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); }; my $all_users = $self->get_all_users; # arrayref my $settings = $self->lims_cfg->{settings}; my $lab_name_abbr = $settings->{lab_name_abbreviation}; # always exists my $central_labs = $settings->{central_labs} || ''; # optional my @labs; push @labs, $lab_name_abbr; push @labs, split ',', $central_labs; # warn Dumper \@labs; # get lab staff: my %lab_staff; for my $user (@$all_users) { my $user_location = $central_labs eq 'all_locations' # eg genomics, make all lab-staff: ? 'all_locations' : $user->user_location->location_name; next unless $user->active eq 'yes' && grep $user_location eq $_, @labs; # warn $user->username; 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 $dev_env = $ENV{ROSEDB_DEVINIT} =~ /devinit_devel/; my %h; if ( $dev_env ) { $h{username} = $user_id; } else { @h{qw/first_name last_name/} = split '\.', $user_id; } my $user = LIMS::DB::User->new(%h)->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 } # dev server doesn't need password or session deletion: return $user->username if $dev_env && ! $ENV{USE_DB_SESSIONS}; # 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;