#!/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