#!/usr/bin/perl

=begin -------------------------------------------------------------------------
Compiles & emails authorised (or amended) reports as PDF attachments for
locations specified in email_contacts table, where 'type' col is set to 'report'

Does not sent report for 'unknown clinician' due to referrer_department row 31116:
rd.parent_organisation_id = 298 (UNKNOWN) so query "where rd.parent_organisation_id
= nnn" always fails - fixed in email_reports.pl (doesn't use rd in query restriction)

Required entries must be in email_contacts table (doesn't use lib/contacts.lib
as most of addresses are the same as for mdt contact), with 'type' col set to
'report'. May require entries in %departments & @require_new in config section
below.

Scope = organisation, hospital or department. If set to 'organisation', records
are retrieved using parent_organisation_id; if scope set to 'department', expects
entry in %departments map to provide hospital_department.display_name to filter
on; if set to hospital, uses the referral_source_id to retrieve records

Skip reports configured in skip_email_reports.yml

Uses LIMS::Controller::Roles::format_report() to generate PDF reports, via
LIMS::Local::Reports to provide methods - render_view(), model(), etc - required
by LIMS methods

Uses 'file' as session store (set in L::Local::LIMS), /chart/ url calls LIMS so
it provides USE_FILE_SESSIONS query param flag to prevent new db session created
--------------------------------------------------------------------------------
=cut

use strict;
use warnings;

my $JUST_TESTING = 0; # emails just raj, dumps history data to lims_test db

################################################################################
my %departments = ( # entry MUST match display_name in email_contacts table
    # email_contacts.display_name => hospital_departments.display_name
    Airedale    => 'histopathology',
    Blackburn   => 'histopathology',
    Harrogate   => 'Histopathology',
    Preston     => 'histopathology',
    Salford     => 'histopathology',
    Wigan       => 'histopathology',
    Wythenshawe => 'histopathology',
);

# recipients requiring only 'new' diagnoses - otherwise defaults to 'all':
my @require_new = ( # entry MUST match display_name in email_contacts table
    'Calderdale (CWT)',  # Cancer Waiting Times
    'Scarborough (CWT)', # Cancer Waiting Times
);

my $delta = $ARGV[0] || 1; # warn $delta; # days ago (1 for production)
################################################################################

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

use IO::All;
use File::Slurp;
use Data::Dumper;
use Config::Auto;
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); # warn Dumper $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 $dbix    = $tools->dbix();

my $date = $tools->date_subtract( days => $delta )->ymd; # warn $date;
# substitutes LIMS methods required by Role::RecordHandler :
my $lims = LIMS::Local::Reports->new({tools => $tools});

{ # localhost http address - for charts; is_print_request for tt formatting:
    my $process_name = $config->{process_name};
    $lims->tt_params(
		app_url => 'http://localhost/' . $process_name,
		is_print_request => 1, # can't use c.get_current_runmode method
	);
}

#-------------------------------------------------------------------------------
# common vars for email message:
my %mail = (
	config  => $config,
);

# universally required constraints:
my @common_constraints = (
    q!DATE(rr.updated_at) = ?!,
    q!so.description IN ('authorised', 'complete')!,
);

# get contents of email_contacts table:
my $email_contacts = get_active_email_contacts(); # AoH

# get referral_source_id map of locations requiring only 'new' reports:
my $ids_requiring_new = get_locations_requiring_new($email_contacts); # hashref

# get referral_source_id map of locations requiring departmental reports:
my $department_location_ids = get_department_locations($email_contacts); # hashref

# load exemptions:
my $skip_reports = $tools->get_yaml_file('skip_email_reports'); # hashref or 0
#-------------------------------------------------------------------------------

