• Files
• Commits
• Log
• Graph
• Stats

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 Module::Runtime qw(use_module);
use Email::Sender::Simple qw(sendmail);

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;
}

#-------------------------------------------------------------------------------
sub email_patient_demographics {
    my ($self, $params, $session) = @_; # p $params; p $session;

    # first highlight any changed params:
    _highlight_changes($params, $session); # p $params;
    
    my $content = 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      => $self->app_config->{plugins}->{Email}->{headers}->{to},
            from    => $session->{email},
            subject => ( sprintf 'Patient demographic update [%s]',
                $session->{nhs_number} ),
        ],
    ); # p $email;

=begin # 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
=begin # for smtp credentials:
    my $cfg = $self->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 { # set transport object (Mbox, Test, SMTP, etc):
        my $t = $ENV{MY_EMAIL_SENDER_TRANSPORT} # command-line ENV has priority
            || $params->{email} =~ /fail/ # then form 'email' param =~ /fail/
                ? 'TestFail' # then .yml setting, finally default smtp:
                : $self->app_config->{email_sender_transport} || 'smtp';
        my $transport_module = join '::', ( qw/Email Sender Transport/, $t );
        use_module($transport_module)->new; # p $transport_module;
    }; # p $transport; # Email::Sender::Transport object
    
    my %h = ( msg => 'Thanks for your update, we will do something, maybe' );
    try {
        sendmail($email, { transport => $transport } );
    }
    catch {
        $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;
}

# 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
}

#-------------------------------------------------------------------------------
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 0;
}

#-------------------------------------------------------------------------------
# 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

{
    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;