#!/usr/bin/env perl

=begin #------------------------------------------------------------------------
* generates messages to registered recipients when new or updated report available
* excludes clinical trial & outreach samples
* select requests >5 mins old to allow for further updates within short time span
* runs every 30 (?) mins
* see __DATA__ section for sql queries

Event Triggers: request status either authorised or complete, and one of:
    * new authorised report
    * confirmed final diagnosis
    * change to diagnosis
    * amended comment
To do:
    * request status (new/relapsed/default) to allow selective messaging
    * manual trigger (as in with the right permissions, the reporter can trigger
        a notification to any recipient)

Any existing request_notification 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 ****
#-------------------------------------------------------------------------------
=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 = 0; # emails admin only, logs to lims_test.request_history

#===============================================================================
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 (and 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 Template;
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; # 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  = $JUST_TESTING
    ? 'lims_test.request_notification' : '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;
# timepoint for deciding if notification is new or update = authorised < (window + t_max):
my $auth_time_cutoff = $NOW->clone->subtract( seconds => $delta + $delay ); # p $auth_time_cutoff;

# run queries to update request_notification table =============================
do_updates();

# get request id's from request_notification with timestamps older than delay (t_max):
my @req_ids = $dbix->select($table, 'request_id',
    { datetime => { '<' => $t_max } })->column; # say $_ for @req_ids; exit;
# @req_ids = (300001 .. 300005); # for testing
exit unless @req_ids; # or next query is nonsense (where 0=1)

# 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
        rrd.status
        rrd.comment
        pc.referral_source_id
        rs.parent_organisation_id
        ref.national_code|gmc_code
        rd.hospital_department_code
        max(rh.time)|authorised
        d.name|diagnosis
	    d2.name|secondary_diagnosis
	); # 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'             => 'rrd.request_id=r.id'              ,
        'request_report_detail|rrd'       => 'r.referrer_department_id=rd.id'   ,
        'referrer_department|rd'          => 'rd.referrer_id=ref.id'            ,
        'referrers|ref'                   => 'rh.request_id=r.id'               ,
        'request_history|rh'              => 'rrd.diagnosis_id=d.id'            ,
        'diagnoses|d'                     => '=>rsd.request_id=r.id'            ,
        'request_secondary_diagnosis|rsd' => '=>rsd.secondary_diagnosis_id=d2.id',
        'diagnoses|d2'
	);
    my @args = (
		-columns  => \@cols,
		-from     => [ -join => @rels ],
		-where    => {
            'rh.action' => 'authorised',
            'r.id'      => { -in => \@req_ids },
        },
        -group_by => 'r.id', # required for MAX(rh.time)
	); # 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

my $tt = Template->new({ TAG_STYLE => 'asp' }); # for tt rendering (only uclh)

for my $ref (@notifications) { # p $ref;
    # send notification(s) to any addresses configured for this request:
    if ( my @addr = _retrieve_addresses($ref) ) { # p \@addr; AoH
        _send_notification($ref, @addr);
    }
    # delete row whether message sent or not:
    $dbix->delete($table, { request_id => $ref->{request_id} });
}

#===============================================================================
sub do_updates { # request_history.action within past $delta mins:
    my @skip_screens = ( # don't notify if screened as:
        'Outreach',
        'Outreach CML',
        'Outreach CLL post-Rx monitoring',
        'Outreach BLPD/PCD pre-Rx monitoring',
    );
    my @rels = (
        'requests|r'                    => 'r.status_option_id=so.id'  ,
        'status_options|so'             => 'rh.request_id=r.id'        ,
        'request_history|rh'            => '=>rt.request_id=r.id'      ,
        'request_trial|rt'              => 'ris.request_id=r.id'       ,
        'request_initial_screen|ris'    => 'ris.screen_id=s.id'        ,     
        'screens|s'
    );
    my @args = (
        -columns => [ 'r.id|request_id', 'rh.time|datetime' ],
        -from    => [ -join => @rels ],
        -where   => {
            'rt.request_id'  => undef,
            's.description'  => { -not_in => \@skip_screens },
            'so.description' => { -in => [ 'authorised','complete' ] },
            -or => [
                'rh.action' => { -in =>
                    [
                        'confirmed final diagnosis',
                        'amended comment',
                        'authorised',
                    ],
                },
                'rh.action' => { -like => 'amended diagnosis (%)' }, # can be error or update
            ],
            'rh.time' => { '>=' => $window },
        }
    );
    my ($sql, @bind) = $sqla->select(@args); # p $sql; # p \@bind;
        # $dbix->dump_query($sql, @bind);  exit;
    my $result = $dbix->query($sql, @bind);
    while ( my $ref = $result->hash ) { # p $ref; next;
        $dbix->insert_or_update_if_greater($table, $ref, 'datetime');
    }
}

