use Modern::Perl; #=============================================================================== my $db = 'hilis4'; #=============================================================================== # extracts lab number from source file () and finds dna extraction test & vial location use lib '/home/raj/perl-lib'; use Data::Printer 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 $src_file = './samples_to_check_for_DNA.csv'; open( $io, '<', $src_file ) || die $!; my $csv = Text::CSV->new({ binary => 1 }); # p $csv; exit; my $xl = Spreadsheet::WriteExcel::Simple->new; my @cols = qw(lab_number dna_extracted storage_location plateId vialId vial_location); $xl->write_bold_row(\@cols); my $out_file = './samples_to_check_for_DNA.xls'; # delete if exists: io($out_file)->unlink if -e $out_file; my $i = 0; ROW: while ( my $row = $csv->getline($io) ) { # p $row; my ($request_number, $yr) = $row->[0] =~ m!H(\d+)_(\d{2})!; # p [$request_number, $yr]; 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; my $data = _get_storage_location($request_id); # p $data; # AoA if (@$data) { $xl->write_row([ @{$_}{@cols} ]) for @$data; # href } else { my $lab_number = join '/', $request_number, $yr; $xl->write_row( [ $lab_number, 'no' ] ); } } $xl->save( $out_file ); } sub _get_storage_location { my $request_id = shift; my @col_names = ( q!concat(r.request_number,'/',lpad(r.year - 2000,2,0))|lab_number!, q!if(ts.id,'yes','no')|dna_extracted!, qw/sr.storage_location sr.plateId rs.vialId rs.vial_location/ ); my @tbl_rels = ( 'requests|r' => '=>rs.request_id=r.id' , 'request_storage|rs' => '=>rs.rack_id=sr.id' , 'storage_racks|sr' => '=>ts.request_id=r.id' , 'request_lab_test_status|ts' => '=>ts.lab_test_id=lt.id' , 'lab_tests|lt' ); my %where = ( 'r.id' => $request_id, -or => [ 'lt.test_name' => 'dna_extraction', 'lt.test_name' => undef, ], ); my @params = ( -columns => \@col_names, -where => \%where, -from => [ -join => @tbl_rels ], ); my ($sql, @bind) = $sqla->select(@params); # p $sql; p \@bind; # $dbix->dump_query($sql, @bind); exit; my @data = $dbix->query($sql, @bind)->hashes; # p \@data; return \@data; }