# reads upload_file_for_slide_storage.xlsx for updating request_storage table # defaults to lims_test db unless -d 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; }