package LIMS::Local::ScriptHelpers;
#-------------------------------------------------------------------------------
# provides dbix, sql_lib, lims_config & template objects to stand-alone scripts
#-------------------------------------------------------------------------------
use Moose;
with 'LIMS::Local::Role::DiagnosisAlert';
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 LIMS::Local::Utils;
use LIMS::Model::Email;
use LIMS::Local::Config;
use LIMS::Local::QueryLibrary; # patched version of SQL::Library
# 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 get_email_address {
my ($self, $username) = @_;
my $sql = 'select email from users where username = ?';
my $email = $self->dbix->query($sql, $username)->list;
return $email;
}
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});
$ftp->quit;
return $ftp->message if $ftp->message;
}
sub get_contacts {
my $src_file = "$PATH_TO_APP_ROOT/script/crons/lib/contacts.lib";
my $contacts = Config::Auto::parse($src_file);
return $contacts;
}
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 $secure_contacts = $self->get_contacts();
my $JUST_TESTING = $self->test_only(); # warn $JUST_TESTING;
RECIPIENT:
foreach my $recipient (@$recipients) {
my $email =
$recipient =~ /\.secure\Z/ # require nhs.net address
? $secure_contacts->{$recipient}
: $self->get_email_address($recipient);
$email or next RECIPIENT; # in case doesn't exist
next RECIPIENT if ( $JUST_TESTING && $email !~ /ra\.jones/ );
$mail->{recipient} = $email; # warn Dumper $mail->{recipient}; next;
$mail->{attachment}
? $self->send_attachment($mail)
: $self->send_message($mail);
}
}
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};
}
}
sub send_message{
my ($self, $mail) = @_;
my $filename = $self->script_filename;
my $rtn = LIMS::Model::Email->send_message($mail);
if ($rtn) {
print "$filename reports " . $rtn;
warn "$filename error: " . $rtn;
}
else {
my $email = $mail->{recipient};
print "$filename reports message sent to $email\n";
}
}
sub mail_admin {
my ($self, $args) = @_;
my $cfg = $self->config;
my $subject = 'Error message from ' . $args->{script};
my %mail = (
settings => $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 script_filename {
my $self = shift;
my $script = $PATH_TO_APP_ROOT . $0; # warn $script;
return io($script)->filename;
}
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_config {
my $self = shift;
my $config = LIMS::Local::Config->instance;
my $settings = $config->{settings};
#my $config = Config::Tiny->read("$PATH_TO_APP_ROOT/config/settings.txt"); # $self->debug($config);
#my %settings = map %{ $config->{$_} }, qw(local global); # warn Data::Dumper::Dumper \%settings;
return $settings;
}
sub _build_template {
my $self = shift;
my $t = Template->new({ INCLUDE_PATH => "$PATH_TO_APP_ROOT/templates" });
return $t;
}
