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'; }