package LIMS::Model::Roles::Query;
use Moose::Role;
use LIMS::Local::QueryLibrary;
use SQL::Abstract::More;
use Data::Dumper;
use IO::All;
has search_fields_map => ( is => 'ro', isa => 'HashRef', lazy_build => 1 );
has relationships_map => ( is => 'ro', isa => 'HashRef', lazy_build => 1 );
has search_constraint => ( is => 'rw', isa => 'HashRef', default => sub { {} });
has sql_lib => ( is => 'ro', isa => 'LIMS::Local::QueryLibrary', lazy_build => 1 );
#-------------------------------------------------------------------------------
sub get_sql_with_constraint {
my $self = shift;
my $entry = shift; # sql lib entry
my $time_column = shift; # to set duration on
my $default_constraint_type = shift || ''; # optional - to override return
# set constraint & constraint_title params:
$self->_set_search_constraints($time_column, $default_constraint_type);
my $constraint = join ' AND ', $self->all_constraints; # list format
my $sql = $self->sql_lib->retr($entry);
$sql =~ s/%CONSTRAINT%/$constraint/; # warn $sql;
return $sql;
}
#-------------------------------------------------------------------------------
sub get_date_constraints { # used by M::Audit methods using date_constratints.tt & not dbix
my $self = shift;
my $time_column = shift; # to set duration on
my $default_constraint_type = shift || ''; # optional - to override return
$self->_set_search_constraints($time_column, $default_constraint_type);
my $constraint = join ' AND ', $self->all_constraints; # list format
return $constraint;
}
#-------------------------------------------------------------------------------
sub get_args_for_requests_count {
my ($self, $search_constraints) = @_; # warn Dumper $search_constraints;
$self->search_constraint($search_constraints);
# require data from these tables:
my @tables = (); # none for count
# format args_for_search:
my $args_for_search = $self->_format_args_for_search(\@tables);
return $args_for_search; # warn Dumper $args_for_search;
}
#-------------------------------------------------------------------------------
sub get_args_for_request_id {
my ($self, $search_constraints) = @_;
$self->search_constraint($search_constraints);
# require data from these tables:
my @tables = qw( patients specimens referrers referral_sources clinical_trials );
# format args_for_search:
my $args_for_search = $self->_format_args_for_search(\@tables);
return $args_for_search; # warn Dumper $self->args_for_search;
}
#-------------------------------------------------------------------------------
# recieves $args hashref with keys 'search_constraints' & 'args_for_search':
sub get_args_for_find_requests {
my ($self, $args) = @_; # warn Dumper $args;
my $search_constraints = $args->{search_constraints}; # $self->debug($search_constraints);
# add $search_constraints to $self for _format_relationships():
$self->search_constraint($search_constraints);
# require data from these tables:
my @tables = qw( patients referrers referral_sources diagnoses status_options);
# format args_for_search:
my @args = (\@tables, $args->{args_for_search});
my $args_for_search = $self->_format_args_for_search(@args);
return $args_for_search; # warn Dumper $self->args_for_search;
}
#-------------------------------------------------------------------------------
# requires keys cols (aref), joins (aref) OR tbl (str), optional where (href),
# sort_by (aref), group_by (aref), order_by (aref), limit (int), offset (int)
sub sqla_query {
my ($self, $args) = @_; # warn Dumper $args;
# always have cols:
my $cols = $args->{cols} || die 'no columns supplied';
my @params = ( -columns => $cols );
# either single table or table joins:
my $from = $args->{joins}
? [ -join => @{ $args->{joins} } ]
: $args->{tbl};
push @params, ( -from => $from );
# optional params where, group_by, order_by, limit, offset:
push @params, ( -$_ => $args->{$_} )
for grep $args->{$_}, qw(where order_by group_by limit offset); # warn Dumper @params;
my ($sql, @bind) = SQL::Abstract::More->new->select(@params); # warn Dumper [$sql,\@bind];
return ($sql, @bind);
}
#-------------------------------------------------------------------------------
# accepts pairs of params & returns them in a format suitable for RDBO::Manager
sub format_query {
my ($self, %params) = @_;
# RBDO::Manager needs query as arrayref of pairs:
return [ %params ];
}
#-------------------------------------------------------------------------------
# accepts arrayref of table_names, returns arrayref of relationship names:
sub get_relationships {
my ($self, $tables) = @_; # arrayref
my $relationships_map = $self->relationships_map;
# get relationship names needed for table joins:
my @relationships = map {
$relationships_map->{$_}->{rel_name}
} grep {
# check entry exists (or rel silently skipped & db gets hit again for missing data):
$relationships_map->{$_} || die "no such entry '$_' in _build_relationships_map()"
} @$tables;
return \@relationships;
}
#-------------------------------------------------------------------------------
# accepts $required_relationships arrayref and optional $args_for_search hashref
# or creates new; adds 'query' arrayref from $self->search_constraints; adds
# 'with_objects' & 'require_objects' arrayrefs if required; returns $args_for_search
sub _format_args_for_search {
my $self = shift;
my $tables = shift; # arrayref
my $args_for_search = shift || {}; # optional (contains limit, sort_by, etc)
my $search_fields_map = $self->search_fields_map; # warn Dumper $search_fields_map;
my $relationships_map = $self->relationships_map;
my $search_constraints = $self->search_constraint; # warn Dumper $search_constraints;
{ # convert $search_constraints hashref format into arrayref for query func:
my @params = %$search_constraints;
# put 'query' into $args_for_search:
$args_for_search->{query} = \@params;
}
# convert $tables array(ref) into a hash to prevent duplicate relationships
# in FIELD block below:
my %tables = map { $_ => 1 } @$tables; # warn Dumper \%tables;
# get any additional table joins required for this query:
FIELD:
foreach my $field (keys %$search_constraints) { # warn $field;
# get table name for 'key' of search_constraints (last_name, unit_number, etc):
my $table_name = $search_fields_map->{$field}
|| next FIELD; # eg request_number, year - don't need additional table joins
$tables{$table_name}++;
} # warn Dumper \%tables;
# create 'with_objects' & 'require_objects' from data in %tables:
foreach my $table (keys %tables) { # keys are unique so tbl only loaded once
my $relationship_data = $relationships_map->{$table} # eg with => 'request_trial'
|| die "no such entry '$table' in _build_relationships_map()";
my $join_type = $relationship_data->{join_type}; # 'with_objects' or 'require_objects'
my $rel_name = $relationship_data->{rel_name}; # eg 'patient_case.patient', etc
# push relationship name onto $args_for_search $join_type key:
push @{ $args_for_search->{$join_type} }, $rel_name;
}
if ( $args_for_search->{with_objects} ) {
# needs multi_many_ok => 1 to silence warnings and nested_joins => 0 for speed:
$args_for_search->{multi_many_ok} = 1;
$args_for_search->{nested_joins} = 0;
} # warn Dumper $args_for_search;
# set default 'order by':
$args_for_search->{sort_by} ||= 'requests.id'; # not supplied in patient merge
return $args_for_search;
}
#-------------------------------------------------------------------------------
sub _build_search_fields_map {
my $self = shift;
# create map of form field => $self->relationships_map name:
my %search_fields_map = (
# field_name # in table
last_name => 'patients',
first_name => 'patients',
dob => 'patients',
nhs_number => 'patients',
unit_number => 'patients',
gender => 'patients',
name => 'referrers',
specimen_id => 'specimens',
patient_id => 'patient_case', # added for HMRN new maligs link
option_name => 'request_options',
trial_id => 'clinical_trials',
trial_number => 'patient_trials',
referral_source_id => 'referral_sources',
parent_code => 'parent_organisations',
external_reference => 'request_external_ref',
# for simple sql query:
clinical_details => 'request_report',
morphology => 'request_report',
comment => 'request_report',
biopsy_site => 'request_report',
gross_description => 'request_report',
sample_code => 'sample_code',
'diagnoses.name' => 'diagnoses',
'referrers.name' => 'referrers', # or could just use 'name' as above
'display_name' => 'referral_sources',
'patients.id' => 'patients',
'unit_number' => 'patient_case',
'screens.description' => 'request_initial_screen',
results_summary => 'results_summary',
trial_name => 'clinical_trials',
foreign_id => 'section_foreign_id',
);
return \%search_fields_map;
}
#-------------------------------------------------------------------------------
# map of relationship names for tables, relative to LIMS::DB::Request:
sub _build_relationships_map {
my $self = shift;
my %relationship_map = (
# table name => join-type / relationship name
# require = 'inner join'; with = 'left outer join'
authorised_reports => {
join_type => 'require_objects',
rel_name => 'authorised_report',
},
clinical_trials => {
join_type => 'with_objects',
rel_name => 'request_trial.trial',
},
diagnoses => {
join_type => 'with_objects',
rel_name => 'request_report.diagnosis',
},
diagnostic_categories => {
join_type => 'with_objects', # changed from diagnosis.icdo3_category.diagnostic_category
rel_name => 'request_report.diagnosis.diagnostic_category',
},
hospital_departments => {
join_type => 'require_objects',
rel_name => 'referrer_department.hospital_department',
},
outreach_pack_dispatches => {
join_type => 'require_objects',
rel_name => 'outreach_request_pack_dispatch',
},
parent_organisations => {
join_type => 'require_objects',
rel_name => 'patient_case.referral_source.parent_organisation',
},
patients => {
join_type => 'require_objects',
rel_name => 'patient_case.patient',
},
patient_case => {
join_type => 'require_objects',
rel_name => 'patient_case',
},
patient_demographics => {
join_type => 'require_objects',
rel_name => 'patient_case.patient.patient_demographic',
},
patient_gps => {
join_type => 'require_objects',
rel_name => 'patient_case.patient.patient_demographic.referrer',
},
patient_notes => {
join_type => 'with_objects',
rel_name => 'patient_case.patient.patient_note',
},
patient_practices => { # patient GP practices
join_type => 'require_objects',
rel_name => 'patient_case.patient.patient_demographic.practice',
},
patient_trials => {
join_type => 'require_objects',
rel_name => 'patient_case.patient.patient_trial',
},
referral_sources => {
join_type => 'require_objects',
rel_name => 'patient_case.referral_source',
},
referrer_departments => {
join_type => 'require_objects',
rel_name => 'referrer_department',
},
referrers => {
join_type => 'require_objects',
rel_name => 'referrer_department.referrer',
},
request_external_ref => {
join_type => 'with_objects',
rel_name => 'request_external_ref',
},
request_general_notes => {
join_type => 'with_objects',
rel_name => 'request_general_note',
},
request_history => {
join_type => 'require_objects',
rel_name => 'request_history',
},
request_history_user => {
join_type => 'require_objects',
rel_name => 'request_history.user',
},
request_initial_screen => {
join_type => 'with_objects',
rel_name => 'request_initial_screen.screen',
},
request_options => {
join_type => 'with_objects',
rel_name => 'request_option.option',
},
request_report => {
join_type => 'require_objects',
rel_name => 'request_report',
},
request_status => {
join_type => 'require_objects',
rel_name => 'request_status.status_option',
},
request_specimens => {
join_type => 'require_objects',
rel_name => 'request_specimen.specimen',
},
request_specimen_detail => {
join_type => 'with_objects',
rel_name => 'request_specimen_detail',
},
results_summary => {
join_type => 'require_objects',
rel_name => 'results_summary',
},
sample_code => { # used by simple sql search only
join_type => 'require_objects',
rel_name => 'request_specimen.specimen',
},
secondary_diagnosis => {
join_type => 'with_objects',
rel_name => 'request_secondary_diagnosis.diagnosis',
},
section_foreign_id => {
join_type => 'with_objects',
rel_name => 'request_lab_section_foreign_id',
},
specimens => {
join_type => 'require_objects',
rel_name => 'request_specimen',
},
status_options => {
join_type => 'require_objects',
rel_name => 'status_option',
},
);
return \%relationship_map;
}
=begin
my $type = $vars->{constraint_type};
my $method = "_build_${type}_sql";
my $sql = $self->$method($vars);
and have sub _build_lastyear_sql { ... } and such
you'll always have a constraint_type and you can dispatch by that,
e.g. simply use it to call a method named "handle_${constraint_type}_query"
the nice thing about dispatching to different methods per constraint type means
you can do things like put them into reusable roles and such
=cut
# sets __PACKAGE__->constraint & __PACKAGE__constraint_title:
sub _set_search_constraints {
my $self = shift;
my $time_column = shift; # warn $time_column;
my $default_constraint_type = shift || ''; # optional - to override return
my $vars = $self->params; # warn Dumper $vars;
my $constraint_type # undef on 1st call, unless default set in model method
= $vars->{constraint_type} || $default_constraint_type || '';
my ($constraint, $title);
# for checkboxes it's safe to examine $constraint_type, for textboxes &
# selects, need to test for defined query param as it's possible to submit an
# empty field, where constraint_type is defined but equivalent param is undef
if ( $constraint_type eq 'all_data' ) {
$constraint = qq!YEAR($time_column) IS NOT NULL!; # ie everything
$title = 'all requests';
}
elsif ( $constraint_type eq 'this_year' ) {
my $this_year = DateTime->now->year;
$constraint = qq!YEAR($time_column) = $this_year!;
$title = 'year ' . $this_year;
}
elsif ( $constraint_type eq 'one_month' ) {
$constraint = qq!$time_column BETWEEN DATE_SUB(CURDATE(), INTERVAL
1 MONTH) AND CURDATE()!;
$title = 'last 1 month';
}
elsif ( $constraint_type eq 'year_since' && $vars->{year} ) { # check var sent
$constraint = qq!YEAR($time_column) >= $vars->{year}!;
$title = 'all from ' . $vars->{year};
}
# textboxes & select fields:
elsif ( my $days = $vars->{days} ) { # $constraint_type eq 'days'
$constraint = qq!$time_column >= DATE_SUB(CURDATE(), INTERVAL $days DAY)!;
$title = 'previous ' . $days . ' days';
}
elsif ( my $year = $vars->{year} ) { # $constraint_type eq 'year'
$constraint = qq!YEAR($time_column) = $year!;
$title = 'year ' . $vars->{year};
}
# need both 'from' & 'to' dates:
elsif ( $vars->{date_from} && $vars->{date_to} ) { # $constraint_type eq 'date_range'
# NB: silently fails if date is invalid:
my $start_date =
ref $vars->{date_from} eq 'DateTime'
? $vars->{date_from}->ymd
: LIMS::Local::Utils::date_to_mysql($vars->{date_from});
my $end_date =
ref $vars->{date_to} eq 'DateTime'
? $vars->{date_to}->ymd
: LIMS::Local::Utils::date_to_mysql($vars->{date_to});
# need to ensure no date conversion error:
if ($start_date && $end_date) {
$constraint = qq!$time_column BETWEEN '$start_date' AND '$end_date'!;
$title = 'dates between ' . $vars->{date_from} . ' & ' . $vars->{date_to};
}
}
# set default to previous calendar year if no form constraint or invalid date:
$constraint ||= qq!$time_column BETWEEN DATE_SUB(CURDATE(), INTERVAL 1 YEAR)
AND CURDATE()!;
$title ||= 'last 365 days';
# set package accessors:
$self->add_constraint($constraint);
$self->constraint_title($title);
}
sub _build_sql_lib {
my $self = shift;
my $cfg = LIMS::Local::Config->instance;
my $path_to_app_root = $cfg->{path_to_app_root}; # warn $path_to_app_root;
my @libs = map {
io( sprintf '%s/src/lib/%s.sql', $path_to_app_root, $_ )->slurp;
} qw(library local chart);
my $sql_lib = new LIMS::Local::QueryLibrary( { lib => \@libs } );
# warn Dumper [$sql_lib->elements]; # array
return $sql_lib;
}
1;
