• Files
• Commits
• Log
• Graph
• Stats

#!/usr/bin/perl

=begin -------------------------------------------------------------------------
quarterly email XL list of all trial cases (except HTC & Gallium)
=cut ---------------------------------------------------------------------------

use strict;
use warnings;

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

############ usernames from users table #######################################
my @recipients = qw( ruth-de.tute.secure sarah.bagguley.secure raj.secure );
################################################################################

use lib '/home/raj/perl5/lib/perl5';
use Sort::Naturally;
use Data::Dumper::Concise;

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

my $cfg_file = "$Bin/../lib/settings.cfg";
my $settings = Config::Auto::parse($cfg_file); # warn Dumper $settings;

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

#-------------------------------------------------------------------------------
my $duration = 3; # months

my $yesterday = $tools->date_subtract( days => 1 );
my $filename  = sprintf 'trial_cases_%s.xls', lc $yesterday->quarter_abbr;
my $subject   = sprintf 'Trial cases for %s', $yesterday->quarter_abbr;

# xl file headers:
my @headers = qw( request_number year last_name first_name dob location
    presentation registered specimen );
#-------------------------------------------------------------------------------

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

my $re = qr{\[\]\:\*\?\/\\}; # to substitute invalid chars in trialname

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

# get SQL statements for query:
my $sql = $sql_lib->retr('trial_cases'); # warn $sql;
my $result = $dbix->query( $sql, $duration );

my %data; # container for results of query, keys = trialnames

while ( my $ref = $result->hash ) { # warn Dumper $ref; next;
    my $trialname = $ref->{trial_name}; # substitute invalid chars:
    $trialname =~ s/[$re]/_/g; # warn $trialname;
    push @{ $data{$trialname} }, [ @{$ref}{@headers} ];
} # warn Dumper \%data; exit;

if (%data) {
	my $content; # to hold output of write_excel_file() - sent as  *scalarref*
	my $xl = LIMS::Local::ExcelHandler->new({ scalarref => \$content });

	my @data = map {
		{
			name => $_,
			data => $data{$_}, # array(ref) of AoH
			headers => \@headers,
		}
    } sort keys %data;

	$xl->write_excel_file(\@data); # formats @data into $content output
	binmode STDOUT; # apparently this is needed even for linux

	$mail{attachment} = $content;
    $mail{filename}   = $filename;
}
else { # unlikely:
	$mail{message} = 'No ' . lcfirst $subject; # Trial cases for ....
}
$tools->send_mail(\%mail, \@recipients);