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', 'patient_notes.detail' => 'patient_notes', results_summary => 'results_summary', trial_name => 'clinical_trials', foreign_id => 'section_foreign_id', vialId => 'request_storage', 'request_general_notes.detail' => 'request_general_notes', ); 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_storage => { join_type => 'require_objects', rel_name => 'request_storage', }, 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;