• Files
• Commits
• Log
• Graph
• Stats

use Modern::Perl;

#===============================================================================
my $db = 'hilis4';
#===============================================================================

# 1) deletes storage vials and adds comment to request_lab_test_history
# 2) just adds comment to request_lab_test_history

use lib '/home/raj/perl-lib';

use Data::Printer alias => 'p', use_prototypes => 0;
use Spreadsheet::WriteExcel::Simple;
use SQL::Abstract::More;
use Local::DB;
use Text::CSV;
use IO::File;
use IO::All;

my $sqla = SQL::Abstract::More->new;
my $dbix = Local::DB->dbix({ dbname => 'hilis4' });
my $tbl  = 'hilis4.request_storage';
my $io 	 = new IO::File;

$dbix->lc_columns = 0; # vialId

my $user_id = $dbix->select('users', 'id', { username => 'raj'})->value; # p $user_id;

#delete_vials();
#insert_comment();

sub delete_vials {
	my $src_file  = './vials_for_deleting.csv';
	open( $io, '<', $src_file ) || die $!;

	my $csv = Text::CSV->new({ binary => 1 }); # ddp $csv; exit;

	my $xl = Spreadsheet::WriteExcel::Simple->new;
	my @cols = qw(request_number year name storage_location plateId vialId vial_location
        specimen source);
	$xl->write_bold_row(\@cols);
	my $out_file = './storage_vials_deleted.xls';
	# delete if exists:
	io($out_file)->unlink if -e $out_file;

	my $i = 0;
	ROW: while ( my $row = $csv->getline($io) ) { # ddp $row;
		my ($request_number, $yr) = $row->[0] =~ m!H(\d+)/(\d{2})!;
		next ROW unless $request_number && $yr; # p [$request_number, $yr];

		my $request_id = $dbix->select(	'requests', 'id',
			{ request_number => $request_number, year => $yr + 2000 } )->value
		# or ... and is correct syntax:
		or warn "no request.id for $request_number/$yr" and next ROW; # p $request_id;

		# get storage location(s) for each vial:
		my $data = _get_storage_location($request_id); # AoA
		for my $vial(@$data) { # href
			my $vial_id = $vial->{vialId};
			# comment in request_lab_test_history:
			my $action = sprintf "deleted vial %s - DNA sample discarded "
				. 'due to contamination (see 14MG contamination report)', $vial_id;
			my %h = (
				request_id => $request_id,
				user_id	   => $user_id,
				action     => $action,
			);
			my $result = $dbix->delete("$db.request_storage",
				{ vialId => $vial_id });
			if ( $result->rows ) {
                $xl->write_row([ @{$vial}{@cols} ]);
                $dbix->insert("$db.request_lab_test_history", \%h);
                $i++;
                say "deleted vialId $vial_id";
            }
            else { say "did not delete vialId $vial_id" }
		}
	}
	$xl->save( $out_file );
	say "deleted $i records";
}

sub insert_comment { # insert comment to request_lab_test_history & request_storage:
	my $src_file  = './vials_for_comment.csv';
	open( $io, '<', $src_file ) || die $!;

	my $csv = Text::CSV->new({ binary => 1 }); # ddp $csv; exit;

	my $xl = Spreadsheet::WriteExcel::Simple->new;
	my @cols = qw(request_number year name storage_location plateId vialId vial_location
        specimen source);
	$xl->write_bold_row(\@cols);
	my $out_file = './storage_vials_comment.xls';
	# delete if exists:
	io($out_file)->unlink if -e $out_file;

	my $n1 = my $n2 = 0;
	while ( my $row = $csv->getline($io) ) { # ddp $row;
		my ($request_number, $yr) = $row->[0] =~ m!H(\d+)/(\d{2})!;
		next unless $request_number && $yr; # p [$request_number, $yr];

		my $request_id = $dbix->select(	'requests', 'id',
			{ request_number => $request_number, year => $yr + 2000 } )->value
		# or ... and is correct syntax:
		or warn "no request.id for $request_number/$yr" and next; # p $request_id;

		# get storage location(s) for each vial:
		my $data = _get_storage_location($request_id); # AoA
		for my $vial(@$data) { # p $vial; # href
			my $vial_id = $vial->{vialId}; p $vial_id;
			{ # comment in request_lab_test_history:
                my $action = sprintf "vial %s has suspected low level contamination "
                . '- see 14MG contamination report before using this sample', $vial_id;
                my %h = (
                    request_id => $request_id,
                    user_id	   => $user_id,
                    action     => $action,
                );
                my $result = $dbix->insert("$db.request_lab_test_history", \%h);
                $n1++ if $result->rows;
            }
			{ # shorter comment in request_storage table:
                my $comment = 'see sample history';
                my $result = $dbix->update("$db.request_storage",
                    { comment => $comment }, { vialId => $vial_id } );
                $n2++ if $result->rows;
            }
            $xl->write_row([ @{$vial}{@cols} ]);
		}
	}
    $xl->save( $out_file );
	say "updated $n2 storage records and created $n1 history records";
}

sub _get_storage_location {
	my $request_id = shift;

	my @col_names = qw( r.request_number r.year p.last_name|name sr.storage_location
		sr.plateId rs.vialId rs.vial_location s.sample_code|specimen rs.source );
    my @tbl_rels = (
        'request_storage|rs' => 'rs.rack_id=sr.id'        ,
		'storage_racks|sr'   => 'rs.request_id=r.id'      ,
		'requests|r'		 => 'r.patient_case_id=pc.id' ,
        'patient_case|pc'    => 'pc.patient_id=p.id'      ,
        'patients|p'         => 'rs.specimen_id=s.id'     ,
        'specimens|s'
	);
    my %where = ( 'r.id' => $request_id, 'sr.storage_location' => { -not => undef } );

	my @params = (
		-columns  => \@col_names,
		-where    => \%where,
		-from     => [ -join => @tbl_rels ],
        # -order_by => undef, # don't need it
	);
	my ($sql, @bind) = $sqla->select(@params); # p $sql; p \@bind;

	my @data = $dbix->query($sql, @bind)->hashes; # p \@data;
	return \@data;
}