#!/usr/bin/perl

=begin -------------------------------------------------------------------------
emails .csv list of new Hodgkin diagnoses, or any previous Hodgkin diagnosis
changed to something else, over specified duration, for LTH & Bradford Hospitals,
to Blood Bank contacts - can be set to test mode using $JUST_TESTING
=cut ---------------------------------------------------------------------------

use strict;
use warnings;

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

############ recipients from contacts.lib ######################################
my @recipients = qw( stephen.potts terrence.haines david.beale raj.secure );
my $duration = 7; # over past number of days
################################################################################

BEGIN {
    use FindBin qw($Bin); # warn $Bin;
    use lib "$Bin/../../../lib";
}

use Data::Dumper;
use LIMS::Local::ScriptHelpers;

#-------------------------------------------------------------------------------
my $date     = DateTime->today->dmy;
my $filename = 'hodgkin.csv';
my $subject  = "New/amended Hodgkin lymphomas for week ending $date";

# csv file headers:
my @headers = qw(LastName FirstName DoB PatientID NHSNumber Location Diagnosis);
# fields for formatting data in _process_data():
my @fields = qw(last_name first_name dob unit_number nhs_number location diagnosis);
#-------------------------------------------------------------------------------

# 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;
{ # new hodgkin cases:
    my $query = $sql_lib->retr('hodgkin');
    
    my $result = $dbix->query($query, $duration);    
    
    while (my $ref = $result->hash) { # warn Dumper $vars; next;
        my $row = _process_data($ref);
        push @rows, $row;
    }
}
{ # get cases which have diagnoses revised to other than hodgkin:
    my $query = $sql_lib->retr('ex-hodgkin');
    
    my $result = $dbix->query($query, $duration);    
    
    while (my $ref = $result->hash) { # warn Dumper $vars; next;
        my $row = _process_data($ref);
        push @rows, $row;
    }
}

unless (@rows) {
    print "No new Hodgkin diagnoses for week ending $date\n";
    exit;
} # no point e-mailing empty list

# add headers to beginning of @rows:
unshift @rows, join ',', @headers;

my $content = join "\n", @rows;

my %mail = (		
	attachment => $content,
	config     => $config,
    filename   => $filename,
	subject    => $subject,
    message    => '', # don't need one
); # warn Dumper \%mail; # next;
    
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;

	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};
	}
}

sub _process_data {
    my $data = shift; # warn Dumper $data;
    
    # get rid of csv field delimiters and ensure no undef's:
    map { $data->{$_} =~ s/\,//g } qw(location diagnosis);
    map { $data->{$_} ||= ''     } qw(dob nhs_number);
    # case transform:
    $data->{first_name} = ucfirst $data->{first_name};
    $data->{last_name}  = uc $data->{last_name};
    # join data fields: 
    my $row = join ',', @{$data}{@fields};
    return $row;
}