#!/usr/bin/env perl

=begin #------------------------------------------------------------------------
* generates messages to registered recipients when new report available or updated
* excludes clinical trial samples
* runs every 30 (?) mins
* see __DATA__ section for sql queries

Event Triggers:
    * New authorised report
    * Any change to summary comment or diagnosis
    * New Diagnosis
    * Relapsed Diagnosis
    * Manual Trigger (as in with the right permissions, the reporter can trigger
        a notification to any recipient)
    * New & relapsed diagnosis covered in new authorised report or diagnosis update

Any existing row only updated with a more recent datetime, using:
    "ON DUPLICATE KEY UPDATE
        datetime = IF(VALUES(datetime) > datetime, VALUES(datetime), datetime)"
    *** see __DATA__ section for validation ****
Uses columns() and maybe hash_map() methods so needs Local::DB

TODO:
* how to register clinician?
    - at request registration if request box checked (consultant/registrar/etc)
        will require registered user on HILIS
    - individual request - take email from logged-in user
    - always for some clinicians?

* use insert_multi($new_table, [ +{ 1 => time, 2 => time, etc }], { ignore => 1 } # INSERT IGNORE query
* select requests from new table >5 mins old - allows for 2 updates within short time span
* include request status (new/relapsed/default) to allow selective messaging
* checks for recipient(s), emails message(s), deletes entry
#-------------------------------------------------------------------------------
=cut

BEGIN {
	use constant DURATION => 1800; # default if no value passed as -t
	use Getopt::Std;
	getopts('t:'); # time (seconds)
	our($opt_t);
} # warn $opt_t; exit;

my $JUST_TESTING = 1; # emails admin only

#===============================================================================
my $delta = $opt_t || DURATION; # warn $delta; # time window (seconds) to detect update
my $delay = 300; # seconds delay - to allow for reflection before sending notification
#===============================================================================

# delta value cannot be less than $delay (needs to be much greater to avoid risk
# of task repeating before previous instance finished, so set at 2x):
die "run frequency ($delta seconds) cannot be less than 2x delay time ($delay seconds)"
    unless $delta >= $delay * 2;

my $dbname = $ENV{CENTRE} || 'hilis4'; # cron exports 'CENTRE' for non-HMDS tasks

use lib (
    '/home/raj/perl5/lib/perl5',
    '/home/raj/perl-lib',
);

use Local::DB;
use Modern::Perl;
use Config::Auto;
use Data::Printer;
use FindBin qw($Bin); # warn $Bin; exit;
use SQL::Abstract::More;

use lib "$Bin/../../../lib";
use LIMS::Local::ScriptHelpers;
$Local::QueryLogger::NO_QUERY_LOGS = 1; # don't need queries in logs dir
$Local::DBIx::Simple::Result::NO_AUTO_DATE_INFLATION = 1; # don't need DT object

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

my $config = $tools->config(); # p $config;
my $table  = 'request_notification';

my $sqla = SQL::Abstract::More->new;
my $dbix = Local::DB->dbix({dbname => $dbname});

# get user.id of server_username from config:
my $server_name = $config->{server_username};
my $user_id = $dbix->select('users', 'id', { username => $server_name })->value;

my $NOW = $tools->time_now;
# duration to detect a change of request status:
my $window = $NOW->clone->subtract( seconds => $delta ); # p $window;
# timepoint at time now minus delay:
my $t_max = $NOW->clone->subtract( seconds => $delay ); # p t_max;

# run update queries ===========================================================
{ # newly authorised requests within past $delta mins:
    my @rels = (
        'request_status_view|rsv' => '=>rt.request_id = rsv.request_id' ,
        'request_trial|rt'
    );
    my @args = (
        -columns => [ 'rsv.request_id', 'rsv.time|datetime' ],
        -from    => [ -join => @rels ],
        -where   => {
            'rt.request_id' => undef,
            'rsv.action'    => 'authorised',
            'rsv.time'      => { '>=' => $window },
        }
    );
    my ($sql, @bind) = $sqla->select(@args); # p $sql; # p \@bind;
    my $result = $dbix->query($sql, @bind);
    while ( my $ref = $result->hash ) {
        $dbix->insert_or_update_if_greater($table, $ref, 'datetime');
    }
}

{ # diagnosis update within past $delta mins:
    my @rels = (
        'requests|r'                      => 'r.status_option_id=so.id' ,
        'status_options|so'               => 'rdh.request_id = r.id'    ,
        'request_diagnosis_history|rdh'   => '=>rt.request_id = r.id'   ,
        'request_trial|rt'
    );
    my @args = (
        -columns => [ 'r.id|request_id', 'rdh.time|datetime' ],
        -from    => [ -join => @rels ],
        -where   => {
            'rt.request_id'  => undef,
            'so.description' => { -in => [ 'authorised','complete' ] },
            'rdh.time'       => { '>=' => $window },
        }
    );
    my ($sql, @bind) = $sqla->select(@args); # p $sql; # p \@bind;
    my $result = $dbix->query($sql, @bind);
    while ( my $ref = $result->hash ) {
        $dbix->insert_or_update_if_greater($table, $ref, 'datetime');
    }
}

{ # results_summary update within past $delta mins - a bit slow ??
    my @rels = (
        'requests|r'                     => 'r.status_option_id=so.id'  ,
        'status_options|so'              => 'rrs.request_id = r.id'     ,
        'request_result_summaries|rrs'   => '=>rt.request_id = r.id'    ,
        'request_trial|rt'
    );
    my @args = (
        -columns => [ 'r.id|request_id', 'rrs.time|datetime' ],
        -from    => [ -join => @rels ],
        -where   => {
            'rt.request_id'  => undef,
            'so.description' => { -in => [ 'authorised','complete' ] },
            'rrs.time'       => { '>=' => $window },
        }
    );
    my ($sql, @bind) = $sqla->select(@args); # p $sql; # p \@bind;
    my $result = $dbix->query($sql, @bind);
    while ( my $ref = $result->hash ) {
        $dbix->insert_or_update_if_greater($table, $ref, 'datetime');
    }
}

my @req_ids = $dbix->select($table, 'request_id',
    { datetime => { '<' => $t_max } })->column; # say $_ for @req_ids; exit;
# @req_ids = (300001 .. 300005); # for testing

# get details for all request_id's =============================================
my @notifications = do {
	my @cols = qw(
		p.last_name
		p.first_name
		p.nhs_number
        p.dob
        r.id|request_id
        rrv.status
        pc.referral_source_id
        rs.parent_organisation_id
        ref.national_code|gmc_code
        rd.hospital_department_code
	); # r.request_number r.year ref.name|referrer rs.display_name|location
    my @rels = (
        'requests|r'                =>  'r.patient_case_id=pc.id'           ,
        'patient_case|pc'           =>  'pc.patient_id=p.id'                ,
        'patients|p'                =>  'pc.referral_source_id=rs.id'       ,
        'referral_sources|rs'       =>  'rrv.request_id=r.id'               ,
        'request_report_view|rrv'   =>  'r.referrer_department_id=rd.id'    ,
        'referrer_department|rd'    =>  'rd.referrer_id=ref.id'             ,
        'referrers|ref'
	);
    my @args = (
		-columns  => \@cols,
		-from     => [ -join => @rels ],
		-where    => { 'r.id' => { -in => \@req_ids } },
	); # p @args;
	my ($sql, @bind) = $sqla->select(@args); # p $sql; # p \@bind;
	  # $dbix->dump_query($sql, @bind); exit;
    $dbix->query($sql, @bind)->hashes;
}; # p \@notifications;

=begin
    Each selected request is checked for any registered recipient(s), message(s)
    sent, then deleted from request_notification. Any row with timestamp more
    recent than the delay (5 mins) will be processed by subsequent cycle.
=cut

for my $ref (@notifications) { # p $ref;
    my @addr = _retrieve_addresses($ref);
    _notify($ref, @addr);
    # delete row whether message sent or not:
    $dbix->delete($table, { request_id => $ref->{request_id} });
}

#===============================================================================
sub _retrieve_addresses {
    my $data = shift;

    my @cols = qw( hospital_department_code parent_organisation_id
        referral_source_id gmc_code );
    my ($department_id, $parent_id, $source_id, $gmc_number) = @{$data}{@cols};

    my @where = (
        { type => 'organisation', identifier => $parent_id  },
        { type => 'hospital',     identifier => $source_id  },
        { type => 'referrer',     identifier => $gmc_number },
        { -and => [
            department_id => $department_id,
                [
                    { type => 'organisation', identifier => $parent_id },
                    { type => 'hospital',     identifier => $source_id },
                ]
            ],
        },
    );
    my @args = (
		-columns  => 'contact_address',
		-from     => 'report_notification',
		-where    => \@where,
	); # p @args;
	my ($sql, @bind) = $sqla->select(@args); # p $sql; # p \@bind;
	    # $dbix->dump_query($sql, @bind); exit;
    my @addr = $dbix->query( $sql, @bind )->array;
    return @addr;
}

sub _notify {
    my ($data, @recipients) = @_; # href, array

    my $message = sprintf '<%s/search/notification/%s>',
        $config->{application_url}, $data->{request_id}; # p $message;
    my $subject = $data->{status} eq 'new'
        ? 'HMDS new diagnosis report available'
        : 'HMDS report available';
    $subject .= sprintf ' [%s %s :: %s]',
        ucfirst $data->{first_name}, uc $data->{last_name},
        $data->{nhs_number} || $data->{dob}; # p $subject;
    my $table = $JUST_TESTING ? 'lims_test.request_history' : 'request_history';

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

    for my $addr (@recipients) {
        $mail{recipient} = $JUST_TESTING
            ? $config->{admin_contact} : $addr;
        warn "unsafe recipient address $mail{recipient}" and next
            unless $mail{recipient} =~ /\@nhs.net\Z/;
        my $result = LIMS::Model::Email->send_message(\%mail); # Return::Value
        if ( $result->type eq 'success' ) { # log
            my %h = (
                request_id => $data->{request_id},
                user_id    => $user_id,
                action     => 'dispatched report notification to ' . $addr,
            );
            $dbix->insert($table, \%h);
        }
    }
}

__DATA__
# test of ON DUPLICATE KEY UPDATE datetime:
# http://stackoverflow.com/questions/10081481/mysql-update-if-value-is-greater-than-that-current-value

$dbix->delete('test.'$table); # don't do this on live server !!

{ # insert row:
    my $sql = qq!
        INSERT INTO 'test.$table(request_id, datetime) VALUES(??)
        ON DUPLICATE KEY UPDATE datetime
            = IF(VALUES(datetime) > datetime, VALUES(datetime), datetime)
    !;
    my $res = $dbix->query($sql, 10, '2017-01-01 02:00:00'); say $res->rows;
}
say "check test.$table now"; sleep 5;
{ # earlier datetime - should *not* update:
    my $sql = qq!
        INSERT INTO 'test.$table(request_id, datetime) VALUES(??)
        ON DUPLICATE KEY UPDATE datetime
            = IF(VALUES(datetime) > datetime, VALUES(datetime), datetime)
    !;
    my $res = $dbix->query($sql, 10, '2017-01-01 01:00:00'); say $res->rows;
}
say "check test.$table now"; sleep 5;
{ # later datetime - *should* update:
    my $sql = qq!
        INSERT INTO 'test.$table(request_id, datetime) VALUES(??)
        ON DUPLICATE KEY UPDATE datetime
            = IF(VALUES(datetime) > datetime, VALUES(datetime), datetime)
    !;
    my $res = $dbix->query($sql, 10, '2017-01-01 03:00:00'); say $res->rows;
}
say "check test.$table now"; exit;

================================================================================
INSERT INTO $table
    SELECT rsv.request_id, rsv.time
    FROM request_status_view rsv
    LEFT JOIN request_trial rt on rt.request_id = rsv.request_id
    WHERE rsv.time > DATE_SUB(NOW(), INTERVAL ? MINUTE)
and rsv.action = 'authorised'
and rt.request_id IS NULL
ON DUPLICATE KEY UPDATE datetime
    = IF(VALUES(datetime) > datetime, VALUES(datetime), datetime)

INSERT INTO $table
    SELECT rdh.request_id, rdh.time
    FROM request_diagnosis_history rdh
    JOIN requests r on rdh.request_id = r.id
    LEFT JOIN request_trial rt on rt.request_id = r.id
    WHERE rdh.time > DATE_SUB(NOW(), INTERVAL ? MINUTE)
and r.status_option_id IN (4,5)
and rt.request_id IS NULL
ON DUPLICATE KEY UPDATE datetime
    = IF(VALUES(datetime) > datetime, VALUES(datetime), datetime)

INSERT INTO $table
    SELECT rrs.request_id, rrs.time
    FROM request_result_summaries rrs
    JOIN requests r on rrs.request_id = r.id
    LEFT JOIN request_trial rt on rt.request_id = r.id
    WHERE rrs.time > DATE_SUB(NOW(), INTERVAL ? MINUTE)
and r.status_option_id IN (4,5)
and rt.request_id IS NULL
ON DUPLICATE KEY UPDATE datetime
    = IF(VALUES(datetime) > datetime, VALUES(datetime), datetime)

SELECT contact_address
FROM notification_contacts
WHERE
    ( type = 'referrer'     and identifier = ? )  or
    ( type = 'hospital'     and identifier = ? )  or
    ( type = 'organisation' and identifier = ? )  or
    ( department = ? and (
      ( type = 'hospital' and identifier = ? ) or
      ( type = 'organisation' and identifier = ? )
    ) )