=begin # replaced by a single request_history table query above
sub do_updates {
    { # newly authorised requests within past $delta mins:
        my @rels = (
            'request_history|rh' => '=>rh.request_id = rt.request_id' ,
            'request_trial|rt'
        );
        my @args = (
            -columns => [ 'rh.request_id', 'rh.time|datetime' ],
            -from    => [ -join => @rels ],
            -where   => {
                'rt.request_id' => undef,
                'rh.action'     => 'authorised',
                'rh.time'       => { '>=' => $window },
            }
        );
        my ($sql, @bind) = $sqla->select(@args); # p $sql; # p \@bind;
            # $dbix->dump_query($sql, @bind); # exit;
        my $result = $dbix->query($sql, @bind);
        while ( my $ref = $result->hash ) {
    #        $ref->{status} = 'authorised'; # using "rh.time as authorised" instead
            $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;
            # $dbix->dump_query($sql, @bind); # exit;
        my $result = $dbix->query($sql, @bind);
        while ( my $ref = $result->hash ) {
    #        $ref->{status} = 'updated'; # using "rh.time as authorised" instead
            $dbix->insert_or_update_if_greater($table, $ref, 'datetime');
        }
    }
    { # results_summary update within past $delta mins - slow and replaced with next block
        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;
            # $dbix->dump_query($sql, @bind); # exit;
        my $result = $dbix->query($sql, @bind);
        while ( my $ref = $result->hash ) {
    #        $ref->{status} = 'updated'; # using "rh.time as authorised" instead
            $dbix->insert_or_update_if_greater($table, $ref, 'datetime');
        }
    }
    { # requests.updated_at within past $delta mins, or request_report_detail.updated_at
        # within past $delta mins and > requests.updated_at
        my @rels = (
            'requests|r'                     => 'r.status_option_id=so.id'  ,
            'status_options|so'              => 'rrd.request_id = r.id'     ,
            'request_report_detail|rrd'      => '=>rt.request_id = r.id'    ,
            'request_trial|rt'
        );
        my @args = (
            -columns => [ 'r.id|request_id', 'rrd.updated_at|datetime' ],
            -from    => [ -join => @rels ],
            -where   => {
                'rt.request_id'  => undef,
                'so.description' => { -in => [ 'authorised','complete' ] },
                -or => [
                    'r.updated_at'   => { '>=' => $window },
                    'rrd.updated_at' => { '>=' => $window, '>' => \'r.updated_at' },
                ],
            }
        );
        my ($sql, @bind) = $sqla->select(@args); # p $sql; # p \@bind;
            # $dbix->dump_query($sql, @bind); # exit;
        my $result = $dbix->query($sql, @bind);
        while ( my $ref = $result->hash ) {
    #        $ref->{status} = 'updated'; # using "rh.time as authorised" instead
            $dbix->insert_or_update_if_greater($table, $ref, 'datetime');
        }
    }
}
=cut

#-------------------------------------------------------------------------------
sub _retrieve_addresses {
    my $data = shift;
    return ( { contact_address => $config->{service_email}, status => 'all' } )
        if $JUST_TESTING;

    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 = (
        -and => [
            is_active => 'yes',
            [ # <= square bracket pair not strictly necessary here
                { 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', 'status' ],
		-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 )->hashes;
    return @addr;
}

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

    my $message; # default (leeds) is for no message apart from url, appended below
    if ( $config->{_centre} eq 'uclh' ) { # parse template:
        $message = _process_uclh_tt($data);
    }
    # append url to online report:
    $message .= sprintf
        'The full report is available online: <%s/search/notification/%s>',
            $config->{application_url}, $data->{request_id}; # p $message; exit;

    my $subject = sprintf 'Notification of %s HMDS report on %s %s [%s]',
        # must be an update if authorised before (window + delay) mins ago:
        ( $data->{authorised} < $auth_time_cutoff ? 'an updated' : 'a new' ),
        # names:
        ucfirst $data->{first_name}, uc $data->{last_name},
        # nhs number or dob:
        ( $data->{nhs_number} || $data->{dob}->ymd ); # p $subject;

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

    my $tbl = $JUST_TESTING # already have a global $table (request_notification)
        ? 'lims_test.request_history' : 'request_history';

    ADDR:
    for my $recipient (@recipients) { # p $recipient;
        # skip if contact wants only new diagnoses & diagnosis status isn't new:
        next ADDR if $recipient->{status} eq 'new' && $data->{status} ne 'new';

        my $addr = $recipient->{contact_address};
        warn "unsafe recipient address $addr" and next ADDR
            unless $addr =~ /\@nhs.net\Z/;

        $mail{recipient} = $addr; # p \%mail; next ADDR;
        my $result = LIMS::Model::Email->send_message(\%mail); # Return::Value
        if ( $result->type eq 'success' ) { # log it:
            my %h = (
                request_id => $data->{request_id},
                user_id    => $user_id,
                action     => 'dispatched report notification to ' . $addr,
            );
            $dbix->insert($tbl, \%h);
        }
    }
}

#-------------------------------------------------------------------------------
sub _process_uclh_tt {
    my $data = shift;

    my $tmpl = qq!An integrated report is available on your patient !
    . qq!<% first_name.ucfirst %> <% last_name.upper %> d.o.b. <% dob.ymd %> !
    . qq!showing a <% IF status.match('new'); 'NEW '; END %>diagnosis !
    . qq!of "<% diagnosis %>"<% IF secondary_diagnosis %> and a secondary !
    . qq!diagnosis of "<% secondary_diagnosis %>"<% END %>.\n\n!
    . qq!<% IF comment %>Comment: <% comment %>\n\n<% END %>!;

    my $msg;
    $tt->process(\$tmpl, $data, \$msg) or die $tt->error(); # p $msg; # die OK as data stays in db
    return $msg;
}

__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
 /* do not use request_status_view in cron - maybe exceeds /tmp capacity for tmp 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 = ? )
    ) )