use Modern::Perl;
use Data::Dumper;
# extracts user responsible for entering/updating result summary from
# request_lab_test_history table for insertion into request_result_summaries
# requires test.request_result_summary clone, with addition of user_id column
# switch on query output using -q switch
#===============================================================================
my $src = 'hilis4'; # source of request_lab_test_history data
my $db = 'hilis4'; # db.request_result_summaries to write user.id results
#===============================================================================
BEGIN {
use Getopt::Std;
getopts('q');
our($opt_q);
$ENV{SQL_TRACE} = $opt_q;
}
use lib '/home/raj/perl-lib';
use Data::Printer alias => 'p', use_prototypes => 0;
use SQL::Abstract::More;
use Local::DB;
$Local::QueryLogger::NO_QUERY_LOGS = 1; # don't need queries in logs dir
my $sqla = SQL::Abstract::More->new;
my $dbix = Local::DB->dbix({ dbname => $src });
$dbix->lc_columns = 0; # vialId
# delete test.request_result_summary.user_id col: # TOO DANGEROUS - DELETE & RECREATE TABLE INSTEAD
# $dbix->update("$db.request_result_summaries", { user_id => undef, time => \q!`time`! });
# recreate_test_rrs_table(q!`test`.`request_result_summaries`!);
do_hilis3();
do_hilis4();
sub do_hilis3 {
my %sections = ( # lab_section.id:
Flow => 1,
Hist => 2,
Mol => 4,
Gen => 5,
Fish => 7,
);
my ($sql, @bind) = $sqla->select(
-from => 'request_lab_test_history',
-columns => [ qw(request_id user_id action) ],
-where => {
# action => { rlike => '(input|updated) (Fish|Flow|Mol|Hist|Gen)Result' }
action => { rlike => \q!BINARY('Result')! }, # captures also 'requested Checked and FlowResult'
},
-order_by => 'time',
); # p $sql;
my $query = $dbix->query($sql, @bind); # p $sql;
while ( my $ref = $query->hash ) { # next unless $ref->{request_id} == 128445;
my $request_id = $ref->{request_id}; # p $request_id;
my $action = $ref->{action}; # p $action;
# capture any *Result (eg "updated MolResult and input FlowResult"):
my @matches = ( $action =~ /(\w+)Result/g ); # p \@matches;
for my $entry (@matches) {
my $section_id = $sections{$entry} or die "no section for $entry";
my $res = $dbix->update(
"$db.request_result_summaries",
{ time => \q!`time`!, user_id => $ref->{user_id} },
{ request_id => $request_id, lab_section_id => $section_id },
);
say "failed to update $request_id:$entry" unless $res->rows;
}
}
}
sub do_hilis4 {
my ($sql, @bind) = $sqla->select(
-columns => [ qw(request_id user_id action) ],
-from => 'request_lab_test_history',
-where => { action => { rlike => 'result summary' } },
-order_by => 'time',
);
my $query = $dbix->query($sql, @bind); # p $sql; p @bind;
my $map = $dbix->select('lab_sections', [ qw(section_name id) ])->map; # p $map;
REQ: while ( my $ref = $query->hash ) { # next unless $ref->{request_id} == 296930;
my $request_id = $ref->{request_id}; # p $request_id;
my $action = $ref->{action}; # p $action;
next REQ if $action =~ /^deleted/;
my ($section) = $action =~ /(?:new|updated) (.*) result summary/; # p $section;
my $section_id = $map->{$section} or die "no section for $section"; # p $section_id;
my $res = $dbix->update(
"$db.request_result_summaries",
{ time => \q!`time`!, user_id => $ref->{user_id} },
{ request_id => $request_id, lab_section_id => $section_id },
); # absence probably means section result summary deleted:
say "failed to update $request_id:$section" unless $res->rows;
}
}
sub recreate_test_rrs_table {
my $test_tbl = shift; say "dropping $test_tbl";
$dbix->dbh->do('DROP TABLE IF EXISTS '.$test_tbl );
say "creating new $test_tbl";
$dbix->dbh->do( qq!CREATE TABLE $test_tbl (
`request_id` int(11) NOT NULL DEFAULT '0',
`lab_section_id` smallint(6) NOT NULL DEFAULT '0',
`results_summary` text,
`user_id` smallint(6) DEFAULT NULL,
`time` timestamp NOT NULL DEFAULT CURRENT_TIMESTAMP ON UPDATE CURRENT_TIMESTAMP,
PRIMARY KEY (`request_id`,`lab_section_id`)
) ENGINE=InnoDB! );
my @cols = join ',', qw(request_id lab_section_id results_summary time);
my $sql = qq!INSERT INTO $test_tbl (@cols)
SELECT @cols FROM request_result_summaries!; # say $sql;
say "copying data into $test_tbl";
$dbix->dbh->do($sql);
say 'done';
}