package Reporter::DB;
use Reporter::SQL::Lib;
use Reporter::Class; # provides Moo, Modern::Perl & Data::Printer::p
use Try::Tiny;
# use DBI::Log;
use lib '/home/raj/perl-lib';
use Local::Utils;
use Local::DB;
# switch off auto-date-inflation until all apps date handling updated:
$Local::DBIx::Simple::Result::NO_AUTO_DATE_INFLATION = 1;
# $DBI::Log::trace = 0;
has dbname => ( is => 'ro', isa => String, required => 1 ); # hilis4, test, etc
has config => ( is => 'ro', isa => HashReference, required => 1 ); # app config
has dbix => (
is => 'lazy',
predicate => 1, # so we can call has_dbix
clearer => 1, # to remove object if db connection gone away
); # returns DBIx::Simple object
# in case dbh lost, will need to create new dbix:
after clear_dbix => sub { shift->clear_sql_lib };
has sql_lib => (
is => 'lazy',
builder => sub { Reporter::SQL::Lib->new( dbix => shift->dbix ) },
clearer => 1, # in case dbh lost, don't hold on to broken dbix
);
sub debug { p $_[1] if $_[0]->app_settings->{environment} =~ /^dev/ }
#-------------------------------------------------------------------------------
# check persistent dbix object still has an active db connection, if not then
# clear dbix object - will be re-created on demand when needed for next db query:
sub check_db_connection { # same as check_db_connection() but logs to sdtout:
my $self = shift;
# call has_dbix() 1st in case object hasn't been created yet (dbix is lazy):
if ( $self->has_dbix and not $self->dbix->dbh->ping ) {
$self->clear_dbix;
}
return; # routine has no return value so don't return anything
}
=begin # same as check_db_connection() but writes to stdout:
sub _check_db_connection {
my @log = Local::Utils::time_now . ' checking Reporter db connection:';
my $self = shift; # say $self->has_dbix ? 'have dbix' : 'do not have dbix';
# call has_dbix() 1st in case object hasn't been created yet (dbix is lazy):
# if ( $self->has_dbix and not $self->dbix->dbh->ping ) {
if ( $self->has_dbix ) {
my $id = $self->dbix->dbh->{mysql_thread_id};
push @log, "have dbix object (thread_id=$id), testing ping:";
if (! $self->dbix->dbh->ping ) {
push @log, '*** inactive ping ***, clearing dbix object';
$self->clear_dbix;
}
else { push @log, 'dbh still active' }
}
else { push @log, 'no dbix object' }
debug @log;
return; # routine has no return value so don't return anything
}
=cut
#-------------------------------------------------------------------------------
sub get_user_data {
my ($self, $userid) = @_; # p $userid;
my @cols = qw(id username last_name first_name password);
my %where = ( # ( username = $userid OR email = $userid ):
-or => { username => $userid, email => $userid }
);
my $user = $self->dbix->select('draft_report_users', \@cols, \%where)->hash
# if no user, check HILIS4 users, if present, transfer data to draft_report_user:
|| $self->check_hilis4_users($userid); # p $user;
return $user || 0;
}
#-------------------------------------------------------------------------------
sub check_hilis4_users { # transfers data to draft_report_users if exists in hilis4.users
my ($self, $userid) = @_; # p $userid;
my $dbix = $self->dbix;
my @cols = qw(username last_name first_name email password);
my %where = ( # active = 'yes' AND ( username = $userid OR email = $userid ):
-and => [
{ active => 'yes' },
-or => [ { username => $userid }, { email => $userid } ]
]
);
my $user = $self->dbix->select('users', \@cols, \%where)->hash
|| return 0; # no such HILIS4 user
$dbix->insert('draft_report_users', $user);
return $user;
}
#-------------------------------------------------------------------------------
sub get_report_counts_for_user {
my ($self, $user_id) = @_;
my $i= $self->dbix->count( 'request_draft_report', { user_id => $user_id} ); # p $i;
return $i;
}
#-------------------------------------------------------------------------------
sub get_reports_for_user {
my ($self, $user_id, $args) = @_; # p $user_id; p $args;
my ($sql, @bind) = $self->sql_lib->all_previous_reports($user_id, $args); # p $sql; p \@bind;
my $data = $self->dbix->query($sql, @bind)->hashes; # p $data;
return $data;
}
#-------------------------------------------------------------------------------
sub get_request_data {
my ($self, $request_number, $yr) = @_;
my ($sql, @bind) = $self->sql_lib->request_data($request_number, $yr);
my $data = $self->dbix->query($sql, @bind)->hash; # p $data;
return $data;
}
#-------------------------------------------------------------------------------
sub get_report_data {
my ($self, $request_id, $user_id) = @_;
my %where = ( request_id => $request_id, user_id => $user_id );
my ($sql, @bind) = $self->sql_lib->report_data(\%where);
my $data = $self->dbix->query($sql, @bind)->hash; # p $data;
return $data;
}
#-------------------------------------------------------------------------------
sub get_lab_number {
my ($self, $request_id) = @_; # p $request_id;
my @cols = qw( request_number year );
$self->dbix->select('requests', \@cols, { id => $request_id } )
->into( my ($request_number, $year) );
return sprintf '%s/%02d', $request_number, $year - 2000;
}
#-------------------------------------------------------------------------------
sub get_previous_requests {
my ($self, $request_id, $nhs_number) = @_; # p $request_id;
return 0 if not $nhs_number; # not attempting to match previous otherwise
my @cols = qw( id request_number year diagnosis auth_date );
my %where = (
id => { '<' => $request_id },
nhs_number => $nhs_number,
);
my @sort = ( qw/year request_number/ );
my $data = $self->dbix->select(
'authorised_reports_view', \@cols, \%where, \@sort )->hashes;
return $data;
}
#-------------------------------------------------------------------------------
sub save_report {
my ($self, $data) = @_;
my $dbix = $self->dbix;
my $tbl = 'request_draft_report';
my %where = map +($_ => $data->{$_}), qw(request_id user_id);
$data->{updated_at} = DateTime->now(); # sqlite can't handle \'NOW()'
my %result = ( success => 0 ); # default fails, updated below:
if ( $dbix->select( $tbl, 1, \%where )->list ) { # exists so update:
try { $dbix->update( $tbl, $data, \%where ) }
catch { # p $_; # DBD::mysql::st execute failed ....
$result{error} = "error updating $tbl table = " . $dbix->error;
}
finally {
$result{success} = 1 unless @_;
};
$result{action} = 'update_record';
}
else { # create new record:
try { $dbix->insert( $tbl, $data ) }
catch { # p $_; # DBD::mysql::st execute failed ....
$result{error} = "error saving to $tbl table = " . $dbix->error;
}
finally {
$result{success} = 1 unless @_;
};
$result{action} = 'create_record';
}
return \%result;
}
#-------------------------------------------------------------------------------
sub register_user {
my ($self, $data) = @_;
my $dbix = $self->dbix;
my $tbl = $self->config->{environment} eq 'development'
? 'test.draft_report_users'
: 'draft_report_users';
my %result = ( success => 0 ); # default fails, updated below:
try { $dbix->insert( $tbl, $data ) }
catch { # p $_; # DBD::mysql::st execute failed ....
$result{error} = "error saving to $tbl table = " . $dbix->error;
}
finally {
$result{success} = 1 unless @_;
};
return \%result;
}
#-------------------------------------------------------------------------------
sub get_result_summaries {
my ($self, $request_id) = @_;
my ($sql, @bind) = $self->sql_lib->result_summaries($request_id);
my $data = $self->dbix->query($sql, @bind)->hashes; # p $data;
return $data;
}
#-------------------------------------------------------------------------------
sub get_lab_test_results {
my ($self, $request_id) = @_;
my ($sql, @bind) = $self->sql_lib->lab_test_results($request_id);
my $data = $self->dbix->query($sql, @bind)->hashes; # p $data;
my %h;
for my $ref (@$data) {
my ($section, $test) = map $ref->{$_}, qw(section test); # p $section; p $test;
$h{$section}{$test} = $ref->{result};
}
return \%h;
}
#-------------------------------------------------------------------------------
sub get_diagnoses {
my ($self, $str) = @_; # p $str;
my ($sql, @bind) = $self->sql_lib->get_diagnoses($str);
my $data = $self->dbix->query($sql, @bind)->hashes; # p $data;
return $data;
}
#-------------------------------------------------------------------------------
sub _build_dbix { # say 'building dbix object';
my $self = shift;
my $db = $self->dbname; # warn $db;
my %args = ();
$db eq 'test' # return in memory sqlite dbix object
? ( $args{dsn} = 'dbi:SQLite:dbname=:memory:' )
: ( $args{dbname} = $db, $args{log_query} = 1 ); # warn Dumper \%args;
my $dbix = Local::DB->dbix(\%args);
return $dbix;
}
1;
