package LIMS::Controller::Resources; use Moose; BEGIN { extends 'LIMS::Base'; } with ( 'LIMS::Controller::Roles::Misc', 'LIMS::Controller::Roles::DataMap', 'LIMS::Controller::Roles::DataFile', 'LIMS::Controller::Roles::Resource', ); __PACKAGE__->meta->make_immutable(inline_constructor => 0); use CGI::Session; use Data::Dumper; use IO::All; #------------------------------------------------------------------------------- sub menu : StartRunmode { my $self = shift; $self->_debug_path($self->get_current_runmode); return $self->tt_process; } #------------------------------------------------------------------------------- sub list_all_screen_tests : Runmode { my $self = shift; $self->_debug_path($self->get_current_runmode); my $o = $self->model('Screen')->get_all_assigned_tests; my %tests; while (my $test = $o->next) { # $self->debug($test->as_tree); next if $test->screen->active eq 'no'; my $section_name = $test->lab_test->lab_section->section_name; my $description = $test->screen->description; my $field_label = $test->lab_test->field_label; my $category = $test->screen->category->name, my %data = ( section_name => $section_name, field_label => $field_label, ); push @{ $tests{$category}{$description} }, \%data; } $self->tt_params( data => \%tests ); return $self->tt_process; } #------------------------------------------------------------------------------- sub diagnostic_terms : Runmode { my $self = shift; my %args = ( sort_by => $self->query->param('sort_by') || '' ); my $total = $self->model('Base')->get_objects_count('Diagnosis'); if ( $total > $self->cfg('settings')->{entries_per_page} ) { # invoke pager for template and add limit & offset params to \%args: $self->pager({ query => \%args, total => $total }); } { # get all diagnoses: my $diagnoses = $self->model('Diagnosis')->get_all_diagnoses(\%args); $self->tt_params( diagnoses => $diagnoses ); } { # ICDO3 category - maps ICDO3 to sub-groups (AML, CLL, MCL, etc): my $sub_categories = $self->get_icdo_category(); # L::C::R::Misc $self->tt_params( sub_categories => $sub_categories ); } return $self->tt_process; } #------------------------------------------------------------------------------- sub teaching_cases : Runmode { my $self = shift; my $duration = $self->query->param('duration') || 365; # days default $self->stash( duration => $duration ); # for .tt my $time_now = LIMS::Local::Utils::time_now(); my $query = [ option_name => 'teaching', action => 'authorised', time => { ge => $time_now->subtract( days => $duration ) }, ]; my @objects = ('request_history', 'request_option.option'); # args = classname, optional hashref of args, optional with_objects: my @args = ('Request', { query => $query, multi_many_ok => 1 }, \@objects); my $total = $self->model('Base')->get_objects_count(@args); # warn Dumper $total; if ( $total > $self->cfg('settings')->{entries_per_page} ) { # invoke pager for template and add limit & offset params to \%args: $self->pager({ query => {}, total => $total }); } my $data = $self->model('Audit')->teaching_cases($duration); $self->tt_params( cases => $data, start_date => $self->model('Request')->get_first_request_date(), ); return $self->tt_process; } #------------------------------------------------------------------------------- sub view_cron_log : Runmode { my $self = shift; my $file = $self->cfg('settings')->{cron_log_path} . '/cron.log'; my @log = io($file)->slurp; return $self->tt_process( { data => \@log }); } #------------------------------------------------------------------------------- sub data_file : Runmode { my $self = shift; $self->_debug_path($self->get_current_runmode); my $errs = shift; return $self->forbidden() unless $self->user_can('do_admin'); return $self->tt_process('resources/new_data_file.tt', { error => $errs }); } #------------------------------------------------------------------------------- sub active_sessions : Runmode { my $self = shift; $self->_debug_path($self->get_current_runmode); # args = classname, optional hashref of args, optional with_objects: my @args = ('Session', { sort_by => 'time desc' }, 'user.user_location'); my $all_sessions = $self->model('Base')->get_objects(@args); my $settings = $self->cfg('settings'); my $timeouts = $self->get_yaml_file('idle_timeout'); # warn Dumper $timeouts; my @active_sessions = (); my @cgi_sess_cfg = ( 'driver:MySQL;serializer:'.$settings->{db_session_serializer}, undef, # placeholder for session id, { Handle => $self->dbh }, 1, # THIS IS EXPERIMENTAL: pass a true value as the fourth parameter if # you want to skip the changing of access time. This isn't documented # more formally, because it only called by find() [works OK in v4.43] ); SESSION: for my $session (@$all_sessions) { next unless $session->userid; # skip failed logins & not logged in yet $cgi_sess_cfg[1] = $session->id; # set session id my $sess = CGI::Session->load(@cgi_sess_cfg); # load() doesn't force new # warn Dumper [ $sess->atime, $sess->ctime, $sess->expire, time() ]; my $user_location = $session->user->user_location->location_name; my $timeout # if user location in idle_timeout.yml, or default: = $timeouts->{$user_location} || $settings->{default_user_timeout}; # push @active_sessions, $session # unless $sess->is_expired; # no, this is CGI::Session timeout (24hrs)! if ( my $atime = $sess->atime ) { # to prevent unititialized val in subtraction err my $session_is_expired = ( time() - $atime > $timeout ); # warn Dumper [ time() - $sess->atime, $timeout ]; next SESSION if $session_is_expired; # warn Dumper $session->as_tree; my %data = ( addr => $sess->remote_addr, user => $session->user, time => $session->time, ); # warn Dumper \%data; push @active_sessions, \%data; } } $self->tt_params( sessions => \@active_sessions); { # callback for template to calculate duration: my $duration = sub { LIMS::Local::Utils::time_now->delta_ms(@_); }; $self->tt_params( calculate_duration => $duration ); } return $self->tt_process; } #------------------------------------------------------------------------------- sub get_data_file : Runmode { my $self = shift; $self->_debug_path($self->get_current_runmode); return $self->forbidden() unless $self->user_can('do_admin'); my $method = $self->query->param('method'); # warn $method; if ($method eq 'url') { return $self->data_file_from_url; # Role::DataFile } elsif ($method eq 'upload') { return $self->data_file_from_upload; # Role::DataFile } else { return $self->forward('data_file'); } } #------------------------------------------------------------------------------- sub user_messages : Runmode { my $self = shift; $self->_debug_path($self->get_current_runmode); if ( my $recipient_id = $self->param('id') ) { # if passed from 'hello' page my $user = $self->model('User')->get_user_profile($recipient_id); $self->tt_params( recipient => $user ); } else { my $profile = $self->user_profile; { # get any user-to-user messages: my $messages = $self->get_user_messages($profile->{id}); $self->tt_params( user_messages => $messages ); } { # get any admin-to-user messages: my $user_location = $profile->{user_location}->{location_name}; my $messages = $self->get_admin_messages($user_location); $self->tt_params( admin_messages => $messages ); } { # get list of users: my @sort_order = qw(user_location.location_name last_name first_name); my $args = { sort_by => \@sort_order }; # override default my $users = $self->model('User')->get_all_users($args); $self->tt_params( users => $users ); } } return $self->tt_process; } #------------------------------------------------------------------------------- sub new_message : Runmode { my $self = shift; $self->_debug_path($self->get_current_runmode); my $vars = $self->query->Vars(); return $self->forward('user_messages') if grep { ! $vars->{$_}} qw(user_id message); # dfv overkill for 2 vars ?? my $rtn = $self->model('User')->new_user_message($vars); if ($rtn) { return $self->error($rtn); } else { $self->flash( info => $self->messages('user')->{msg_sent}); return $self->redirect( $self->query->url . '/resources/user_messages' ); } } #------------------------------------------------------------------------------- sub new_diagnoses : Runmode { my $self = shift; $self->_debug_path($self->get_current_runmode); my $org_code = $self->query->param('org_code'); # optional my $data = $self->new_and_relapsed_diagnoses($org_code); $self->tt_params( locations => $data->{locations_map}, results => $data->{results}, ); # do we need to restrict to user location (for template only, not model): unless ( $self->is_lab_staff ) { # only lab staff can view all locations my $profile = $self->user_profile; my $region_code = $profile->{user_location}->{region_code}; $self->tt_params( restricted_location => $region_code ); } return $self->tt_process(); } # ------------------------------------------------------------------------------ sub system_resources : Runmode { my $self = shift; $self->_debug_path($self->get_current_runmode); # callback for CPU load: $self->tt_params( cpu => \&_cpu_data ); return $self->tt_process(); } sub _cpu_data { # from webmin/proc/linux-lib.pl os_get_cpu_info() open my $src, '<' . '/proc/loadavg' || return 0; my @load = split /\s+/, <$src>; return @load[0..2]; } 1;