#!/usr/bin/perl =begin ------------------------------------------------------------------------- emails 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( david.blythe.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 $month = $tools->date_subtract( months => 1 ); # date 1 month ago my $subject = sprintf 'Trial cases for %s %s', $month->month_abbr, $month->year; # warn $subject; exit; my $filename = sprintf 'trial_cases_%s_%s.xls', $month->month_abbr, $month->year; # 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 ); 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 { $mail{message} = sprintf 'No trial cases for %s %s', $month->month_abbr, $month->year; } $tools->send_mail(\%mail, \@recipients);