• Files
• Commits
• Log
• Graph
• Stats

#!/usr/bin/perl

=begin -------------------------------------------------------------------------
emails XL list of Myeloma X FISH data to specified recipients - no longer required
=cut ---------------------------------------------------------------------------

use strict;
use warnings;

my $JUST_TESTING = 0; # email to ra.jones only

############ recipients from contacts.lib #######################################
my @recipients = qw( raj.secure ); # selina.denman.secure
################################################################################

use lib '/home/raj/perl5/lib/perl5';
use Data::Dumper;
use Sort::Naturally;
use Spreadsheet::WriteExcel::Simple;

use FindBin qw($Bin); # warn $Bin;
use lib $Bin . '/../../../lib';
use LIMS::Local::ScriptHelpers;

# get tools from LIMS::Local::ScriptHelpers:
my $tools = LIMS::Local::ScriptHelpers->new();
$tools->test_only($JUST_TESTING);

#-------------------------------------------------------------------------------
my $duration = 2; # how many months back
my $date = $tools->date_subtract( months => $duration );

my $subject  = sprintf 'Myeloma X FISH data for %s.%s',
	$date->month_abbr, $date->year; # warn $subject; exit;
my $filename = 'myelomaX.xls';

# xl file headers:
my @headers = qw( request_number year registered last_name first_name
    trial_number presentation fish_result fish_date flow_result flow_date );
#-------------------------------------------------------------------------------

my $sql_lib  = $tools->sql_lib();
my $config   = $tools->config();
my $dbix     = $tools->dbix();

# get map of field_names => lab_test_id of FISH probes which are resultable:
my $probes = do {
    my $query = $sql_lib->retr('resultable_fish_probe_names'); # warn $query;
    $dbix->query($query)->map;
}; # warn Dumper $probes;

# get alphanumeric list of FISH probe names:
my @probe_names = Sort::Naturally::nsort( keys %$probes ); # warn Dumper @probe_names; exit;

# need to create map of FISH probe name to column position for XL output:
my %probe_name_to_array_position_map = do {
    my $i = @headers; # no of elements in array, so next array pos = $headers[$i]
    map { $_ => $i++ } @probe_names; # ie increment AFTER use
}; # warn Dumper \%probe_name_to_array_position_map; exit;

# add FISH probe names to @headers:
push @headers, @probe_names; # warn Dumper @headers; exit;

my @data;

# get SQL statements for queries:
my $requests = $sql_lib->retr('myelomaX_data_requests');
my $results  = $sql_lib->retr('myelomaX_fish_results');

my @bind = ($duration, $duration, $duration, $duration);
my $result = $dbix->query( $requests, @bind ); # 4 placeholders for duration val

while ( my @row = $result->list ) { # warn Dumper \@row; next;
    my $request_id = shift @row; # remove request.id from data

	# get list of FISH data for each request as an array of hashrefs:
    my $fish_data = $dbix->query($results, $request_id)->hashes;
	for (@$fish_data) { # warn Dumper $_;
		my $probe  = $_->{field_label};
		my $result = $_->{result};

		# add probe result at its correct col position:
		my $ary_pos = $probe_name_to_array_position_map{$probe};
		$row[$ary_pos] = $result; # warn Dumper [$probe, $result, $ary_pos];
	}
    # add combined request data & FISH probe data to @data:
    push @data, \@row;
}

# flag to Local::Mail::_verify_service_status() that msg safe to send:
$config->{_safe_message} = 1 if ! $config->{is_in_production_mode};

my %mail = (
	config  => $config,
	subject => $subject,
);

if (@data) {
	my $xl = Spreadsheet::WriteExcel::Simple->new;
	$xl->write_bold_row(\@headers);
	$xl->write_row($_) for @data; # $xl->save("myeloma_data.xls"); exit;

	$mail{attachment} = $xl->data;
    $mail{filename}   = $filename;
}
else {
	$mail{message} = sprintf 'No myeloma X data for %s.%s',
        $date->month_abbr, $date->year;
}

$tools->send_mail(\%mail, \@recipients);

# sub by_name { lc $a cmp lc $b } # alphabetically, ignores case