package Model;
use Git;
use Moo;
use Try::Tiny;
use Path::Tiny;
use Digest::SHA1;
use Data::Printer;
use FindBin qw($RealBin); # warn $RealBin;
use DateTime::Format::MySQL;
use Module::Runtime qw(use_module);
use Email::Sender::Simple qw(sendmail);
use lib '/home/raj/perl-lib';
use Local::Utils;
use Model::DB; # app db methods
# required items for constructor:
has app_config => ( is => 'ro', required => 1 ); # appdir, environment, etc
has db => ( is => 'lazy', builder => sub {
Model::DB->new( app_config => shift->app_config );
});
# BEGIN { $ENV{EMAIL_SENDER_TRANSPORT} ||= 'Test' } # to force test email delivery
my $git = Git->repository(Directory => path($RealBin, '..', '.git')->realpath);
our $VERSION = version(); # warn $VERSION;
sub version { $git->command_oneline('rev-list', 'HEAD', '--count') }
#-------------------------------------------------------------------------------
sub authenticate_user {
my ($self, $params) = @_; # p $params;
my $userId = $params->{userid};
$userId =~ s/\s+//g; # remove any spaces (nhs no)
# userid is email address, nhs_no or combination of 'OUT' prefix + patient.id:
my $key; # for user details db lookup
# try valid email address:
if ( Local::Utils::is_valid_email($userId) ) {
$key = 'email';
} # OUTnn:
elsif ( $userId =~ m!^OUT\d{2,6}$! ) {
$key = 'patient_id';
$userId =~ s/OUT//; # remove prefix
} # NHS number:
elsif ( $userId =~ m!^\d{10}$! ) {
$key = 'nhs_number';
}
return 0 unless $key; # p $userId;
# get user from users table or return:
my $user = $self->db->get_user_details({ $key => $userId }) || return 0; # p $user;
# don't need password authentication for dev env:
unless ( $self->app_config->{environment} eq 'development' ) {
# check SHA1 b64digest 'password' param matches patient_access.password:
my $digest = _sha1_digest($params->{password}); # p $digest;
return 0 unless $user->{password} eq $digest;
# update last_login date:
$self->db->update_last_login($user->{patient_id});
}
return $user;
}
#-------------------------------------------------------------------------------
sub get_outreach_data {
my ($self, $patient_id) = @_; # p $patient_id;
my @data = $self->db->get_pack_dispatches($patient_id);
my %h = ( packs => \@data ); # pack dispatches:
# report available for 1st one with request_status = complete:
for my $req (@data) { # in reverse chronological order so most recent 1st
next unless $req->{request_status} eq 'complete';
# encrypt using todays date for tamper protection:
my $key = Local::Utils::today->ymd;
$h{print_report_token} = Local::Utils::encrypt($req->{id}, $key);
# better to use report date but not available (needs HILIS4 access):
$h{date_registered} = $req->{registered};
last;
}
return \%h;
}
#-------------------------------------------------------------------------------
sub email_patient_demographics {
my ($self, $params, $session) = @_; # p $params; p $session;
my $app_config = $self->app_config;
# set transport object (Mbox, Test, SMTP, TestFail, etc):
=begin # for Mbox, to specify path/to/mbox:
use Email::Sender::Transport::Mbox;
my $transport = Email::Sender::Transport::Mbox->new({
filename => path($app_config->{appdir}, 'logs', 'mbox')->realpath,
});
=cut
=begin # for smtp credentials:
my $cfg = $app_config->{plugins}->{Email}->{headers};
my $transport = Email::Sender::Transport::SMTP->new({
host => 'smtp.hmds.org.uk',
sasl_username => 'ra.jones@hmds.org.uk',
sasl_password => 'testing_invalid', # to trigger failure
});
=cut
my $transport = do {
# TestFail = my Email::Sender::Transport::TestFail package below
my $t = $ENV{MY_EMAIL_SENDER_TRANSPORT} # command-line ENV has priority
|| $params->{email} =~ /fail/ # then web-form 'email' param =~ /fail/
? 'TestFail' # then .yml setting, finally default smtp:
: $app_config->{email_sender_transport} || 'smtp';
my $transport_module = 'Email::Sender::Transport::'.$t;
use_module($transport_module)->new; # p $transport_module;
}; # p $transport; # Email::Sender::Transport object
my $content = do {
# first highlight any changed params:
_highlight_changes($params, $session); # p $params;
join "\n", map { join ': ', $_, $params->{$_} }
qw(first_name last_name dob address email contact_number practice);
};
my $email = Email::Simple->create(
body => $content,
header => [
to => $app_config->{plugins}->{Email}->{headers}->{to},
from => $session->{email},
subject => ( sprintf 'Patient demographic update [%s]',
$session->{nhs_number} ),
],
); # p $email;
my %h = ( msg => 'Thanks for your update, we will do something, maybe' );
try {
sendmail($email, { transport => $transport } );
}
catch { # set errors key, will cause route to return non-success status:
$h{errors} = { sendmail => 'email failed: '.$_->message };
}; # p %h;
return \%h;
}
#-------------------------------------------------------------------------------
sub validate_password {
my ($self, $params, $session) = @_; # p $params; p $session;
my $digest = _sha1_digest($params->{password}); # p $digest;
my %h = (); # return \%h;
unless ( $session->{password} eq $digest ) { # p $session->{password};
$h{errors} = { password => "sorry, your password doesn't match!" };
}
return \%h;
}
#-------------------------------------------------------------------------------
sub gitlog {
my @args = ( '--pretty=format:"%ad :: %s"', '--date=relative' );
my @log = $git->command( 'log', @args );
return \@log;
};
# private subs =================================================================
sub _highlight_changes { # modifies $params hashref - no return expected
my ($params, $session) = @_;
my $highlight = sub { '!!! ' . $_[0] . ' !!!' };
$params->{$_} = &$highlight($params->{$_}) for
grep lc $params->{$_} ne lc $session->{$_},
qw(first_name last_name email contact_number);
$params->{dob} = &$highlight($params->{dob}) if
$params->{dob} ne $session->{dob}->strftime('%d %b %Y');
# address & practice are composited on form:
$params->{address} = &$highlight($params->{address}) if
$params->{address} ne join ', ', @{$session}{qw/address post_code/};
$params->{practice} = &$highlight($params->{practice}) if
$params->{practice} ne join ', ', @{$session}{qw/gp practice/};
return undef;
}
#-------------------------------------------------------------------------------
sub _sha1_digest {
my $str = shift; # p $str;
my $sha1 = Digest::SHA1->new;
$sha1->add($str);
return $sha1->b64digest;
}
=begin # queries handled by Model::SQL now
#-------------------------------------------------------------------------------
sub _query {
my $self = shift;
my ($sql, @bind) = @_; # p $sql; p @bind;
my $data = $self->dbix->query($sql, @bind)->hashes; # p $data;
_autoinflate_dates($data);
# return array, ref to array of hashrefs or single hashref:
return wantarray
? @$data
: @$data > 1
? $data # AoH
: $data->[0]; # href
}
#-------------------------------------------------------------------------------
# if it looks like a MySQL date or date + time, inflate to DateTime object:
sub _autoinflate_dates {
my $data = shift;
my $re = qr!\d{4}-\d{2}-\d{2}(\s\d{2}:\d{2}:\d{2})?!;
my $to_datetime = sub {
my $val = shift // return; # p $val; # must use // or lose $val of zero
return $val if ref $val eq 'DateTime'; # if already a DateTime object
if ( my ($date) = $val =~ m!\A($re)\Z! ) { # p $date;
$val = length $date > 10 # ie date + time
? DateTime::Format::MySQL->parse_datetime($date)
: DateTime::Format::MySQL->parse_date($date);
}
return $val;
};
for my $ref(@$data) {
$ref->{$_} = &$to_datetime($ref->{$_}) for keys %$ref;
}
}
=cut
{
package Email::Sender::Transport::TestFail;
use Data::Printer;
use Moo;
extends 'Email::Sender::Transport::Test';
sub delivery_failure {
my ($self, $email) = @_; # p $email;
return Email::Sender::Failure->new('test delivery failure');
}
no Moo;
1;
}
1;
