• Files
• Commits
• Log
• Graph
• Stats

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::DB;

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

has sql_lib => (
    is => 'lazy',
    builder => sub { Reporter::SQL::Lib->new( dbix => shift->dbix ) }
);

#-------------------------------------------------------------------------------
# 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 { # say 'checking 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 ) {
        warn 'dbh has gone away, clearing dbix object for recreation';
        $self->clear_dbix;
    }
    return; # routine has no return value so don't return anything
}

#-------------------------------------------------------------------------------
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; # dbname = test, hilis4, etc

    my $dbix = ( $db eq 'test' ) # return in memory sqlite dbix object
        ? Local::DB->dbix({ dsn => 'dbi:SQLite:dbname=:memory:' })
        : Local::DB->dbix($db);
    return $dbix;
}

1;