package LIMS::Local::ScriptHelpers;

#-------------------------------------------------------------------------------
# provides dbix, sql_lib, lims_config & template objects to stand-alone scripts
#-------------------------------------------------------------------------------

use Moose;
with 'LIMS::Local::Role::DiagnosisAlert';

has secure_contacts => ( is => 'ro', isa => 'HashRef', lazy_build => 1 );
has user_emails     => ( is => 'ro', isa => 'HashRef', lazy_build => 1 );

has test_only => ( is => 'rw', isa => 'Str' ); # skips email recipients execept raj
has template  => ( is => 'ro', isa => 'Template', lazy_build => 1 );
has sql_lib   => ( is => 'ro', isa => 'LIMS::Local::QueryLibrary', lazy_build => 1 );
has config    => ( is => 'ro', isa => 'HashRef', lazy_build => 1 );
has dbix      => ( is => 'ro', isa => 'DBIx::Simple', lazy_build => 1 );

__PACKAGE__->meta->make_immutable;

use IO::All;
use Net::FTP;
use Template;
use Config::Auto;
use DBIx::Simple;
use Data::Dumper;
use Net::SCP::Expect;
use LIMS::Local::Utils;
use LIMS::Model::Email;
use LIMS::Local::Config;
use LIMS::Local::QueryLibrary; # patched version of SQL::Library
use DateTime::Format::Strptime;

# for Role::DiagnosisAlert:
sub get_sql_lib { return shift->sql_lib }
sub get_config  { return shift->config  }
sub get_dbix    { return shift->dbix    }

BEGIN {
# FindBin doesn't work as lims_config.pl can't find_home()
    use FindBin qw($Bin); # warn $Bin;
#    use lib "$Bin/../../../lib";
#    use lib "$Bin/../../../config";
#    warn Dumper \@INC;
}

# my $PATH_TO_APP_ROOT = '/home/raj/www/apps/HMDS/trunk';
my $PATH_TO_APP_ROOT = "$Bin/../../../"; # warn $PATH_TO_APP_ROOT;

1;

sub process_template {
    my ($self, $tmpl, $data) = @_;
    
    my $tt = $self->template;
    
    my $output;
    $tt->process($tmpl, $data, \$output); # warn Dumper $filled_tmpl;

    return $output;    
}

sub ftp_file {
    my ($self, $args) = @_;
    
	my $ftp = Net::FTP->new($args->{server_addr}, Debug => 0)
    || return "Cannot connect to $args->{addr}: $@";
    
    if ($args->{username} && $args->{password}) {
        $ftp->login(@{$args}{qw/username password/}) 
        || return 'Cannot login - ' . $ftp->message;
    }
	$ftp->binary();
	
	$ftp->put($args->{local_filename}, $args->{remote_filename})
    # need to return NOW, or err message() will be replaced by outcome of quit():
    || return 'FTP error - ' . $ftp->message; 
    
    $ftp->quit;
    
    return 0; # don't return message() here - will be result of quit() eg 'goodbye'
}

sub scp_file {
    my ($self, $args) = @_; # warn Dumper $args;
    
    my %auth = (
        host => $args->{server_addr},
        user => $args->{username},
        password => $args->{password}, # don't need this if using ssh keys
    );
    
	my $dest = '/'; # root dir for login
	my $src  = $args->{local_filename};

    my $scp = Net::SCP::Expect->new(%auth); # uses hash args
    # my $scp = Net::SCP->new(\%auth); # if using ssh keys; uses hashref args ??
    $scp->scp($src, $dest);
    
    return $scp->{errstr} if $scp->{errstr};
}

sub get_server_user_details {
    my $self = shift;
    
    my $server_username = $self->config->{server_username}; 
    my $sql = 'select * from users where username = ?';
    my $user = $self->dbix->query($sql, $server_username)->hash; # warn Dumper $user;
    return $user;
}

sub send_mail {
    my ($self, $mail, $recipients) = @_;
    
    my $JUST_TESTING = $self->test_only(); # warn $JUST_TESTING;
    
    RECIPIENT:
    foreach my $recipient (@$recipients) {    
        my $addr = ( $recipient =~ /\@nhs.net/ )
            ? $recipient # use directly if already email address format
            : $self->recipient_address($recipient);

        unless ($addr) { # in case it doesn't exist
	        my $filename = $self->script_filename;
            warn "$filename: can't find address for $recipient";
            next RECIPIENT;
        }
        next RECIPIENT if ( $JUST_TESTING && $addr !~ /ra\.jones/ );
        
        $mail->{recipient} = $addr; # warn Dumper $mail; # next;

        my $ok = $mail->{attachment} # both return 1 on success, 0 on failure:
            ? $self->send_attachment($mail)
            : $self->send_message($mail);

        return 0 unless $ok; # most callers don't care about return
    }
    return 1; # all recipients OK
}

