package LIMS::Controller::Storage;
=begin # FluidX XTR-96 plate reader:
requires xtr_96_addr ip:port in settings file to provide access
System settings:
Winsock: Add <CRLF> = OFF; Enable Winsock = ON; Port = 2001
Barcode: Integral reader (ensure Matrix ID auto orientate off)
Results settings:
Header information: Single Field; Label: Rack Identifier (checked)
Results Format: Tube IDs and TubeRack Coords
Spacing of results: commas only
Separation of records: same line
Grouping of records: by Column
Results capture: Require RackID with tube readings
=cut
use LIMS::ControllerClass; # inherits LIMS::Base and provides LIMS::Local::Debug::p
with (
'LIMS::Controller::Roles::Storage', # get_auto_location
'LIMS::Controller::Roles::FormData', # validate_form_params
'LIMS::Controller::Roles::RecordHandler',
);
__PACKAGE__->meta->make_immutable(inline_constructor => 0);
use Net::Telnet;
use Data::Dumper;
use LIMS::Local::Utils;
use XML::Simple qw(:strict);
# ------------------------------------------------------------------------------
# default() should never be called direct - redirect to start page:
sub default : StartRunmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
return $self->redirect( $self->query->url );
}
# ------------------------------------------------------------------------------
sub load : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
my $errs = shift; $self->stash( errs => $errs );
return $self->forbidden()
unless $self->user_can( [ 'view_storage', 'modify_results' ] );
my $request_id = $self->param('id')
|| return $self->error('no id passed to ' . $self->get_current_runmode);
# get request data:
my $request_data = $self->model('Request')->get_single_request($request_id);
# get existing storage data:
my $storage = $self->model('Storage')->get_request_storage($request_id);
# vials in storage NOT signed out:
my @available = map $_->vialId, grep ! $_->signed_out, @$storage;
# get specimen map for request:
my $specimen_map = $self->specimen_map([ $request_id ]); # warn Dumper $specimen_map;
my %tt_params = (
specimen_map => $specimen_map,
request => $request_data,
available => \@available,
storage => $storage,
);
{ # menu options:
my $opts = $self->_get_menu_options();
$tt_params{menu_options} = $opts;
}
# yaml config to allow new tests to be requested (eg xNA extraction):
if ( my $yml = $self->get_yaml_file('storage') ) { # p $yml;
# only allowed 1 lab section as method for result_update expects section id:
my ($section) = keys %$yml; # p $section;
my $o = $self->model('LabTest')->get_lab_tests; # warn Dumper $_ for @$o;
{ # lab tests:
my %h = map +($_->field_label => $_->id),
grep $_->lab_section->section_name eq $section, @$o; # p %h;
# take hash slice:
my $lab_tests = $yml->{$section}; # p $lab_tests;
my %tests = map +($_ => $h{$_}), @$lab_tests; # p %tests;
$tt_params{lab_tests} = \%tests;
}
{ # lab section details:
my %h =
map +($_->lab_section->section_name => $_->lab_section_id), @$o;
my %lab_section = ( name => $section, id => $h{$section} ); # p %lab_section;
$tt_params{lab_section} = \%lab_section;
}
{ # request-lab-test data for $section:
my %h = ( section_name => $section, request_id => $request_id );
my $o = $self->model('LabTest')
->get_request_lab_tests_for_section(\%h);
my %map = map +(
$_->lab_test->field_label => $_->status->description
), @$o; # p %map;
$tt_params{request_lab_tests} = \%map; # p $request_lab_test;
}
{ # record status (RecordHandler::is_record_complete):
my $is_locked = $self->is_record_complete($request_data); # p $is_locked;
$tt_params{is_locked} = $is_locked; # will be undef if status != complete
}
}
$self->tt_params(%tt_params);
return $self->render_view($self->tt_template_name, $errs);
}
# ------------------------------------------------------------------------------
sub input : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
my $errs = shift;
return $self->forbidden()
unless $self->user_can( 'modify_results' );
my $request_id = $self->param('id')
|| return $self->error('no id passed to ' . $self->get_current_runmode);
my $dfv = $self->check_rm('load', $self->validate('storage_input') )
|| return $self->dfv_error_page;
my $params = $dfv->valid;
$params->{request_id} = $request_id; # p $params;
my $rtn = $self->model('Storage')->input_storage($params);
return $self->error( $rtn ) if $rtn;
# insert flash message
$self->flash( info => $self->messages('action')->{create_success} );
return $self->redirect( $self->query->url . '/storage/=/' . $request_id );
}
# ------------------------------------------------------------------------------
sub output : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
my $errs = shift;
return $self->forbidden()
unless $self->user_can( 'modify_results' );
my $request_id = $self->param('id')
|| return $self->error('no id passed to ' . $self->get_current_runmode);
my $dfv = $self->check_rm('load', $self->validate('storage_output') )
|| return $self->dfv_error_page;
my $params = $dfv->valid; # warn Dumper $params;
$params->{request_id} = $request_id;
my $rtn = $self->model('Storage')->output_storage($params); # 'OK' or href error
if (ref $rtn eq 'HASH') { # will be error
return $self->forward('load', $rtn);
}
# insert flash message:
$self->flash( info => $self->messages('action')->{edit_success} );
return $self->redirect( $self->query->url . '/storage/=/' . $request_id );
}
# ------------------------------------------------------------------------------
sub edit : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
my $errs = shift; $self->stash( errs => $errs );
return $self->forbidden()
unless $self->user_can( 'modify_results' );
my $vial_id = $self->param('id')
|| return $self->error('no id passed to ' . $self->get_current_runmode);
my $request_id = $self->param('Id')
|| return $self->error('no Id passed to ' . $self->get_current_runmode);
my $request = $self->model('Request')->get_single_request($request_id);
$self->tt_params( request => $request );
{ # menu options:
my $opts = $self->_get_menu_options();
$self->tt_params( menu_options => $opts );
}
my $data = $self->model('Storage')->get_storage_vial($vial_id);
$self->tt_params( data => $data );
return $self->tt_process($errs);
}
# ------------------------------------------------------------------------------
sub delete : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
return $self->forbidden()
unless $self->user_can( 'modify_results' );
my $vial_id = $self->param('id')
|| return $self->error('no vialId passed to ' . $self->get_current_runmode);
my $request_id = $self->param('Id')
|| return $self->error('no request_id passed to ' . $self->get_current_runmode);
my $vial = $self->model('Storage')->get_storage_vial($vial_id);
$self->tt_params( vial => $vial );
if ( my $vialId = $self->query->param('vialId') ) { # confirmation vial id form param
$self->query->param(vial_id => $vial_id); # add $self->param('id') to query for DFV
my $messages = $self->messages('storage');
my $profile = $self->validate('storage_delete');
# validate form entry - can't use check_rm as return page is same rm so get infinate loop
my $dfv = $self->validate_form_params($profile); # warn Dumper $dfv;
# need confirmation to delete record (scanned vialId matches id of vial selected):
if ($dfv->has_missing || $dfv->has_invalid) {
return $self->tt_process({ dfv_errs => $dfv->msgs });
}
my $data = $dfv->valid; # warn Dumper $data;
my $rtn = $self->model('Storage')->delete_storage_vial($data);
return $self->error($rtn) if $rtn;
# set flash success & redirect:
$self->flash( info => $messages->{delete_success} );
$self->redirect( $self->query->url . '/storage/=/' . $request_id );
}
# just load data for confirmation:
return $self->tt_process();
}
# ------------------------------------------------------------------------------
sub update_storage_vial : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
my $errs = shift;
return $self->forbidden()
unless $self->user_can( 'modify_results' );
# capture param 'Id' - 'id' = vialId in case validation failure -> edit()
my $request_id = $self->param('Id')
|| return $self->error('no request_id passed to ' . $self->get_current_runmode);
my $dfv = $self->check_rm('edit', $self->validate('storage_update') )
|| return $self->dfv_error_page; # warn Dumper $dfv;
my $params = $dfv->valid; # p $params;
$params->{request_id} = $request_id;
my $rtn = $self->model('Storage')->update_storage_vial($params);
return $self->error( $rtn ) if $rtn;
# insert flash message
$self->flash( info => $self->messages('action')->{edit_success} );
return $self->redirect( $self->query->url . '/storage/=/' . $request_id );
}
# ------------------------------------------------------------------------------
sub read_xtr_96 : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
return $self->forbidden()
unless $self->user_can( 'modify_results' );
#-------------------------------------------------------------
# to test, telnet <ip_address> <port> then issue 'get' command
#-------------------------------------------------------------
my $cfg = $self->cfg('settings'); # p $cfg->{xtr_96_addr};
# connection info, or return:
my ($host, $port) = split ':', $cfg->{xtr_96_addr}; # p [$host, $port];
return $self->error('require host & port') unless ($host && $port);
# request to commence plate scan:
if ( $self->query->param('scan') ) {
my $rtn_url = $self->query->url . '/storage/read_xtr_96';
my $msgs = $self->messages('storage');
# get data or return (any failure will be in flash msg):
my $xtr_96 = $self->_get_xtr_96_data($host, $port) # hashref of plate_data & plateId
|| return $self->redirect( $rtn_url ); # warn Dumper $xtr_96;
{ # get storage_rack & request_storage db table data (if exists):
my $plate_data = $xtr_96->{plate_data}; # p($plate_data);
my $plateId = $xtr_96->{plateId};
unless ($plate_data) {
$self->flash(error => $msgs->{no_plate_data});
return $self->redirect( $rtn_url );
}
unless ($plateId) {
$self->flash(error => $msgs->{no_plate_id});
return $self->redirect( $rtn_url );
}
my $storage_rack = $self->model('Storage')->get_storage_rack($plateId); # hashref
my @locations = keys %{ $plate_data }; # p(@locations); p($storage_rack);
my @vial_ids = grep $_ !~ /NO (TUBE|READ)/, values %{$plate_data}; # p(@vial_ids);
# need map of vialId => location:
my %location_map; @location_map{@vial_ids} = @locations; # p %location_map;
my %args = $storage_rack # if exists, use rack id, otherwise vial_id's:
? ( rack_id => $storage_rack->{id} ) # get all vials from rack
: ( vial_ids => \@vial_ids ); # get all vials matching input
my $o = $self->model('Storage')->get_rack_contents(\%args);
# need hash of vialId's from request_storage where signed_out is null:
my %rack_data = map { $_->vialId => $location_map{$_->vialId} }
grep { ! $_->signed_out } @$o; # p(%rack_data);
# do we have any vials in rack which do NOT exist in storage:
my $have_missing = grep { ! $rack_data{$_} }
grep $_ ne 'No Tube', @vial_ids; # eg unrecognised vial, or 'No Read'
my $have_empty = grep $_ eq 'No Tube', @vial_ids; # just highlight on view
# storage locations (for auto-calculation of next rack/tray):
if ( my $yml = $self->get_yaml_file('storage_locations') ) { # p $yml;
$self->tt_params( storage_locations => $yml );
# get js validation foo_onsubmit & foo_dfv_js vars into tt_params:
$self->js_validation_profile('storage_rack');
}
my %h = (
storage_rack => $storage_rack,
have_missing => $have_missing,
have_empty => $have_empty,
rack_data => \%rack_data,
); # p %h;
$xtr_96->{storage} = \%h;
}
$self->tt_params( data => $xtr_96 );
# store in session for retrieval after 'import':
$self->session->param( _xtr_96_data => $xtr_96 );
}
else { # ensure only PC attached to xtr_96 can activate scan:
my ($ip, $port) = split ':', $self->cfg('settings')->{xtr_96_addr};
my $ok = ( $ENV{REMOTE_ADDR} eq $ip ) # test & devel server OK:
|| $self->user_can('do_admin')
|| grep $ENV{$_}, qw(DEVEL_SERVER HARNESS_ACTIVE); # warn $ok;
$self->tt_params(
remote_addr => $ENV{REMOTE_ADDR},
xtr_96_addr => $ip,
can_scan => $ok,
);
}
return $self->tt_process();
}
# ------------------------------------------------------------------------------
# remove storage_location from storage_racks for plateId:
sub remove_storage_plate : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
return $self->forbidden()
unless $self->user_can( 'modify_results' );
my $vars = $self->query->Vars(); # warn Dumper $vars;
if ( my $plateId = $vars->{plateId} ) {
# get storage location:
my $location = $self->model('Storage')->get_storage_rack($plateId);
$self->tt_params( data => $location );
if ( $vars->{confirm_removal} ) {
# set storage_location undef, returns true on success:
my $ok = $self->model('Storage')->remove_storage_location($plateId);
my @msg = $ok
? ( info => "plate $plateId removed successfully" )
: ( error => "plate $plateId NOT removed" ); # not very helpful !!
$self->flash(@msg);
my $url = $self->query->url . '/storage/remove_storage_plate';
return $self->redirect($url);
}
}
return $self->tt_process();
}
# ------------------------------------------------------------------------------
sub import_xtr_96_data : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
return $self->forbidden()
unless $self->user_can( 'modify_results' );
my $xtr_96_data = $self->session->dataref->{_xtr_96_data}
|| return $self->error( 'no xtr-96 data retrieved from session' ); # warn Dumper $xtr_96_data;
# get storage_rack data (if exists):
my $storage_data = $xtr_96_data->{storage}; # p $storage_data;
# check no missing data (shouldn't happen - should not have been able to submit):
if ( $storage_data->{have_missing} ) {
my $url = $self->query->url . '/storage/read_xtr_96?scan=1';
return $self->redirect( $url );
}
my ($result, $plate_id);
my $vars = $self->query->Vars(); # warn Dumper $vars;
# void plate - remove vial_location & plateId from vials:
if ( $vars->{void_plate} ) {
my $plateId = $vars->{_plateId}; # distinct from $plate_id
unless ( $vars->{confirm_void_plate} ) { # need confirmation
return $self->tt_process('storage/void_plate.tt');
}
my $rtn = $self->model('Storage')->void_plate($plateId);
if ($rtn) { # error
return $self->error($rtn);
}
else {
my $msg = $self->messages('storage')->{void_success}; # sprintf:
$self->flash( info => sprintf $msg, $plateId );
return $self->redirect( $self->query->url . '/storage/read_xtr_96');
}
}
elsif ( $vars->{import} ) { # new import:
$plate_id = $xtr_96_data->{plateId} # eg SA00098711
|| return $self->error( 'no plate id retrieved from session' ); # p($plate_id);
# insert new entry in storage_racks, returns storage_racks.id:
my $rack_id = do {
my %args = ( plateId => $plate_id );
if ( my $base_location = $vars->{storage_location} ) {
my $location = $self->get_auto_location($base_location); # warn $location;
# add storage_location to lexical $xtr_96_data for later access:
$args{storage_location}
= $xtr_96_data->{storage_location}
= $location;
} # p %args;
$self->model('Storage')->new_storage_rack(%args);
};
# $rack_data: href vialId => location
my $rack_data = $storage_data->{rack_data}; # p $rack_data;
my %h = ( rack_id => $rack_id, plate => $rack_data ); # p %h;
$result = $self->model('Storage')->update_storage_rack(\%h); # p $result;
$self->tt_params( action => 'scanned in' );
}
# if export data, sign out all vials:
elsif ( $vars->{export} ) { # warn Dumper $rack;
my $rack = $storage_data->{storage_rack}; # warn Dumper $rack;
$plate_id = $rack->{plateId};
return $self->error( "plateId $plate_id is not active" )
unless $rack->{is_active} eq 'yes'; # should never happen
my $rack_data = $storage_data->{rack_data};
my @vial_ids = keys %{ $rack_data }; # warn Dumper \@vial_ids;
# sign out all vials in rack:
my %h = (
vial_id => \@vial_ids,
rack_id => $rack->{id},
);
$result = $self->model('Storage')->sign_out_storage_rack(\%h); # p($result);
$self->tt_params( action => 'signed out' );
}
else { # just set $result to msg for return below:
$result = 'unknown action (not one of: import, export or void plate)';
}
# $result should be hashref, or err str:
return $self->error($result) unless ref $result eq 'HASH';
{ # get request data from $result:
my @request_ids = keys %{ $result->{requests} }; # requests = href of req.ids
my $data = $self->model('Request')->get_requests(\@request_ids); # arrayref
# replace $result->{requests}{request_id} index count with request table row:
$result->{requests}->{$_->id} = $_->as_tree for @$data;
}
# add plate ID:
$result->{plateId} = $plate_id;
# add original scanned plate data from session:
$result->{scan_data} = $xtr_96_data->{plate_data};
# add storage location (if supplied):
$result->{storage_location} = $xtr_96_data->{storage_location};
return $self->tt_process({ data => $result });
}
# ------------------------------------------------------------------------------
# sends commands to scanner via telnet session - see scripts/fluidx_read.pl
# for testing interface
sub _get_xtr_96_data {
my $self = shift; $self->_debug_path();
my ($host, $port) = @_;
my $plate_type = $self->query->param('type'); # radio input so must exist
# uncomment to use test data (using method in C::Roles::Storage):
# return $self->_dummy_data($plate_type) if $ENV{SERVER_PORT} == 8000;
return $self->_test_data() if $self->cfg('settings')->{test_harness};
my @args = (
Errmode => 'return', # don't die (default)
# Timeout => 15, done in waitfor() now otherwise processes delay until $secs
# Input_Log => './xtr-96.log', # uncomment to debug (not under fastcgi, permissions error)
);
my $t = Net::Telnet->new(@args);
my @host = ( Host => $host, Port => $port );
unless ( $t->open(@host) ) { # returns 1 on success, 0 on failure:
$self->flash( error => $t->errmsg ); # failure msg in errmsg()
return 0;
} $self->debug('opened ftp connection');
=begin # xtr-96 text string method:
# initiate plate read:
$t->cmd('get');
# TODO: amend this to work with D06 & F08:
my $re = qr{H12,(.*)$}; # end of output = H12,<result>
my ($prematch, $match) = $t->waitfor(Match => "/$re/", Timeout => undef); # no timeout
=cut
# initiate plate read by intellicode, output as xml:
my $intellicode_prefix = 'Intellicode.Instrument.Profile';
my $profile = "fluidx $plate_type.xtprof";
$t->cmd(
String => "$intellicode_prefix.load($profile)",
Timeout => 0, # don't wait for Timeout period
);
$t->waitfor(String => 'success:load');
$self->debug("$profile loaded, initiating scan");
$t->cmd(
String => "$intellicode_prefix.scan",
# may need slight delay (2 - 5 secs) for "NO TUBE"s; needs transition
# & area adjustments in profile (see "No Tube/No Read Configuration"
# section in Intellicode manual)
Timeout => 0,
);
$t->waitfor(String => 'success:scan'); $self->debug('completed scan');
# get results:
$t->cmd(
String => "$intellicode_prefix.Exporter.getResults(xml_exporter)",
Timeout => 0, # don't wait for Timeout period
); # my $ref = $t->buffer; p $ref; # captures all output
my ($prematch, $match) = $t->waitfor(String => 'success:getResults');
$self->debug('returned results');
# end of intellicode plate read section
$self->flash( error => $t->errmsg ) if $t->errmsg;
$t->close;
return 0 unless $prematch && $match; # assume error captured in $t->errmsg
#=begin extract data from intellicode output:
# need to use 'm' & 's' to handle multi-line data feed:
my ($xml) = $prematch =~ /msg:(.*)/ms; # p $xml;
my $plate = extract_xml($xml); # p $plate;
#=cut
#=begin extract data from xtr-96 output:
# my $data = $prematch . $match; # p $data;
# my ($header, $body) = split "\n", $data; # p [$header, $body];
#
# my ($plateId) = $header =~ /Rack Identifier = ([A-Z0-9]+)/;
#
# $plate = { plateId => $plateId };
# {
# no warnings 'uninitialized'; # happens if process timeout waiting for reader
# # my %plate_data = ( $str =~ /^([A-H][0-9]{2})\,\s?(.+?)$/mg ); # if $str is list format
# my %plate_data = split /,\s?/, $body; # p %plate_data;
# $plate->{plate_data} = \%plate_data;
# }
# my $plate_type = scalar keys %{ $plate->{plate_data} }; # for $dimensions_map
# my $dimensions_map = _rack_dimensions_map(); # dimensions A1-D6, A1-H8, etc
# my ($number_of_wells) = $plate->{name} =~ /(\d+) Tube/; # warn $number_of_wells;
# $plate->{well_max} = $dimensions_map->{$number_of_wells};
#=cut
{ # calculate max well position (D6, F8 or H12) for tt to draw table of correct size:
my @wells = keys %{ $plate->{plate_data} }; # p @wells;
# sort naturally (A1, A2 .. A10, etc):
my @nsorted = LIMS::Local::Utils::n_sort(\@wells); # p @nsorted;
# get alphanumerical values (A-Z & nn) of max well position:
my @alphanum_max = $nsorted[-1] =~ /([a-z])(\d+)/i;
@{ $plate->{well_max} }{ qw/alpha_max numbr_max/ } = @alphanum_max;
} # warn Dumper $plate;
return $plate;
}
sub extract_xml { # modified intellicode xml output
my $xml = shift;
my $ref = XMLin($xml, ForceArray => 0, KeyAttr => []); # p $ref;
my $well_data = $ref->{well};
my ($plate_id) = map $ref->{$_}, # linear or 2-d barcode reading:
grep { $ref->{$_} =~ /\w+?\d+/ } qw/idlbc id2d/;
my %h = ( plateId => $plate_id ); # plate_type => $ref->{name}; # not required
for (@$well_data) { # p $_; next;
my $well_id = $_->{id};
$h{plate_data}{$well_id} = $_->{value};
} # p %h;
return \%h;
}
sub _get_menu_options {
my $self = shift;
my $yaml = $self->get_yaml_file('menu_options'); # p $yaml;
my $opts = $yaml->{storage_options};
return $opts;
}
1;
