• Files
• Commits
• Log
• Graph
• Stats

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