package Model;
use Try::Tiny;
use Path::Tiny;
use SQL::Library;
use DBIx::Simple;
use Digest::SHA1;
use Data::Printer;
use DateTime::Format::MySQL;
use Email::Sender::Simple qw(sendmail);
# use Email::Sender::Transport::SQLite; # if defined in development.yml
use Email::Sender::Transport::Test;
use Email::Sender::Transport::Failable;
use Moo;
# required items for constructor:
has $_ => ( is => 'ro', required => 1 ) for qw(dbh app_config); # appdir, environment, etc
has dbix => ( is => 'lazy', builder => sub { DBIx::Simple->new(shift->dbh) } );
has sql_lib => ( is => 'lazy' ); # _build_sql_lib()
# BEGIN { $ENV{EMAIL_SENDER_TRANSPORT} ||= 'Test' } # to force test email delivery
#-------------------------------------------------------------------------------
sub authenticate_user {
my ($self, $params) = @_; # p $params;
my $sql = $self->sql_lib->retr('user_details'); # p $sql;
# get user from users table using supplied username param, or return:
my $user = $self->_query($sql, $params->{username}) || return 0; # p $user;
# don't need authenticated login 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:
my $now = 'NOW()'; # DateTime->now( time_zone => 'Europe/London' );
$self->dbix->update( 'patient_access',
{ last_login => \$now },
{ patient_id => $user->{patient_id} },
);
return $user;
}
#-------------------------------------------------------------------------------
sub get_outreach_data {
my ($self, $nhs_number) = @_; # p $nhs_number;
my %h;
{ # pack dispatches:
my $sql = $self->sql_lib->retr('pack_dispatches'); # p $sql;
my @data = $self->_query($sql, $nhs_number); # p @data;
$h{packs} = \@data;
}
{ # results:
my $sql = $self->sql_lib->retr('results'); # p $sql;
my @data = $self->_query($sql, $nhs_number); # p @data;
$h{results} = \@data;
}
{ # for demo only - to test for presence of pre-compiled report:
$h{has_report} = -e sprintf '%s/public/reports/%s.htm',
$self->app_config->{appdir}, $nhs_number;
}
return \%h;
}
{
package Email::Sender::Transport::TestFail;
use Moo;
extends 'Email::Sender::Transport::Test';
sub delivery_failure {
my ($self, $email) = @_; p $email;
return Email::Sender::Failure->new('bad sender');
}
no Moo;
1;
}
#-------------------------------------------------------------------------------
sub email_patient_demographics {
my ($self, $params, $session) = @_;
my $content = join "\n", map { join ': ', $_, $params->{$_} }
# make this a bold row & send html
grep $params->{$_} ne $session->{$_}, # skip identical vals
qw(first_name last_name dob address email contact_number practice);
my $email = Email::Simple->create(
body => $content,
header => [
to => $self->app_config->{plugins}->{Email}->{headers}->{to},
from => $session->{email},
subject => ( sprintf 'Patient demographic update [%s]',
$session->{nhs_number} ),
],
); # p $email;
# maybe override default SMTP transport:
if ( my $transport = $self->app_config->{email_sender_transport} ) { # mbox, test, maildir, etc
# allow any command-line ENV setting to take priority, or set from app config:
$ENV{EMAIL_SENDER_TRANSPORT} ||= $transport; # 'Test' for devel
}
=begin # or for Mbox, to specify path/to/mbox:
use Email::Sender::Transport::Mbox;
my $transport = Email::Sender::Transport::Mbox->new({
filename => path($self->app_config->{appdir}, 'logs', 'mbox')->realpath,
});
=cut
my $fail_test = Email::Sender::Transport::TestFail->new;
my %h = ( msg => 'Thanks for your update, we will do something, maybe' );
# try { sendmail->($email) } # { transport => $transport } # arg to sendmail if set
try { $fail_test->send($email); }
catch { $h{errors} => { sendmail => "email failed: $_" } };
if ( lc $self->app_config->{email_sender_transport} eq 'test' ) {
my @deliveries = Email::Sender::Simple->default_transport->deliveries;
p @deliveries;
} # 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;
}
# private subs =================================================================
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;
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;
}
}
#-------------------------------------------------------------------------------
sub _sha1_digest {
my $str = shift; # p $str;
my $sha1 = Digest::SHA1->new;
$sha1->add($str);
return $sha1->b64digest;
}
#-------------------------------------------------------------------------------
sub _build_sql_lib {
my $lib = shift->app_config->{appdir} . '/src/queries.sql';
SQL::Library->new({ lib => $lib });
};
=begin
sub _build_dbix { # warn 'building dbix object';
my $dsn = 'dbi:mysql:database=hilis4;mysql_read_default_file=~/.local/mysql.cnf';
DBIx::Simple->connect($dsn);
}
=cut
1;
