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->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;