• Files
• Commits
• Log
• Graph
• Stats

package Reporter::Model;

use Reporter::Validator; # Data::FormValidator class
use Reporter::Class; # provides Moo, Clone, Modern::Perl, Local::MooX::Types & Data::Printer::p
use Reporter::DB;

has dbname  => ( is => 'ro', isa => String, required => 1 ); # hilis4, test, etc
has config  => ( is => 'ro', isa => HashReference, required => 1 ); # app config
has cache   => ( is => 'rw', isa => HashReference, default => sub { {} } );

has db => (
    is => 'lazy',
    builder => sub { Reporter::DB->new( dbname => shift->dbname ) },
    handles => [ 'check_db_connection' ], # to check db handle still connected
);

has validator => ( # Data::FormValidator
    is => 'lazy',
    builder => sub { Reporter::Validator->new },
);

use Digest::SHA1;
use DateTime::Format::MySQL;
# use Lingua::EN::Numbers qw(num2en_ordinal);

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

    my $userid = $params->{userid}; # username or email addr
    my $passwd = $params->{password};

    if ( my $user = $self->db->get_user_data($userid) ) { # p $user; p $digest;
        return $user if $self->config->{environment} eq 'development'; # don't need pwd

        my $digest = _sha1_digest($passwd); # p $digest;
        return $user if $user->{password} eq $digest;
    }
    # either no user retrieved by username or passwd, or passwd incorrect:
    return 0;
}

#-------------------------------------------------------------------------------
sub load_request {
    my ($self, $args) = @_; # p $args;

    my ($lab_number, $user_id) = map $args->{$_}, qw(lab_number user_id);

    # split lab_number into request_number & yr:
    my ($request_number, $yr) = $lab_number =~ m!(\d+)/(\d{2})!;

    # request data:
    my $request = $self->db->get_request_data($request_number, $yr); # p $request;
    my $request_id = $request->{id} || return 0; # in case request not found

    { # section result summaries:
        my $data = $self->db->get_result_summaries($request_id); # p $data;
        $request->{result_summaries} = $data;
    }
    { # lab test results:
        my $data = $self->db->get_lab_test_results($request_id); # p $data;
        $request->{test_results} = $data;
    }
    { # previous cases:
        my $nhs_number = $request->{nhs_number}; # will return empty if undef:
        my $previous = $self->db->get_previous_requests($request_id, $nhs_number);
        if ($previous) { # p $previous;
            $_->{auth_date} = $self->to_datetime($_->{auth_date}) for @$previous;
            $request->{previous_requests} = $previous;
        }
    }
    { # previous draft report by same user:
        my $data = $self->db->get_report_data($request_id, $user_id); # p $data;
        $data->{$_} = $self->to_datetime($data->{$_})
            for qw(created_at updated_at);
        $request->{report} = $data;
    }
    # dates to datetime:
    $request->{$_} = $self->to_datetime($request->{$_}) for qw(registered dob);
    # store for later use:
    $self->cache( { request_data => $request } );
    return $request;
}

#-------------------------------------------------------------------------------
sub get_validation_profile {
    my ($self, $profile_name) = @_; # p $profile_name;
    # clone DFV profile otherwise changes affect original profiles hashref:
    my $profile = clone $self->validator->profiles->{$profile_name}; # p $profile;

    if ( $profile_name eq 'report' ) { # possibly add new required fields:
        my $required_fields = $profile->{required}; # p $required_fields; # arrayref
        my $request_data    = $self->cache->{request_data}; # p $request_data;
        my $specimen        = $request_data->{specimen};

        my %re = (
            fixed_or_trephine => qr{BMAT|[DGLRXT]([BS][LP]|F|U)},
            histology_type    => qr{[DGLRX]([BS]L|F|U)},
        );

        push @$required_fields, 'biopsy_site'
            if $specimen =~ /$re{histology_type}/;
        push @$required_fields, 'gross_description'
            if $specimen =~ /$re{fixed_or_trephine}/;
    } # p $profile;
    return $profile;
}

#-------------------------------------------------------------------------------
sub get_reports_for_user {
    my ($self, $user_id) = @_; # p $user_id;

    my $data = $self->db->get_reports_for_user($user_id); # p $data;
    $_->{created_at} = $self->to_datetime($_->{created_at}) for @$data;
    return $data;
}

#-------------------------------------------------------------------------------
sub save_report {
    my ($self, $data) = @_; # p $data;

    my $result = $self->db->save_report($data); # p $result;
    { # construct msg for tt (displayed if no error from insert/update):
        my $action = $result->{action};
        my %msgs = (
            create_record => 'new record created successfully',
            update_record => 'record updated successfully',
        ); # p $msgs{$action};
        $result->{message} = $msgs{$action} || 'unknown action';
    }
    return $result;  # hashref of keys success, message & optional error
}

#-------------------------------------------------------------------------------
sub get_diagnoses {
    my ($self, $str) = @_; # p $str;
	return 0 unless length $str >= 3; # causes db error if undef

    my $data = $self->db->get_diagnoses($str); # p $data;
    return $data;
}

#-------------------------------------------------------------------------------
sub get_lab_number { shift->db->get_lab_number(@_) }

#-------------------------------------------------------------------------------
sub num2ordinal { num2en_ordinal($_[1]) }

#-------------------------------------------------------------------------------
sub to_datetime {
    my $self = shift;
    my $date = shift || return;

    return $date =~ /\d{2}:\d{2}:\d{2}$/ # time
        ? DateTime::Format::MySQL->parse_datetime($date)
        : DateTime::Format::MySQL->parse_date($date);
}

#-------------------------------------------------------------------------------
sub _sha1_digest {
	my $str = shift; # warn $str;

    my $sha1 = Digest::SHA1->new;
    $sha1->add($str);

    return $sha1->b64digest;
}

1;