package Reporter::SQL::Lib; use SQL::Abstract::More; # extends SQL::Abstract to support joins use Reporter::Class; # provides Moo, Modern::Perl & Data::Printer::p use lib '/home/raj/perl-lib'; use Local::QueryLibrary; has sql_abs => ( is => 'lazy', builder => sub { SQL::Abstract::More->new } ); has sql_lib => ( is => 'lazy', builder => sub { Local::QueryLibrary->new } ); has dbix => ( is => 'ro', required => 1 ); # for get_table_col lookups #------------------------------------------------------------------------------- sub request_data { my ($self, $request_number, $yr) = @_; my @cols = ( qw/ r.id r.request_number r.year r.created_at|registered p.last_name p.first_name p.nhs_number p.dob rs.display_name|location /, 'group_concat(s.sample_code order by s.sample_code)|specimen', ); # p @cols; # SQL::Abstract::More join (rr & d = left joins, unused but retained for syntax): my @joins = ( # table|alias # FK-PK relationship qw/ requests|r r.patient_case_id=pc.id patient_case|pc pc.patient_id=p.id patients|p pc.referral_source_id=rs.id referral_sources|rs =>{rr.request_id=r.id} request_report_view|rr =>{rr.diagnosis_id=d.id} diagnoses|d rs2.request_id=r.id request_specimen|rs2 rs2.specimen_id=s.id specimens|s / ); my %where = ( 'r.request_number' => $request_number, 'r.year' => $yr + 2000, ); my ($sql, @bind) = $self->create_query(\@cols, \@joins, \%where); return ($sql, @bind); } #------------------------------------------------------------------------------- sub report_data { my ($self, $where) = @_; # p $where; # request_id & user_id - pass straight through my @cols = ( $self->get_table_cols( request_draft_report => 'r' ), # tbl|alias 'd1.name|diagnosis', 'd2.name|secondary_diagnosis', ); # p @cols; my @joins = qw( request_draft_report|r r.diagnosis_id=d1.id diagnoses|d1 =>{r.secondary_diagnosis_id=d2.id} diagnoses|d2 ); my ($sql, @bind) = $self->create_query(\@cols, \@joins, $where); return ($sql, @bind); } #------------------------------------------------------------------------------- sub get_diagnoses { my ($self, $str) = @_; # p $str; my @cols = qw( id name|diagnosis icdo3 ); my @joins = 'diagnoses|d'; # still works OK with single table my %expr = $self->dbix->dbh->{Name} =~ qr/:memory:/ # sqlite ? ( like => '%'.$str.'%' ) : ( rlike => $str ); my %where = ( name => \%expr ); my ($sql, @bind) = $self->create_query(\@cols, \@joins, \%where); return ($sql, @bind); } #------------------------------------------------------------------------------- sub result_summaries { my ($self, $request_id) = @_; # p $request_id; my @cols = qw( ls.section_name rrs.results_summary ); my @joins = qw( request_result_summaries|rrs rrs.lab_section_id=ls.id lab_sections|ls ); my %where = ( 'rrs.request_id' => $request_id ); my ($sql, @bind) = $self->create_query(\@cols, \@joins, \%where); return ($sql, @bind); } #------------------------------------------------------------------------------- sub all_previous_reports { my ($self, $user_id, $args) = @_; # p $user_id; p $args; $args ||= {}; # needs to exist to add group_by my @cols = qw( r.request_number r.year d.name|diagnosis rrd.created_at ); # sqlite doesn't support ordering of grouped data: push @cols, ( $self->dbix->dbh->{Name} =~ qr/:memory:/ ) ? 'group_concat(s.sample_code)|specimen' : 'group_concat(s.sample_code order by s.sample_code)|specimen'; my @joins = ( # tbl|alias # FK-PK relationship 'requests|r', 'r.id=rrd.request_id', 'request_draft_report|rrd', 'rrd.diagnosis_id=d.id', 'diagnoses|d', 'rs2.request_id=r.id', 'request_specimen|rs2', 'rs2.specimen_id=s.id', 'specimens|s' ); my %where = ( 'rrd.user_id' => $user_id ); my @sort_by = qw( rrd.created_at r.year r.request_number ); $args->{group_by} = 'r.id'; my ($sql, @bind) = $self->create_query(\@cols, \@joins, \%where, \@sort_by, $args); return ($sql, @bind); } #------------------------------------------------------------------------------- sub lab_test_results { my ($self, $request_id) = @_; # p $request_id; my @cols = qw( ls.section_name|section lt.field_label|test ltr.result ); my @joins = qw( request_lab_test_results|ltr ltr.lab_test_id=lt.id lab_tests|lt lt.lab_section_id=ls.id lab_sections|ls ); my %where = ( 'ltr.request_id' => $request_id ); my ($sql, @bind) = $self->create_query(\@cols, \@joins, \%where); return ($sql, @bind); } #------------------------------------------------------------------------------- sub create_query { # aref, aref, href, optional aref, optional href (limit & offset) my ($self, $cols, $joins, $where, $sort_by, $args) = @_; my @params = ( -columns => $cols, -from => [ -join => @$joins ], -where => $where, -order_by => $sort_by || [], ); push @params, ( -$_ => $args->{$_} ) for grep $args->{$_}, qw(limit offset group_by); # p \@params; my ($sql, @bind) = $self->sql_abs->select(@params); # p $sql; p \@bind; return ($sql, @bind); } #------------------------------------------------------------------------------- sub get_table_cols { my ($self, $table, $prefix) = @_; # str, optional str my @cols = map { # use prefix if supplied: $prefix ? ( join '.', $prefix, $_->{field} ) : $_->{field}; } $self->dbix->query('show columns from ' . $table)->hashes; # p @cols; return wantarray ? @cols : \@cols; # return array unless called as scalar } 1;