#!/usr/bin/perl

=begin -------------------------------------------------------------------------
for messages with body consisting of text rows (not attachments or html)
emails list of cases during previous week with:
* biopsy-site or morphology matching testicular, breast or CNS/cerebral
* cytogenetics result = failed
* inadequate unfixed specimens
=cut ---------------------------------------------------------------------------

use strict;
use warnings;

my $JUST_TESTING = 0; # email to ra.jones only
my $duration     = 7; # over past number of days

use lib '/home/raj/perl5/lib/perl5';
use Data::Printer;

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

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

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

my ($recipients, $subject, $query); # vars set/reset in code blocks

#===============================================================================
{ # failed cytogenetics:
	$recipients = [ qw( raj sharon.barrans.secure catherine.cargo.secure
		matt.cullen ) ]; # from contacts.lib
	$subject = 'Cytogenetics failed week ending ' . $today;
	$query   = $sql_lib->retr('cytogenetics_failed');
	run();
}
{ # testicular, breast & CNS/cerebral biopsies:
	$recipients = [ qw( raj sharon.barrans.secure ) ]; # from contacts.lib
	$subject = 'Testicular/breast/CNS biopsies week ending ' . $today;
	$query   = $sql_lib->retr('testicular_breast_cns_biopsies');
	run();
}
{ # inadequate unfixed samples
	$recipients = [ qw( raj david.blythe.secure sarah.bagguley.secure ) ]; # from contacts.lib
	$subject = 'Inadequate unfixed specimens week ending ' . $today;
	$query   = $sql_lib->retr('inadequate_unfixed_specimen');
	run();
}
#===============================================================================

sub run {
	my $message = 'no requests this week'; # default if no data
	if ( my @data = $dbix->query($query, $duration)->arrays ) {
		$message = join "\n", map { # replace default
			join ' :: ', map $_ ||= 'NULL', @{$_};
		} @data; # p $message; return;
	}
	my %mail = (
		config  => $config,
		message => $message,
		subject => $subject,
	); # p %mail; p $recipients

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