• Files
• Commits
• Log
• Graph
• Stats

package LIMS::Local::ScriptHelpers;

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

use Moose;
with (
    'LIMS::Model::Roles::Query', # sql_lib()
    'LIMS::Local::Role::DiagnosisAlert',
    'LIMS::Local::Role::DiagnosisConfirm',
);

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 use_path  => ( is => 'rw', isa => 'Str' ); # allows scripts to override default path_to_app_root
has template  => ( is => 'ro', isa => 'Template', lazy_build => 1 );
has config    => ( is => 'ro', isa => 'HashRef', lazy_build => 1 ); # settings.txt
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 Data::Dumper;
use Net::SCP::Expect;
use LIMS::Local::Utils;
use LIMS::Model::Email;
use LIMS::Local::Config;
use LIMS::Local::DBIxSimple; # patched to allow omniholders with individual placeholders
use DateTime::Format::Strptime;

# for Role::DiagnosisAlert:
sub get_settings { return shift->config  } # content of settings.txt file
sub get_sql_lib  { return shift->sql_lib }
sub get_dbix     { return shift->dbix    }

BEGIN {
    use FindBin qw($Bin); # warn $Bin;
#    use lib "$Bin/../../../lib";
#    use lib "$Bin/../../../config";
#    warn Dumper \@INC;
}

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) = @_; # warn Dumper $args;

	my $ftp = Net::FTP->new($args->{server_addr}, Debug => 0)
    || return "Cannot connect to $args->{server_addr}: $@";

    if ($args->{username} && $args->{password}) {
        $ftp->login(@{$args}{qw/username password/})
        || return 'Cannot login - ' . $ftp->message;
    }
	$ftp->binary();
    $ftp->passive(1) if $args->{passive_mode};

	$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 get_yaml_file {
    my ($self, $file) = @_;

    my $cfg = $self->config; # warn Dumper $cfg;

    my %args = (
        app_root => $self->path_to_app_root,
        yaml_dir => $cfg->{yaml_dir},
        filename => $file,
    );
    my $yaml = LIMS::Local::Utils::get_yaml(\%args);
    return $yaml;
}

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 = $self->send_message($mail); # returns 1 on success, 0 on failure
        return 0 unless $ok; # most callers don't care about return
    }
    return 1; # all recipients OK
}

sub send_message { # returns 1 on success, 0 on failure
    my ($self, $mail) = @_;

    my $JUST_TESTING = $self->test_only(); # warn $JUST_TESTING;
    return 0 if ( $JUST_TESTING && $mail->{recipient} !~ /ra\.jones/ );

    my $filename = $self->script_filename;

    my $result = LIMS::Model::Email->send_message($mail); # Return::Value object

	if ( $result->type eq 'success' ) {
        my $email = $mail->{recipient};
        printf "%s reports %s to %s\n", $filename, lc $result->string, $email;
		return 1;
	}
	else { # failure
        printf "%s reports %s\n", $filename, $result->string;
        warn "$filename error: " . $result->string;
		return 0;
	}
}

sub path_to_app_root {
	my $path = shift->use_path() || $Bin . '/../../..'; # warn $path;
	return $path;
}

sub mail_admin {
    my ($self, $args) = @_;

    my $cfg = $self->config;

    my $recipient = $cfg->{sysadmin_email};
    my $message   = $args->{msg};

	# use specified subject, or create default:
    my $subject = $args->{subject} || 'Error message from ' . $args->{script};

	my %mail = (
        recipient => $recipient,
		message   => $message,
		subject   => $subject,
		config    => $cfg,
	); # warn Dumper \%mail; return;

	my $rtn = LIMS::Model::Email->send_message(\%mail);	# Return::Value object
    if ($rtn->type ne 'success') {
        my $filename = $self->script_filename;
        warn "$filename error: " . $rtn->string;
    }
}

sub log_diagnosis_alert {
    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 @args = ( $dsn, $uid, $pwd, { RaiseError => 1 } );
    my $dbix = LIMS::Local::DBIxSimple->connect(@args);

    return $dbix;
}

sub _build_secure_contacts {
    my $self = shift;

    my $src_file = $self->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 { # returns config 'settings' data
    my $self = shift;

    my $lims_config = LIMS::Local::Config->instance; # warn Dumper $lims_config;
    my $settings = $lims_config->{settings};
    # add path_to_app_root (not already in $settings):
    $settings->{path_to_app_root} = $lims_config->{path_to_app_root};
    return $settings;
}

sub _build_template {
    my $self = shift;

    my $t = Template->new({ INCLUDE_PATH => $self->path_to_app_root . '/templates' });
    return $t;
}