package LIMS::Controller::Resources;
use Moose;
BEGIN { extends 'LIMS::Base'; }
with (
'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;
#-------------------------------------------------------------------------------
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);
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 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, with_objects, optional hashref of args:
my @args = ('Session', 'user.user_location', { sort_by => 'time desc' });
my $all_sessions = $self->model('Base')->get_objects_with(@args);
my $settings = $self->cfg('settings');
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]
);
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 = $user_location eq $settings->{lab_name_abbreviation}
? $settings->{internal_user_timeout} # ie lab user
: $settings->{external_user_timeout}; # ie external/guest user
# push @active_sessions, $session
# unless $sess->is_expired; # no, this is CGI::Session timeout (24hrs)!
my $session_is_expired = ( time() - $sess->atime > $timeout );
# warn Dumper [ time() - $sess->atime, $timeout ];
push @active_sessions, $session unless $session_is_expired;
}
$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->authen->store->fetch('yooza_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->authen->store->fetch('yooza_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;