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;