#!/usr/bin/perl =begin ------------------------------------------------------------------------- emails XL list of MDS diagnoses (new & follow-up) over past week =cut --------------------------------------------------------------------------- use strict; use warnings; my $JUST_TESTING = 1; # email to ra.jones only ############ recipients from contacts.lib ###################################### my @recipients = qw( catherine.norton.secure raj.secure ); my $duration = 7; # over past number of days ################################################################################ BEGIN { use FindBin qw($Bin); # warn $Bin; use lib ( "$Bin/../../../lib", '/home/raj/perl5/lib/perl5', ); } use Data::Dumper; use LIMS::Local::ScriptHelpers; use Spreadsheet::WriteExcel::Simple; #------------------------------------------------------------------------------- my $today = DateTime->today->dmy; my $from = DateTime->today->subtract( days => $duration )->dmy; my $subject = "MDS diagnoses [$from to $today]"; my $filename = 'mds.xls'; # xl file headers: my @headers = qw( lab_number last_name first_name case_number nhs_number dob location diagnosis authorised status ); #------------------------------------------------------------------------------- # get tools from LIMS::Local::ScriptHelpers: my $tools = LIMS::Local::ScriptHelpers->new(); my $contacts = $tools->get_contacts(); my $sql_lib = $tools->sql_lib(); my $config = $tools->config(); my $dbix = $tools->dbix(); my @rows; my $query = $sql_lib->retr('mds_diagnoses'); my $result = $dbix->query($query, $duration); while (my $row = $result->array) { # warn Dumper $row; next; push @rows, $row; } my %mail = ( config => $config, subject => $subject, ); if (@rows) { my $xl = Spreadsheet::WriteExcel::Simple->new; $xl->write_bold_row(\@headers); $xl->write_row($_) for @rows; $mail{attachment} = $xl->data; $mail{filename} = $filename; } else { $mail{message} = q!No MDS diagnoses were made during this period.!; } RECIPIENT: foreach my $recipient (@recipients) { my $email = $contacts->{$recipient} or next RECIPIENT; # in case doesn't exist next RECIPIENT if $JUST_TESTING && $email !~ /ra\.jones/; $mail{recipient} = $email; # warn Dumper $mail{recipient}; next; if ($mail{attachment}) { my $rtn = LIMS::Model::Email->send_attachment(\%mail); # returns hashref: if ($rtn->{success}) { print "$0 reports " . lc $rtn->{message} . " to $email\n"; } else { warn $rtn->{message}; } } else { my $rtn = LIMS::Model::Email->send_message(\%mail); warn "Error in $0: $rtn" if $rtn; } }