• Files
• Commits
• Log
• Graph
• Stats

# reads upload_file_for_slide_storage.xlsx for updating request_storage table
# defaults to lims_test db unless -d <db> supplied

use Getopt::Std;
getopts('qtd:'); # output sql query; testing
our($opt_q,$opt_t,$opt_d); # warn $opt_d; exit;

# switch on sql output to console:
$ENV{SQL_TRACE}  = $opt_q;
my $JUST_TESTING = $opt_t; # outputs to stdout only, doesn't do db updates

#===============================================================================
my $src = $ARGV[0] or die 'require name of src file in src sub-dir';
my $db  = $opt_d || 'lims_test';
#===============================================================================

use Spreadsheet::Read qw(ReadData rows);
use Data::Printer use_prototypes => 0;
use FindBin qw($Bin);
use Modern::Perl;

use lib '/home/raj/perl-lib';
use Local::DB;

my $dbix = Local::DB->dbix({ dbname => 'hilis4' });
my $xls  = ReadData($Bin.'/src/'.$src) || die "cannot read $src"; # p $xls; exit;

my $sheet = $xls->[1]; # p $sheet; # 1st sheet
my @rows  = rows($sheet); # p \@rows; # AoA

my $headers = shift @rows; # p $headers; exit;
$_ =~ s/\s/_/ for @$headers;
$_ =~ s/(\w+)/lc $1/eg for @$headers; # p $headers; exit;

my $request_query = q!select r.id, p.last_name from hilis4.requests r join
    hilis4.patient_case pc on r.patient_case_id = pc.id join hilis4.patients p
    on pc.patient_id = p.id where request_number = ? and year = ?!;
my $specimen_map = $dbix->select('specimens', ['sample_code','id'])->map; # p $specimen_map;

my $user_id; # set inside ROW block
my $i = 0;   # success counter

ROW:
for my $row (@rows) { # arrayref
    my $data = _to_hash($row); # p $data; next;

  # get user - may only occur once in spreadsheet, needs to be 1st row:
    if ( my $user = trim($data->{user}) ) {
        $user_id = $dbix->select('users', 'id', { username => $user })->value
            or die "cannot find user_id for user $user"; # p $user_id;
    }
    die "need a valid username in 1st column" unless $user_id;
  # get request_number & year from sample col:
    my ($req_num, $yr) = $data->{hmds_id} =~ m!H?(\d+)/(\d{2})!; # p $req_num; p $yr;
  # get request_id & last_name from hilis4 db:
    my ($req_id, $last_name)
        = $dbix->query($request_query, $req_num, $yr + 2000)->row; # p $req_id;  p $last_name;
    say "request $req_num/$yr last name mismatch ($last_name, $data->{last_name})"
        and next ROW unless $last_name eq lc trim($data->{last_name});

  # get specimen from specimen col & get specimen_id from hilis4:
    my $specimen    = trim($data->{specimen}); # p $specimen;
    my $specimen_id = $specimen_map->{$specimen} or
        say qq!don't recognise "$specimen"! and next ROW;
  # convert request_num & year into valid vialId (10 digits, zero padded):
    my $vialId = sprintf '%07d-%02d', $req_num, $yr; # p $vialId;
    say "vialId $vialId already exists" and next ROW
        if $dbix->count("$db.request_storage", { vialId => $vialId });

    my $part_num = $data->{part_number};
    my $comment  = $data->{comment};
    my $sample   = lc $data->{sample};
    my $source   = lc $data->{source};

    say "will insert $req_num/$yr $vialId/$specimen/$sample/$part_num/$source/$comment"
		and next ROW if $JUST_TESTING;
    { # update request_storage table:
        my %h = (
            specimen_id => $specimen_id,
            part_number => $part_num,
            request_id  => $req_id,
            comment     => $comment,
            vialId      => $vialId,
            sample      => $sample,
            source      => $source,
        );
        my $result = $dbix->insert("$db.request_storage", \%h);
        say "request $req_num/$yr failed to insert"
            and next ROW unless $result->rows;
        say "inserted $req_num/$yr $vialId/$specimen/$sample/$part_num/$source/$comment";
        $h{user_id} = $user_id;
        request_lab_test_history(\%h);
        $i += $result->rows;
    }
}

say "inserted $i new records";

sub trim {
    local $_ = shift || return;
    $_ =~ s/^\s+|\s+$//g;
    return $_;
}

sub _to_hash {
    my $ref = shift; # p $ref; # arrayref
    my %h;
    my $i = 0;
    for (@$headers) { # p $_;
        $h{$_} = $ref->[$i++];
    } # p %h;
    return \%h;
}

sub request_lab_test_history {
    my $ref = shift;

    my $user_id = $ref->{user_id};
    my $req_num = $ref->{req_num};
    my $req_id  = $ref->{request_id};
    my $vialId  = $ref->{vialId};
    my $yr      = $ref->{yr};

    my %h = (
        request_id => $req_id,
        user_id	   => $user_id,
        action     => "batch-inserted new storage vial (ID: $vialId)",
    ); # p \%h;
    my $result = $dbix->insert("$db.request_lab_test_history", \%h);
    say "failed to update request_lab_test_history for request $req_num/$yr"
        unless $result->rows;
}