package Reporter::DB; use Reporter::SQL::Lib; use Reporter::Class; # provides Moo, Modern::Perl & Data::Printer::p use Try::Tiny; 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; has dbname => ( is => 'ro', isa => String, required => 1 ); # hilis4, test, etc 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 @_ } #------------------------------------------------------------------------------- # 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 = ( # 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; # p $user; return $user || 0; } #------------------------------------------------------------------------------- sub get_reports_for_user { my ($self, $user_id) = @_; my ($sql, @bind) = $self->sql_lib->all_previous_reports($user_id); 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} = \'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 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; my %args = (); $db eq 'test' # return in memory sqlite dbix object ? ( $args{dsn} = 'dbi:SQLite:dbname=:memory:' ) : ( $args{dbname} = $db ); # warn Dumper \%args; my $dbix = Local::DB->dbix(\%args); return $dbix; } 1;