#!/usr/bin/env perl

=begin -------------------------------------------------------------------------
1) function to email reports to:
    a) location options:
        * specific hospital department (eg Pinderfields/Haem)
        * specific organisation department (eg Leeds/Haem)
        * a hospital (all departments)
        * an organisation (all departments)

    b) request status options:
        * new
        * all

2) generates PDF of non-emailed & non-trial reports for manual printing
3) emails list of clinical trial reports
4) replaces crons/daily/email_reports.pl (LEEDS only) & crons/daily/print_run.pl

* ensure fastcgi started if run on test system (http://localhost for charts)

how to deal with reports where a departmental contact exists, and a
hospital/organisation contact (do they also get the dept report?), and also a
CWT contact (usually needs all 'new' reports)
--------------------------------------------------------------------------------
=cut

#===============================================================================
my @recipients = qw(hmds.secure raj); # for clinical trial list
#===============================================================================

BEGIN {
	use lib '/home/raj/perl5/lib/perl5'; # *must* come before FindBin($Bin)
 	use FindBin qw($Bin); # warn $Bin; exit;
 	use lib ("$Bin/../../../lib", '/home/raj/perl-lib');
 	# override default db test:
 	$ENV{ROSEDB_DEVINIT} = "$Bin/../../../config/rosedb_devinit_prod.pl";
}

use Getopt::Std;
getopts('d:t'); # days, testing
our($opt_d,$opt_t); # warn $opt_d; exit;

# emails only 'service_email' addr in config, dumps history data to lims_test db:
my $JUST_TESTING = $opt_t || 0;

use IO::All;
use File::Slurp;
use Config::Auto;
use Modern::Perl;
use Data::Printer;
use SQL::Abstract::More;
use DateTime::Format::MySQL;

use LIMS::Local::Reports;
use LIMS::Local::ScriptHelpers;

my $cfg_file = "$Bin/../lib/settings.cfg";
my $settings = Config::Auto::parse($cfg_file); # p $settings;

# get tools from 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();
my $dbix    = $tools->dbix;

# calculate dates --------------------------------------------------------------
# delta for how many days to subtract (default 1), adjust if $opt_d supplied:
my $delta = $opt_d || 1; # warn $delta; # days ago (1 for production)
# ref_date (normally yesterday):
my $ref_date = $tools->date_subtract( days => $delta ); # warn $ref_date;
# get last working day from ref_date:
my $lwd = LIMS::Local::Utils::last_working_date($ref_date); # warn $lwd;
#-------------------------------------------------------------------------------

# substitutes LIMS methods required by Role::RecordHandler:
my $lims = LIMS::Local::Reports->new({tools => $tools});
my $sqla = SQL::Abstract::More->new;
# localhost http address - for charts; is_print_request for tt formatting:
$lims->tt_params(
    app_url => 'http://localhost/hilis4',
	is_print_request => 1, # otherwise it loads guest view template by default
);
# common vars for email message:
my %mail = ( config => $config );

# load exemptions - never printed or emailed:
my $skip_reports = $tools->get_yaml_file('skip_email_reports') || {}; # hashref or 0
my $service_user = $tools->get_server_user_details();

# go:
#===============================================================================
# send reports by email; runs every day:
do_email_reports();
#===============================================================================
# generate PDF of any non-emailed, non-trial reports, for printing as PrintRun
# function; runs only on weekdays:
do_print_run_pdf() if $today->day_of_week() ~~ [1 .. 5]; # Mon - Fri
#===============================================================================
# generate list of trial cases for email; runs only on weekdays:
do_clinical_trials_list() if $today->day_of_week() ~~ [1 .. 5]; # Mon - Fri
#===============================================================================

#------------------------------------------------------------------------------
sub do_email_reports {
    # get all requests authorised/modified yesterday as AoH [request_id, status,
    # referral_source_id, department_code, parent_organisation_id, trial_name]
    my $requests = get_requests($ref_date); # p $requests; # AoH

    # get list of report email contact details as AoH:
    my $contacts = get_contacts(); # p $contacts; # AoH

    my @request_cols = qw( id status ref_src_id department_code parent_id );
    my @contact_cols
        = qw( scope contact_address parent_id department_id source_id status );

    # for each contact address, assign any matching request ids from $requests
    # involves looping through each request for each contact (but very fast):
    for my $contact (@$contacts) {
        my ($scope, $email, $parent_id, $dept_id, $location_id, $want_status)
            = @{$contact}{@contact_cols};

        my @request_ids = (); # list of request id's for this contact address

        REQ:
        for my $req (@$requests) {
            my ($req_id, $req_status, $req_refsrc_id, $req_department_code,
                $req_parent_id)	= @{$req}{@request_cols};

            # first deal with request status (requires new diagnoses or not):
            if ( $want_status eq 'new' ) {
                next REQ unless $req_status eq 'new';
            }
            # next deal with contacts for specific departments:
            if ( $dept_id ) { # 823, 824, etc
                next REQ unless $req_department_code == $dept_id;
            }
            # contact 'scope' is either hospital or organisation:
            if ( $scope eq 'hospital' ) {
                next REQ unless $req_refsrc_id == $location_id;
            }
            else { # scope = 'organisation'
                next REQ unless $req_parent_id == $parent_id;
            }
            # now have required combination of hospital/organisation + optional dept:
            push @request_ids, $req_id;
        }
        # send email address & list of request_id's to function for creating pdf's:
        generate_reports($email, \@request_ids);
    }
}

#------------------------------------------------------------------------------
sub generate_reports { # creates pdf's for handing to dispatch_report()
    my ($email, $request_ids) = @_; # contact address, [ request.ids ]
=begin #========================================================================
    # for testing using known requests:
    $email = 'hmds.lth@nhs.net';
    $request_ids = [
      # 307257 # NEQAS request - anonymised patient
      # 308979 # PenENRICH trial - unknown referrer
      # 309256 # Imatinib chart
      # 308502 # Outreach
    ];
#===============================================================================
=cut
    # get pdf's as in-memory object for each contact - may involve compiling some
    # reports more than once but alternative is save to disk and clean up after
    REQ:
    for my $req_id (@$request_ids) {
        my $pdf = $lims->format_report($req_id); # L::C::Roles::RecordHandler
        # $pdf > io("$Bin/$req_id.pdf"); warn 'for test only'; next REQ;
        $mail{attachment} = $pdf;

        # retrieve request data object stashed in Recordhandler::_format_report():
        my $data = $lims->stash->{request_data};

        { # add subject line:
            my $referrer_department = $data->referrer_department;

            my $subject = sprintf 'HMDS Report for %s / %s',
                $referrer_department->hospital_department->display_name, # speciality
                $referrer_department->referrer->name; # referrer
            # doesn't work properly if unknown clinician - uses referrer_department.id 31116:
            if ( $subject =~ /Unknown clinician/ ) { # "Unknown/Other / Unknown clinician"
                $subject = 'HMDS Report [referrer unknown]'
            }
            $mail{subject} = $subject;
        }
        { # add filename:
            my $filename = sprintf '%02d_%05d.pdf',
                $data->year - 2000,
                $data->request_number;
            $mail{filename} = $filename;
        } # p \%mail;
        # send report to recipient:
        $mail{recipient} = $email; # p \%mail;
        dispatch_report({ request_id => $req_id, message => \%mail });
    }
}

#------------------------------------------------------------------------------
sub do_print_run_pdf {
    my $pdf_title = ( $lwd->ymd eq $ref_date->ymd )
        ? sprintf ( 'Print run [%s]', $ref_date->dmy('.') )
        : sprintf ( 'Print run [%s - %s]', $lwd->dmy('.'), $ref_date->dmy('.') ); # p $pdf_title;
    my $pdf_name  = 'printrun_' . $today->ymd . '.pdf'; # p $pdf_name;
    my $pdf_path  = $JUST_TESTING ? '/tmp' : '/backups/print_run'; # p $pdf_path;

    my $pdf = PDF::API2->new(-file => join '/', $pdf_path, $pdf_name);
    $pdf->info( Title => $pdf_title );

    my $add_new_pdf = sub {
        my $data = shift;
        my $pdf_string = $lims->format_print_run_report($data);
        my $api = PDF::API2->open_scalar($pdf_string);
        $pdf->importpage($api, $_) for (1 .. $api->pages);
    };

    my $ref = get_request_ids('non-trial');
    for my $request_id ( @{ $ref->{request_ids} } ) { # warn $request_id; # next;
		my $req = $lims->get_single_request_data($request_id); # L::C::Roles::RecordHandler
        $lims->process_raw_lab_test_data($req);
		&$add_new_pdf($req);
    }
    for my $request_id ( @{ $ref->{ccs} } ) {
        my $req = $lims->get_single_request_data($request_id);
        $lims->process_raw_lab_test_data($req);
        my $o = $req->{data};
        $o->referrer_department->referrer->name('cc'); # replace referrer name
        &$add_new_pdf($req);
     }
    $pdf->save; # to $pdf_path
}

#------------------------------------------------------------------------------
sub do_clinical_trials_list { # need to capture $ccs but don't need:
    my $ref = get_request_ids('clinical-trial');

    my @rows;
    for my $request_id ( @{ $ref->{request_ids} } ) { # warn $request_id; # next;
        my $req  = $lims->get_single_request_data($request_id); # L::C::Roles::RecordHandler
        my $data = $req->{data}; # RDBO
        push @rows, sprintf '%s :: %s/%s :: %s',
            $data->request_trial->trial->trial_name,
            $data->request_number,
            $data->year - 2000,
            $data->patient_case->referral_source->display_name;
    }
    if (@rows) {
        my $subject = sprintf 'Clinical trial reports [%s]',
            ( $lwd->ymd eq $ref_date->ymd )
                ? sprintf $ref_date->dmy('.')
                : join ' to ', $lwd->dmy('.'), $ref_date->dmy('.'); # p $subject;
        my %mail = (
            config  => $config,
            subject => $subject,
            message => join "\n", @rows,
        ); # p %mail;
        $tools->send_mail(\%mail, \@recipients);
    }
}

#------------------------------------------------------------------------------
sub get_contacts {
	my @cols = qw(
		ec.display_name
		ec.referral_source_id|source_id
		rs.parent_organisation_id|parent_id
		ec.scope
		ec.department_id
		ec.contact_address
		ec.status
	);
    my @rels = qw(
        email_contacts|ec   ec.referral_source_id=rs.id     referral_sources|rs
	);
    my @args = (
		-columns  => \@cols,
		-from     => [ -join => @rels ],
		-where    => { 'ec.type' => 'report', 'ec.is_active' => 'yes' },
	); # p @args;
	my ($sql, @bind) = $sqla->select(@args); # p $sql; # p \@bind;
	  # $dbix->dump_query($sql, @bind); exit;
    my $ref = $dbix->query($sql, @bind)->hashes;
    return $ref;
}

#------------------------------------------------------------------------------
sub get_request_ids { # used by do_print_run_pdf() & do_clinical_trials_list()
    my $type = shift;

    my %h = (
        start_date => $lwd,
        end_date   => $ref_date,
        type  	   => $type,
    );
    my ($request_ids, $ccs) = $lims->model('PrintRun')->get_print_run_request_ids(\%h);
    return { request_ids => $request_ids, ccs => $ccs };
}

#------------------------------------------------------------------------------
sub get_requests {
    my $start_date = shift;
    my $end_date   = shift; # optional, absence implies single day, presence = date range

	my @cols = qw(
        r.id
        rr.status
        rs.id|ref_src_id
		hd.id|department_code
        rs.parent_organisation_id|parent_id
        ct.trial_name
    );
    my @rels = (
        'requests|r'                  => 'ris.request_id=r.id'               ,
        'request_initial_screen|ris'  => 'ris.screen_id=s.id'                ,
        'screens|s'                   => 'r.patient_case_id=pc.id'           ,
        'patient_case|pc'             => 'pc.referral_source_id=rs.id'       ,
        'referral_sources|rs'         => 'r.referrer_department_id=rd.id'    ,
		'referrer_department|rd'	  => 'rd.hospital_department_code=hd.id' ,
		'hospital_departments|hd'     => 'rr.request_id=r.id'				 ,
		'request_report_view|rr'	  => 'r.status_option_id=so.id'			 ,
		'status_options|so'           => '=>rt.request_id=r.id'              ,
		'request_trial|rt'			  => '=>rt.trial_id=ct.id'				 ,
		'clinical_trials|ct'
    );
    my $date_restriction = $end_date # implies date range
        ? { -between => [ $start_date->ymd, $end_date->ymd ] }
        : $start_date->ymd;

	my %where = (
        'DATE(rr.updated_at)' => $date_restriction,
		'so.description'      => { -in => [ qw(authorised complete) ] },
	);
	# skip specified screened_as/presentations:
	if ( my $presentation = $skip_reports->{presentation} ) { # aref
		$where{'s.description'} = { -not_in => $presentation };
	}
	# skip specified clinical trials:
	if ( my $trials = $skip_reports->{clinical_trial} ) { # aref
		$where{'ct.trial_name'} = # needs an undef or lose all non-ct entries
			[ -or => { -not_in => $trials }, undef ];
	}

    my @args = (
		-columns => \@cols,
		-from    => [ -join => @rels ],
		-where   => \%where,
	);
	my ($sql, @bind) = $sqla->select(@args); # p $sql; # p \@bind;
	   # $dbix->dump_query($sql, @bind); # exit;
    my $ref = $dbix->query($sql, @bind)->hashes; # AoH
    return $ref;
}

#------------------------------------------------------------------------------
sub dispatch_report {
    my $args = shift;

    my $request_id = $args->{request_id};
    my $message    = $args->{message};

    # substitute recipient address here if $JUST_TESTING (L::L::Mail doesn't any more):
    if ($JUST_TESTING) {
        my $safe_address = $config->{service_email};
        die "unsafe recipient address $safe_address"
            unless $safe_address =~ /\@nhs.net\Z/;
        $message->{recipient} = $safe_address;
    }

    my $result = LIMS::Model::Email->send_message($message); # Return::Value
    my $centre = $ENV{CENTRE} || 'leeds';

	if ( $result->type eq 'success' ) {
        my $recipient = $message->{recipient};
        my $filename  = $message->{filename};

        my $str = $result->string; # rs = 'message sent'; can't substitute direct on rs, so:
        $str =~ s/message/$filename [$centre]/i; # str = eg '12_01234.pdf [uclh] sent'

        printf "%s %s to %s\n", $tools->script_filename, $str, $recipient;

        my %data = (
            request_id => $request_id,
            recipient  => $recipient,
        );

        # log details in request_dispatch_log & request_history tables:
        unless ($JUST_TESTING) {
            my $rtn = $lims->model('Request')->update_request_dispatch_log(\%data);
            warn "Error in $0: $rtn" if $rtn;
        }
        else { # manual input into lims_test db:
            $dbix->insert('lims_test.request_dispatch_log', \%data);

            $data{user_id} = $service_user->{id};
            $data{action}  = 'dispatched report to ' . $recipient;
            delete $data{recipient};
            $dbix->insert('lims_test.request_history', \%data);
        }
    }
	else {
		warn $result->string;
        $tools->mail_admin({ script => $0, msg => $result->string });
	}
}