package LIMS::Controller::Storage;
use Moose;
use Net::Telnet;
# if using 'extends', need to run at compile time to load attribute handlers
# from parent class otherwise StartRunmode, Runmode, etc fails - hack around AutoRunmode
BEGIN { extends 'LIMS::Base'; }
with (
'LIMS::Controller::Roles::RecordHandler',
);
__PACKAGE__->meta->make_immutable(inline_constructor => 0);
use Data::Dumper;
# ------------------------------------------------------------------------------
# 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;
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);
# get list of existing samples in storage
my %specimens = map { $_->specimen->sample_code => 1 } @$storage;
# get specimen map for request:
my $specimen_map = $self->specimen_map([ $request_id ]); # warn Dumper $specimen_map;
$self->tt_params(
request_data => $request_data,
specimen_map => $specimen_map,
specimens => \%specimens,
storage => $storage,
);
return $self->render_view($self->tt_template_name);
}
# ------------------------------------------------------------------------------
sub input : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
my $errs = shift;
my $request_id = $self->param('id')
|| return $self->error('no id passed to ' . $self->get_current_runmode);
my $params = $self->query->Vars; warn Dumper $params;
$params->{request_id} = $request_id;
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;
my $request_id = $self->param('id')
|| return $self->error('no id passed to ' . $self->get_current_runmode);
my %params = $self->query->Vars; warn Dumper \%params;
# insert flash message
return $self->redirect( $self->query->url . '/storage/=/' . $request_id );
}
# ------------------------------------------------------------------------------
sub read_xtr_96 : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
my $cfg = $self->cfg('settings'); # warn Dumper $cfg->{xtr_96_addr};
# connection info, or return:
my ($host, $port) = split ':', $cfg->{xtr_96_addr}; # warn Dumper [$host, $port];
return $self->error('require host & port') unless ($host && $port);
# request to commence plate scan:
if ( $self->query->param('scan') ) {
# get data or return (any failure in flash msg):
my $str = $self->_get_xtr_96_data($host, $port)
|| return $self->redirect( $self->query->url . '/storage/read_xtr_96' );
# extract plateId & vial location / vial ID details from xtr-96 output:
my %plate_data = ( $str =~ /^([A-H][0-9]{2})\,\s?(.+?)$/mg );
my ($plateId) = $str =~ /Rack Identifier = ([A-Z0-9]+)/;
my %h = (
plate_data => \%plate_data,
plateId => $plateId,
);
{ # get storage_rack & request_storage db table data (if exists):
my @vial_ids = values %plate_data;
my $storage_rack = $self->model('Storage')->get_storage_rack($plateId); # hashref
my %args = $storage_rack
? ( 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 => 1 } grep { ! $_->signed_out } @$o;
# do we have any vials in rack which do NOT exist in storage:
my $have_missing = grep { ! $rack_data{$_} } @vial_ids;
my %storage = (
storage_rack => $storage_rack,
have_missing => $have_missing,
rack_data => \%rack_data,
);
$h{storage} = \%storage;
}
$self->tt_params( data => \%h );
# store in session for retrieval after 'import':
$self->session->param( _xtr_96_data => \%h );
}
return $self->tt_process();
}
# ------------------------------------------------------------------------------
sub import_xtr_96_data : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
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_rack = $xtr_96_data->{storage}; warn $storage_rack;
return $self->dump_html; # move to own sub - get request info from vial posn
}
# ------------------------------------------------------------------------------
sub _get_xtr_96_data {
my $self = shift; $self->_debug_path();
my ($host, $port) = @_;
return _dummy_data(); # uncomment to use test data
my @args = (
Timeout => 15,
Errmode => 'return', # don't die (default)
# Input_Log => './xtr-96.log', # uncomment to debug
);
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;
}
$t->cmd('get'); # return val is undef (shouldn't be)
my $ref = $t->buffer; # warn Dumper [$ref, $t->errmsg];
$t->close;
# defererence:
return ${$ref};
}
1;
#===============================================================================
sub _dummy_data { # dummy data to spare plate reader ...
my $plateId = 'SA00098711';
my %data = (
'D04' => 'FC12803113',
'H06' => 'FC12803280',
'F06' => 'FC12803202',
'F04' => 'FC12801012',
'B01' => 'FC12800770',
'C11' => 'FC12803515',
'E06' => 'FC12800872',
'G03' => 'FC12803499',
'F07' => 'FC12803399',
'F01' => 'FC12803170',
'B03' => 'FC12803391',
'B02' => 'FC12800850',
'B07' => 'FC12800740',
'D05' => 'FC12801010',
'F05' => 'FC12803423',
'A02' => 'FC12803415',
'D02' => 'FC12801029',
'B05' => 'FC12801091',
'G04' => 'FC12800842',
'G01' => 'FC12800965',
'H02' => 'FC12803407',
'D03' => 'FC12803487',
'B06' => 'FC12803151',
'C06' => 'FC12803135',
'H03' => 'FC12800929',
'D01' => 'FC12803208',
'C01' => 'FC12800680',
'B10' => 'FC12803459',
'F09' => 'FC12803372',
'H04' => 'FC12801106',
'G11' => 'FC12803243',
'C12' => 'FC12800934',
'A05' => 'FC12803203',
'E08' => 'FC12800953',
'C03' => 'FC12803288',
'C05' => 'FC12803099',
'A09' => 'FC12800671',
'C07' => 'FC12803405',
'F08' => 'FC12803511',
'B11' => 'FC12800993',
'H12' => 'FC12800871',
'A01' => 'FC12800704',
'D11' => 'FC12801040',
'A10' => 'FC12801037',
'D10' => 'FC12803246',
'H09' => 'FC12803219',
'A06' => 'FC12801061',
'D09' => 'FC12803385',
'H05' => 'FC12800678',
'A11' => 'FC12803392',
'H11' => 'FC12800771',
'E07' => 'FC12803480',
'B08' => 'FC12803131',
'D08' => 'FC12803072',
'E11' => 'FC12803140',
'G02' => 'FC12800958',
'H01' => 'FC12800972',
'A04' => 'FC12800686',
'A07' => 'FC12800705',
'A08' => 'FC12803350',
'C10' => 'FC12800648',
'G06' => 'FC12801079',
'C09' => 'FC12801027',
'F03' => 'FC12800737',
'F10' => 'FC12803476',
'G09' => 'FC12800873',
'F02' => 'FC12803365',
'E03' => 'FC12801120',
'B04' => 'FC12803458',
'E12' => 'FC12800948',
'G08' => 'FC12803293',
'H08' => 'FC12803401',
'C04' => 'FC12800955',
'H07' => 'FC12803196',
'E01' => 'No Tube',
'G05' => 'FC12803207',
'E05' => 'FC12800774',
'B09' => 'FC12800987',
'C02' => 'FC12803386',
'D06' => 'FC12800753',
'D07' => 'FC12800724',
'E04' => 'FC12800857',
'E02' => 'FC12803185',
'E10' => 'FC12800805',
'H10' => 'FC12801055',
'G12' => 'FC12803439',
'B12' => 'FC12800957',
'E09' => 'FC12803403',
'A03' => 'FC12803358',
'D12' => 'FC12803394',
'F11' => 'FC12803502',
'F12' => 'No Read',
'A12' => 'FC12800868',
'G07' => 'FC12800693',
'G10' => 'FC12800964',
'C08' => 'FC12800777',
); # warn Dumper \%data;
# return in same format as xtr-96 output:
return sprintf "Rack Identifier = %s\n%s", $plateId,
join "\n", map { join ', ', $_, $data{$_} } keys %data;
}