# go:
{
    # get base query, appended with restriction depending on scope (dept, hospital, organisation)
    # my $base_sql = join ' ', <DATA>; warn $base_sql; exit;
    my $base_sql = $sql_lib->retr('mail_reports_request_ids');

    # get list of request_ids to send to compile_reports():
    ENTRY: # loop through each contact and get request_id's as required:
    for my $recipient (@$email_contacts) { # warn Dumper $recipient;
        # next ENTRY unless $recipient->{is_active} eq 'yes'; in query now

        my $ref_src_id = $recipient->{referral_source_id};
        my $entry_id   = $recipient->{id}; # email_contacts.id
        my $scope      = $recipient->{scope}; # dept, hospital or organisation

        # using GROUP_CONCAT on contact_address to avoid repeat data retrieval:
        my @contacts = split ',', $recipient->{contacts}; # maybe > 1

        # copy of $base_sql initial state (gets modified inside blocks):
        my $local_sql = $base_sql;

		# re-initialise arrays:
        my @local_constraints = (); # clear
        my @bind = ($date); # $date universally required

        # reports can be for department, hospital or organisation:
        if ( $scope eq 'department' ) {
            # add restrictions:
            push @local_constraints, ('rs.id = ?', 'hd.display_name = ?');

            my $department = $department_location_ids->{$entry_id} # warn $department;
            || die "cannot find data for email_contacts.id = $entry_id";
            push @bind, ($ref_src_id, $department);
        }
        elsif ( $scope eq 'organisation' ) {
            # add restrictions:
            push @local_constraints, q!rd.parent_organisation_id = ?!;

            # find parent_organisation of ref_src_id:
            my $sql = q!select parent_organisation_id from referral_sources
                where id = ?!;
            $dbix->query( $sql, $ref_src_id )->into( my $parent_org_id );
            push @bind, $parent_org_id;
        }
        elsif ( $scope eq 'hospital' ) {
            # add restrictions:
            push @local_constraints, q!rs.id = ?!;
            push @bind, $ref_src_id;
        }
        else { die "unknown scope: $scope" }

        # restrict to new reports if required:
        if ( $ids_requiring_new->{$entry_id} ) {
            push @local_constraints, q!rr.status = ?!;
			push @bind, 'new';
        }

        if ($skip_reports) { # skip reports:
            { # initial screens:
                my $ary = $skip_reports->{presentation}; # arrayref
                my $str = join ',', map $dbix->dbh->quote($_), @$ary;
                push @local_constraints, qq!s.description NOT IN ($str)!;
            }
            { # clinical trials:
                my $ary = $skip_reports->{clinical_trial}; # arrayref
                my $str = join ',', map $dbix->dbh->quote($_), @$ary;
                push @local_constraints, # need 1st part or query only returns trial cases:
					qq!( ct.trial_name IS NULL OR ct.trial_name NOT IN ($str) )!;
            }
        }

        $local_sql .= join ' AND ', (@common_constraints, @local_constraints);
			# warn Dumper [$local_sql, \@bind]; next ENTRY;
        my $request_ids = $dbix->query($local_sql, @bind)->flat;

        compile_reports( $request_ids, \@contacts ) if @$request_ids;
    }
    # compile_reports([148879], ['ra.jones@nhs.net']); # has chart
    # compile_reports([155975], ['ra.jones@nhs.net']); # has clinical trial
    # compile_reports([175234], ['ra.jones@nhs.net']); # is anonymised patient
}

# IO::All method supsended pending bugfix - https://rt.cpan.org/Public/Bug/Display.html?id=41819
{ # tidy up cgisess files in /tmp from LIMS::Local::Reports session()
    # my @files = io('/tmp')->all_files; # get all files in /tmp
    # map $_->unlink, grep $_->filename =~ /\Acgisess_/, @files;
    my @files = File::Slurp::read_dir('/tmp'); # warn Dumper \@files;
	map { io('/tmp/'.$_)->unlink } grep /\Acgisess_/, @files;
}

sub compile_reports {
    my ($request_ids, $contacts) = @_; # arrayref, arrayref

    for my $request_id (@$request_ids) { # warn $request_id; next;
        { # generate pdf attachment:
			my $pdf = $lims->format_report($request_id); # L::C::Roles::RecordHandler
            # $pdf > io("./$request_id.pdf"); warn 'for test only'; exit;
			$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
			$mail{subject} = $subject;
		}
		{ # add filename:
			my $filename = sprintf '%02d_%05d.pdf',
				$data->year - 2000,
				$data->request_number;
			$mail{filename} = $filename;
		} # warn Dumper \%mail;
        # send report to recipient(s):
        for my $recipient (@$contacts) {
            $mail{recipient} = $recipient;
            dispatch_report({ request_id => $request_id, message => \%mail });
        }
    }
}

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->{email_from};
        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);

            my $service_user = $tools->get_server_user_details();
            $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 });
	}
}

sub get_active_email_contacts { # get array of hashrefs of location/scope => email:
# query uses GROUP_CONCAT on contact_address to avoid repeat data retrieval for
# same location/scope if multiple contacts configured:
    my $sql = $sql_lib->retr('get_email_contacts');
    my $email_contacts = $dbix->query($sql, 'report')->hashes; # warn Dumper $email_contacts;
    return $email_contacts;
}

sub get_department_locations { # locations requiring departmental reports
    my $email_contacts = shift;

    my @locations = keys %departments;

    my %map;
    CONTACT: for my $entry (@$email_contacts) {
        next CONTACT unless $entry->{scope} eq 'department'
            && ( grep $entry->{display_name} eq $_, @locations );
        my $location    = $entry->{display_name};
        my $location_id = $entry->{id};
        my $department  = $departments{$location};

        $map{$location_id} = $department;
    }

    return \%map;
}

sub get_locations_requiring_new { # require 'new' reports only
    my $email_contacts = shift;

    my @ids;
    CONTACT: for my $location (@$email_contacts) {
        next CONTACT unless grep $location->{display_name} eq $_, @require_new;
        push @ids, $location->{id};
    }

    my %map = map { $_ => 1 } @ids;
    return \%map;
}

__DATA__
SELECT r.id
FROM requests r
    JOIN patient_case pc on (r.patient_case_id = pc.id)
	JOIN referrer_department rd on (r.referrer_department_id = rd.id)
	JOIN hospital_departments hd on (rd.hospital_department_code = hd.id)
    JOIN referral_sources rs on (pc.referral_source_id = rs.id)
    JOIN request_initial_screen ris on (ris.request_id = r.id)
    JOIN screens s on (ris.screen_id = s.id)
    JOIN request_report_view rr ON (r.id = rr.request_id)
    JOIN status_options so ON (r.status_option_id = so.id)
    LEFT JOIN ( request_trial rt JOIN clinical_trials ct on (rt.trial_id = ct.id) )
        on (rt.request_id = r.id )
WHERE /* constraints added in script */