sub send_attachment {
    my ($self, $mail) = @_;    
    
    my $filename = $self->script_filename;

    my $rtn = LIMS::Model::Email->send_attachment($mail); # returns hashref:    
    if ($rtn->{success}) {
        my $email = $mail->{recipient};
        print "$filename reports " . lc $rtn->{message} . " to $email\n";
    }
    else {
        print "$filename reports " . $rtn->{message};
        warn "$filename error: " . $rtn->{message};
    }
    return $rtn->{success} ? 1 : 0; # return 1 on success, 0 on failure
}

sub send_message {
    my ($self, $mail) = @_;

    my $filename = $self->script_filename;
    
    my $rtn = LIMS::Model::Email->send_message($mail); # returns error or 0   
    if ($rtn) {
        print "$filename reports " . $rtn;
        warn "$filename error: " . $rtn;
    }
    else {
        my $email = $mail->{recipient};
        print "$filename reports message sent to $email\n";
    }
    return $rtn ? 0 : 1; # return 1 on success, 0 on failure
}

sub mail_admin {
    my ($self, $args) = @_;
    
    my $cfg = $self->config;
    
    my $subject = 'Error message from ' . $args->{script};
    
	my %mail = (		
		config  => $cfg,
		message => $args->{msg},
		subject => $subject, 	
	); # warn Dumper \%mail; return;
    
    $mail{recipient} = $cfg->{admin_contact};

	my $rtn = LIMS::Model::Email->send_message(\%mail);	
    if ($rtn) {
        my $filename = $self->script_filename;
        warn "$filename error: $rtn";
    }
}

sub do_request_history {
    my ($self, $args, $recipients) = @_;
    
    return 0 if $self->test_only(); # don't log to request_history if just testing
    
    my $dbix = $self->dbix();
    
    RECIPIENT:
    foreach my $recipient (@$recipients) { # warn $recipient;
        my $addr = $self->recipient_address($recipient);

        unless ($addr) { # in case it doesn't exist
	        my $filename = $self->script_filename;
            warn "$filename: can't find address for $recipient";
            next RECIPIENT;
        }
        
        my %local = %$args; # take local copy of $args
        $local{action} = $args->{action} . ' to ' . $addr; # append addr to action
        
        $dbix->insert('request_history', \%local); # warn Dumper \%local;
    }
}

sub recipient_address {
    my ($self, $recipient) = @_;

    my $secure_contacts = $self->secure_contacts(); # warn Dumper $secure_contacts;
    my $user_emails     = $self->user_emails();    

    my $addr = ( $recipient =~ /\.secure\Z/ ) # these require nhs.net address:
        ? $secure_contacts->{$recipient}
        # non-secure address, either from hilis4.users table,
        # or contacts.lib also has some non-HILIS users addresses:
        : ( $user_emails->{$recipient} || $secure_contacts->{$recipient} );  
    
    return $addr;
}

sub script_filename {
	my $self = shift;
	
	my $caller = $0;
	my $filename = io($caller)->filename; # returns filename part of full/path/to/filename
	
	my $formatter = DateTime::Format::Strptime->new( pattern => '%Y-%m-%d %T' );
    return sprintf '%s [%s]', $filename, $self->time_now({ formatter => $formatter });
}

sub time_now {
	my $self = shift;
    my $args = shift; # optional args hashref for DT constructor
	return LIMS::Local::Utils::time_now($args); # considers BST
}

sub date_subtract {
    my $self = shift;
    my ($period, $int, $args) = @_; # eg months, 6, optional args for DT->new
    
    my $today = $self->time_now($args);    
    return $today->subtract($period, $int);
}

sub _build_dbix {
    my $self = shift;

    # get db connection params from config file
    my $cfg = $self->config; # warn Dumper $cfg;
    
    my $uid = $cfg->{db_user_id};
    my $pwd = $cfg->{db_password};
    my $db  = $cfg->{production_db};

    my $dsn = "dbi:mysql:$db";

    my $dbix = DBIx::Simple->connect($dsn, $uid, $pwd, { RaiseError => 1 });
    
    return $dbix;
}

sub _build_sql_lib {
    my $self = shift; # warn $PATH_TO_APP_ROOT;
    
    my $lib = "$PATH_TO_APP_ROOT/src/lib/library.sql";
    my $sql_lib = new LIMS::Local::QueryLibrary( { lib => $lib } );
    
    return $sql_lib;
}

sub _build_secure_contacts {
    my $src_file = "$PATH_TO_APP_ROOT/src/lib/contacts.lib";
    my $contacts = Config::Auto::parse($src_file); 
    return $contacts;
}

sub _build_user_emails {
    my $self = shift;    
    return $self->dbix->query('select username, email from users')->map;
}

sub _build_config {
    my $self = shift;
    
    my $config = LIMS::Local::Config->instance;
    my $settings = $config->{settings};
    return $settings;
}

sub _build_template {
    my $self = shift;
    
    my $t = Template->new({ INCLUDE_PATH => "$PATH_TO_APP_ROOT/templates" });
    return $t;
}