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