#!/usr/bin/env perl

=begin
daily Genomics notifications:
1) consent withdrawn
2) unsent sample reason given
=cut

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

use lib '/home/raj/perl5/lib/perl5';
use Modern::Perl;
use Data::Printer;
use SQL::Abstract::More;

use FindBin qw($Bin); # warn $Bin;
use lib "$Bin/../../../lib";
use LIMS::Model::Email; # can't use ScriptHelpers::send_mail due to distribution lists
use LIMS::Local::Utils; # get_unique_elements()
use LIMS::Local::ScriptHelpers;

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

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

my $script_name = $tools->script_filename; # warn $script_name; # contains timestamp also
my $yesterday   = $tools->date_subtract(days => 1); # warn $yesterday;

# set db to genomics:
$dbix->dbh->do('use genomics'); # no need to set centre ENV param

# common contacts for both GMC centres & both arms:
my @common_contacts = qw(
    denise.hancock3@nhs.net
    gill.wilson11@nhs.net
    ra.jones@hmds.org.uk
);

# consent withdrawn (Full):
#===============================================================================
{
    my @cols = (
        'pc.unit_number|participant_id',
        "CASE WHEN sc.name = 'Cancer' THEN 'cancer' ELSE 'rare_disease' END|arm",
        'rs.organisation_code|org_code',
        'u.email|user_email',
    );
    my @rels = (
        # table|alias                  	   # FK-PK relationship
        'requests|r' 				   ,   'r.patient_case_id = pc.id'         ,
		'patient_case|pc'			   ,   'pc.referral_source_id = rs.id'     ,
		'referral_sources|rs'		   ,   'tr.request_id = r.id'              ,
        'request_lab_test_results|tr'  ,   'tr.lab_test_id = lt.id'            ,
        'lab_tests|lt'                 ,   'ris.request_id = r.id'             ,
        'request_initial_screen|ris'   ,   'ris.screen_id = s.id'              ,
        'screens|s'                    ,   's.category_id = sc.id'             ,
        'screen_category|sc'           ,   'rh.request_id = r.id'              ,
        'request_lab_test_history|rh'  ,   'rh.user_id = u.id'                 ,
        'users|u'

    );
    my %where = (
        'rh.action'     => { rlike => 'Consent withdrawal' },
        'lt.test_name'  => 'withdrawal_option',
        'DATE(tr.time)' => $yesterday->ymd,
        'tr.result'     => 'Full',
        'DATE(rh.time)' => \'= DATE(tr.time)', # literal (forces history date to
                                               # be same as recording of result
                                               # date)
    );

    my $subject = '100,000 Genomes Project: Participant Consent Withdrawn';

    my ($sql, @bind) = format_query(\@cols, \@rels, \%where);
        # $dbix->dump_query($sql, @bind); exit;
    my $data = $dbix->query($sql, @bind)->objects; # p $data; exit;

    for my $r (@$data) {
        my $message = sprintf q!The following patient has withdrawn full consent !
            . qq!to participate in the 100,000 Genomes Project on %s: %s. !
            . q!Please now take any appropriate action (e.g. destroy samples).!,
            $yesterday->dmy('/'), $r->participant_id; # p $message;

        my ($org_code, $arm) = map $r->$_, qw(org_code arm); # p $org_code; p $arm;

        my $centre = regional_centre($org_code)
            or die "no regional centre for $org_code";
        my $contacts = distribution_list($centre, $arm) # unlikely if above succeeds:
            or die "cannot find distribution list contacts for $centre/$arm";

        push @$contacts, ( @common_contacts, $r->user_email ); # p $contacts;
        # get unique list (user_email may already exist in distribution list or
        # common contacts):
        my $recipients = LIMS::Local::Utils::get_unique_elements(\@$contacts); # p $recipients;
        send_message($subject, $message, $recipients);
    }
}

# unsent sample reason:
#===============================================================================
{
    my @cols = (
        'pc.unit_number|participant_id',
        'rs.organisation_code|org_code',
        'tr.result|reason',
        'u.email|user_email',
    );
    my @rels = (
        # table|alias                  	   # FK-PK relationship
        'requests|r' 				   ,   'r.patient_case_id = pc.id'         ,
		'patient_case|pc'			   ,   'pc.referral_source_id = rs.id'     ,
		'referral_sources|rs'		   ,   'tr.request_id = r.id'              ,
        'request_lab_test_results|tr'  ,   'tr.lab_test_id = lt.id'            ,
        'lab_tests|lt'                 ,   'rh.request_id = r.id'              ,
        'request_lab_test_history|rh'  ,   'rh.user_id = u.id'                 ,
        'users|u'
    );
    my %where = (
        'rh.action'     => { rlike => 'Specimens - tumour' },
        'lt.test_name'  => 'unsent_sample_reason',
        'DATE(tr.time)' => $yesterday->ymd,
        'DATE(rh.time)' => \'= DATE(tr.time)', # literal (forces history date to
                                               # be same as recording of result
                                               # date)
    );

    my $subject = '100,000 Genomes Project: Sample Quality Issue';

    my ($sql, @bind) = format_query(\@cols, \@rels, \%where);
         # $dbix->dump_query($sql, @bind); exit;
    my $data = $dbix->query($sql, @bind)->objects; # p $data; exit;

    for my $r (@$data) {
        my $message = sprintf q!The following Unsent Sample Reason has been set !
            . q!for patient %s: %s. Please take the appropriate action !
            . q!(e.g. inform the patient/destroy samples).!,
            $r->participant_id, $r->reason; # p $message;

        my $org_code = $r->org_code;

        my $centre = regional_centre($org_code)
            or die "no regional centre for $org_code";
        # only applicable for cancer arm:
        my $contacts = distribution_list($centre, 'cancer') # unlikely if above succeeds:
            or die "cannot find distribution list contacts for $centre";

        push @$contacts, ( @common_contacts, $r->user_email ); # p $contacts;
        # get unique list (user_email may already exist in distribution list or
        # common contacts):
        my $recipients = LIMS::Local::Utils::get_unique_elements(\@$contacts); # p $recipients;
        send_message($subject, $message, $recipients);
    }
}

