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;