package LIMS::Model::Storage; use Moose; extends 'LIMS::Model::Base'; use namespace::clean -except => 'meta'; __PACKAGE__->meta->make_immutable; use Data::Dumper; use LIMS::Local::Utils; #------------------------------------------------------------------------------- sub input_storage { my ($self, $data) = @_; # warn Dumper $data; { # add specimen.id: my $o = LIMS::DB::Specimen::Manager->get_specimens(); my %map = map { $_->sample_code => $_->id } @$o; my $specimen = $data->{specimen}; $data->{specimen_id} = $map{$specimen}; } # warn Dumper $data; my $vialID = $data->{vialId}; # 10 chars, or multiples of (input validated) =begin # using partnum now, validation disallowing >10 chars: my @vials; # array for possible multiple vials if ( length $vialID > 10 ) { # have multiple vials my (@ids) = $vialID =~ /([A-Z]{2}\d{8}|\d{10})/g; # warn Dumper \@ids; for my $vial_id(@ids) { # warn $vial_id; my $c = LIMS::Local::Utils::clone($data); $c->{vialId} = $vial_id; # warn Dumper $c; push @vials, $c; } } else { push @vials, $data; } # warn Dumper \@vials; =cut my $update = sub { my %h = ( class => 'RequestStorage', data => $data ); my $rtn = $self->update_object(\%h); # only returns true on error die $rtn if $rtn; { # RequestLabTestHistory: my @args = ( request_id => $data->{request_id}, user_id => $self->user_profile->{id}, action => 'scanned in vialId ' . $data->{vialId}, ); LIMS::DB::RequestLabTestHistory->new(@args)->save; } }; my $db = $self->lims_db; return $db->do_transaction($update) ? undef : 'input_storage() error - ' . $db->error; } #------------------------------------------------------------------------------- sub output_storage { my ($self, $data) = @_; # warn Dumper $data; my $request_id = $data->{request_id}; my $vial_id = $data->{vialId}; my $o = LIMS::DB::RequestStorage->new(vialId => $vial_id)->load_speculative || return { error => "vialId $vial_id does not exist" }; # first check vialId belongs to request_id: unless ( $o->request_id eq $request_id ) { return { error => "vialId $vial_id does not belong to this request" } } $o->signed_out(LIMS::Local::Utils::time_now); my $update = sub { $o->save(changes_only => 1); { # RequestLabTestHistory: my @args = ( request_id => $request_id, user_id => $self->user_profile->{id}, action => 'scanned out vialId ' . $vial_id, ); LIMS::DB::RequestLabTestHistory->new(@args)->save; } }; my $db = $self->lims_db; return $db->do_transaction($update) # expects 'OK', or hashref error: ? 'OK' : { error => 'output_storage() error - ' . $db->error }; } #------------------------------------------------------------------------------- sub void_plate { my ($self, $plateId) = @_; # warn Dumper $plateId; my $rack = LIMS::DB::StorageRack->new(plateId => $plateId)->load; my $rack_id = $rack->id or die 'cannot find a plate with ID ' . $plateId; # warn $rack_id; my $db = $self->lims_db; # ie LIMS::DB->new_or_cached; my $tx = sub { LIMS::DB::RequestStorage::Manager->update_objects( set => { vial_location => undef, rack_id => undef, }, where => [ rack_id => $rack_id ], # where => [ plateId => $plateId ], # require_objects => 'rack', # can't do this ); # delete rack ID for possible re-scan: $rack->delete; # die; }; return $db->do_transaction($tx) ? 0 : 'void_plate() error - ' . $db->error; } #------------------------------------------------------------------------------- sub update_storage_vial { my ($self, $data) = @_; # warn Dumper $data; my $vialId = $data->{vialId}; my $o = LIMS::DB::RequestStorage->new(vialId => $vialId)->load; # warn Dumper $o->as_tree; my @cols = $o->meta->column_names; # warn Dumper \@cols; PARAM: while ( my ($key, $val) = each %$data ) { next PARAM unless grep $key eq $_, @cols; # skip non-table fields (eg specimen) { # skip if not changed no warnings 'uninitialized'; # $o->key, $val or both maybe undef next PARAM if $o->$key eq $val; } $o->$key($val); { # RequestLabTestHistory: my @args = ( request_id => $o->request_id, user_id => $self->user_profile->{id}, action => sprintf 'updated vial %s %s entry', $vialId, $key, ); # warn Dumper \@args; LIMS::DB::RequestLabTestHistory->new(@args)->save; } } my $db = $self->lims_db; # ie LIMS::DB->new_or_cached; my $tx = sub { $o->save(changes_only => 1) }; return $db->do_transaction($tx) ? 0 : 'update_storage_vial() error - ' . $db->error; } #------------------------------------------------------------------------------- sub update_storage_rack { my ($self, $data) = @_; # warn Dumper $data; my $rack_id = $data->{rack_id}; # warn Dumper $rack_id; my $plate = $data->{plate}; # href of vialId => location (A1 - F12) my $db = $self->lims_db; # ie LIMS::DB->new_or_cached; my %data; # keys = success & failed my $update = sub { while ( my($vialId, $location) = each %$plate ) { # warn Dumper [$vialId,$location]; my $o = LIMS::DB::RequestStorage->new(vialId => $vialId)->load; # warn Dumper $o->as_tree; $o->rack_id($rack_id); $o->vial_location($location); my $request_id = $o->request_id; my %h = ( vialId => $vialId, request_id => $request_id ); $o->save(changes_only => 1) ? $data{success}{$location} = \%h : $data{failed}{$location} = \%h; { # RequestLabTestHistory: my @args = ( request_id => $request_id, user_id => $self->user_profile->{id}, action => sprintf 'vialId %s scanned to plate', $vialId, ); LIMS::DB::RequestLabTestHistory->new(@args)->save; } $data{requests}{$request_id}++; # add request_id } # warn Dumper \%data; }; return $db->do_transaction($update) ? \%data # no errors, but maybe some failed to update : 'update_storage_rack() error - ' . $db->error; } #------------------------------------------------------------------------------- sub sign_out_storage_rack { my ($self, $data) = @_; # warn Dumper $data; my $rack_id = $data->{rack_id}; # warn Dumper $rack_id; my $vial_id = $data->{vial_id}; # arrayref of vialIds my $db = $self->lims_db; # ie LIMS::DB->new_or_cached; my $NOW = $self->time_now; my $rs = do { # get all request_storage rows from vial_id array: my @q = ( vialId => $vial_id ); LIMS::DB::RequestStorage::Manager->get_objects( query => \@q ); }; my %data; # keys = success & fail my $update = sub { for my $ref (@$rs) { # warn $id; $ref->signed_out($NOW); my $request_id = $ref->request_id; my $location = $ref->vial_location; my %h = ( vialId => $ref->vialId, request_id => $request_id ); $ref->save(changes_only => 1) ? $data{success}{$location} = \%h : $data{fail}{$location} = \%h; { # RequestLabTestHistory: my @args = ( request_id => $request_id, user_id => $self->user_profile->{id}, action => 'scanned out vialId ' . $ref->vialId, ); LIMS::DB::RequestLabTestHistory->new(@args)->save; } $data{requests}{$request_id}++; # add request_id } # warn Dumper \%data; { # set plate inactive: my $o = LIMS::DB::StorageRack->new(id => $rack_id)->load; $o->is_active('no'); $o->save(changes_only => 1); } }; return $db->do_transaction($update) ? \%data # no errors, but maybe some failed to update : 'sign_out_storage_rack() error - ' . $db->error; } #------------------------------------------------------------------------------- sub get_request_storage { my ($self, $request_id) = @_; my @args = ( query => [ request_id => $request_id ], with_objects => ['specimen', 'rack' ], sort_by => 'created_at', ); my $o = LIMS::DB::RequestStorage::Manager->get_objects(@args); return $o; } #------------------------------------------------------------------------------- sub get_storage_vial { my ($self, $vial_id) = @_; my $o = LIMS::DB::RequestStorage->new(vialId => $vial_id)->load; return $o; } #------------------------------------------------------------------------------- sub delete_storage_vial { my ($self, $data) = @_; my $vial_id = $data->{vial_id}; my $o = LIMS::DB::RequestStorage->new(vialId => $vial_id)->load; # warn Dumper $o->as_tree; # return 'cannot delete vial when rack Id exists' if $o->rack_id; # allowed now, with reason my $db = $self->lims_db; # ie LIMS::DB->new_or_cached; my $delete = sub { if ( my $reason = $data->{reason} ) { # RequestLabTestHistory: my $action = sprintf 'deleted vialId %s [%s]', $vial_id, $reason; my @args = ( request_id => $o->request_id, user_id => $self->user_profile->{id}, action => $action, ); # warn Dumper \@args; LIMS::DB::RequestLabTestHistory->new(@args)->save; } $o->delete; }; return $db->do_transaction($delete) ? 0 : 'delete_storage_vial() error - ' . $db->error; } #------------------------------------------------------------------------------- sub get_storage_rack { my ($self, $plateId) = @_; my $o = LIMS::DB::StorageRack->new( plateId => $plateId )->load_speculative; return $o ? $o->as_tree : 0; # return hashref for use in session } #------------------------------------------------------------------------------- sub new_storage_rack { my ($self, @args) = @_; # sent as hash but OK to accept as array # return id if exists, otherwise create new object first: my $o = LIMS::DB::StorageRack->new(@args)->load_or_insert; return $o->id; } #------------------------------------------------------------------------------- sub get_rack_contents { # find rack contents by rack.id, or list of vialId's: my ($self, $args) = @_; my $query; if ( my $rack_id = $args->{rack_id} ) { $query = [ rack_id => $rack_id ]; } elsif ( my $vial_ids = $args->{vial_ids} ) { $query = [ vialId => $vial_ids ]; } my @args = ( query => $query ); my $o = LIMS::DB::RequestStorage::Manager->get_objects(@args); return $o; } 1;