#===============================================================================

sub send_message { # can't use ScriptHelpers::send_mail due to distribustion lists
    my $subject  = shift; # say $subject; # str
    my $message  = shift; # say $message; # str
    my $contacts = shift; # p $contacts;  # aref

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

    for my $addr(@$contacts) {
        if ($JUST_TESTING) { next unless $addr =~ /^ra\.jones/ } # sole contact
        $mail{recipient} = $addr; # p %mail; next;
        my $rtn = LIMS::Model::Email->send_message(\%mail); # Return::Value object

        my $result = $rtn->string;
        $rtn->type eq 'success'
            ? printf "%s reports %s to %s\n", $script_name, lc $result, $addr
            : printf "%s reports %s\n", $script_name, $result;
    }
}

sub format_query {
    my ($cols, $rels, $where, $sort) = @_; # $sort optional

    my @args = (
		-columns  => $cols,
		-from     => [ -join => @$rels ],
		-where    => $where,
    ); # p @args;
    push @args, ( -order_by => $sort ) if $sort;
	my ($sql, @bind) = SQL::Abstract::More->new->select(@args); # p $sql; p @bind;
    return ($sql, @bind);
}

sub regional_centre {
    my $org_code = shift;

    my %h = (
        RAE01 => 'leeds',
        RAE05 => 'leeds',
        RCB55 => 'leeds',
        RCD01 => 'leeds',
        RCF22 => 'leeds',
        RCUEF => 'sheffield',
        RFFAA => 'sheffield',
        RFRPA => 'sheffield',
        RHQHH => 'sheffield',
        RHQNG => 'sheffield',
        RHQNN => 'sheffield',
        RHQPH => 'sheffield', # Sheffield Teaching Hospitals (admin address!!)
        RHQWP => 'sheffield',
        RJL30 => 'sheffield', # DPW patients for Sheffield
        RJL32 => 'leeds',
        RP5BA => 'sheffield',
        RP5DR => 'sheffield',
        RR801 => 'leeds',
        RR802 => 'leeds',
        RR807 => 'leeds',
        RR813 => 'leeds',
        RR814 => 'leeds',
        RR819 => 'leeds',
        RR847 => 'leeds',
        RR857 => 'leeds',     # DPW patients for Leeds
        RWA01 => 'leeds',
        RWA16 => 'leeds',
        RWA25 => 'leeds',
        RWY01 => 'leeds',
        RWY02 => 'leeds',
        RXF03 => 'leeds',
        RXF04 => 'leeds',
        RXF05 => 'leeds',
        RXF07 => 'leeds',
        RXF10 => 'leeds',
    );
    return $h{$org_code};
}

sub distribution_list {
    my ($centre, $arm) = @_;

    my %h = (
        rare_disease => {
            leeds => [ (
                'leedsth-tr.genlabadmin@nhs.net',
                'ruth.charlton1@nhs.net',
                # 'n.jaggs@nhs.net',
                'kim.cass@nhs.net',
            )],
            sheffield => [ (
                'Freyja.Docherty@sth.nhs.uk',
                'Jackie.Cook@sch.nhs.uk',
                'Janice.Nunn@sch.nhs.uk',
                'Tamar.Kammin@sth.nhs.uk',
            )],
        },
        cancer => {
            leeds => [ (
                'leedsth-tr.genlabadmin@nhs.net',
                'helen.dickinson5@nhs.net',
                'nick.west2@nhs.net',
                'eldoverghese@nhs.net',
                'phillipthompson@nhs.net',
                'ruth.charlton1@nhs.net',
                # 'n.jaggs@nhs.net',
                'kim.cass@nhs.net',
            )],
            sheffield => [ (
                'sht-tr.100KGP.Histo@nhs.net',
                'cathryn.leng@nhs.net',
                'Janice.Nunn@sch.nhs.uk',
                'Tamar.Kammin@sth.nhs.uk',
            )],
        },
    );
    return $h{$arm}{$centre};
}

# alternative to Syntax::Feature::QwComments to allow comments inside qw()
sub qw_with_comments { $_[0] =~ s/#[^\n]*//rg =~ /\S+/g }