package LIMS::Local::Search; use LIMS::Local::Utils (); use LIMS::Local::Config; use DateTime; DateTime->DefaultLocale('en_GB'); # set default locale use Log::Log4perl qw(:easy); use Sphinx::Search; use Data::Dumper; use Moose; use namespace::clean -except => 'meta'; has query => ( is => 'ro', isa => 'HashRef', default => sub { {} }, traits => ['Hash'], handles => { set_query => 'set' }, ); has user_profile => ( is => 'rw', isa => 'HashRef', required => 1 ); # needs to be writable (_process_sql_simple_search() needs to delete keys): has form_fields => ( is => 'ro', isa => 'HashRef', required => 1 ); has lims_config => ( is => 'ro', isa => 'HashRef', lazy_build => 1 ); __PACKAGE__->meta->make_immutable; Log::Log4perl->easy_init($INFO); #------------------------------------------------------------------------------- sub generate_query { my $self = shift; my $params = $self->form_fields; # warn Dumper $params; my $profile = $self->user_profile; # warn Dumper $profile; my $dt = sub { LIMS::Local::Utils::to_datetime_using_parsedate(@_) }; # returns 0 if no date my @date_fields = qw(day month year); # process sql_simple_search params if supplied: if ( my $field = $params->{sql_simple_search} ) { $self->_process_sql_simple_search($field); } # first deal with date constraints and reformat date fields: { # requests.created_at & constraints upon; don't use elsif's to ensure all # 'invalid'; successive 'created_at' will clobber any previous: if ( grep $params->{$_}, map 'request_'.$_, @date_fields ) { # create date as DT object: my %dmy = map { $_ => $params->{'request_'.$_} } @date_fields; my $date = DateTime->new(%dmy); # warn Dumper $date->ymd; # if all_before or all_after flags set: if ( my $extend_date = $params->{date_extend} ) { my $expr = $extend_date eq 'all_after' ? { ge => $date->ymd } # ie 00:00:00 : { le => $date->add(days => 1)->ymd }; # ie 00:00:00 $self->set_query( created_at => $expr ); } else { # need to create a 'between' to handle timestamp field: my @dates = ( $date->ymd, $date->clone->add(days => 1)->ymd ); $self->set_query( created_at => { ge_le => \@dates } ); } } # previous number of days: if ( my $n = $params->{previous_days} ) { my $date = LIMS::Local::Utils::time_now->subtract(days => $n); $self->set_query( created_at => { ge => $date->ymd } ); } # specific year: if ( my $yr = $params->{specific_year} ) { # $self->set_query( year => $yr ); # need to use created_at: my @dates = ( &$dt("1/1/$yr"), &$dt("31/12/$yr")->add(days => 1) ); $self->set_query( created_at => { ge_le => \@dates } ); } # date_from +/- date_to: if ( grep $params->{$_}, qw(date_from date_to) ) { # don't mix with 'date_extend' param my $from = &$dt($params->{date_from}) || &$dt('1/1/2000'); # any valid date before start my $to = &$dt($params->{date_to}) || LIMS::Local::Utils::today(); my @dates = ( $from->ymd, $to->add(days => 1)->ymd ); # ie to 00:00:00 on next day $self->set_query( created_at => { ge_le => \@dates } ); } } { # DoB: if ( grep $params->{$_}, map 'dob_'.$_, @date_fields ) { # create dob as DT object: my %dmy = map { $_ => $params->{'dob_'.$_} } @date_fields; # warn Dumper \%dmy; my $dob = DateTime->new(%dmy); # warn Dumper $dob->ymd; $self->set_query( dob => $dob ); } } # list of now-redundant entries in %params list not corresponding to table cols: my @skip_params = ( qw( previous_days specific_year date_extend date_from date_to ), ( map 'request_' . $_, @date_fields ), ( map 'dob_' . $_, @date_fields ), ); # warn Dumper \@skip_params; while ( my($field_name, $search_term) = each %$params ) { # skip redundant and/or empty form params: next if (! $search_term ) || ( grep $_ eq $field_name, @skip_params ); # referrer name search: if ( $field_name eq 'referrer_name' ) { # converts comma/spaces to single space for GP's & clinicians format: $search_term =~ s/[\,\s]+/ /; $self->set_query( 'referrers.name' => { like => $search_term . '%' } ); } # first_name/last_name/name search: elsif ( $field_name =~ /name\Z/ ) { # \A(first|last)_name\Z # enable 'like' queries on names: $self->set_query( $field_name => { like => $search_term . '%' } ); } # lab_number search: elsif ( $field_name eq 'lab_number' ) { my ($request_number, $year) = LIMS::Local::Utils::split_labno( $search_term ); $self->set_query( request_number => $request_number ); $self->set_query( year => $year ); } # nhs_number search: elsif ( $field_name eq 'nhs_number' ) { # collapse spaces if submitted in nnn nnn nnnn format: $search_term =~ s/\s+//g; $self->set_query( nhs_number => $search_term ); } # request options: elsif ( grep $field_name eq $_, qw(private urgent copy_to) ) { $self->set_query( option_name => $field_name ); } # wildcard search: elsif ( $search_term =~ /[\%\*]/ ) { # substitute * for sql wildcard: $search_term =~ s/\*/\%/; $self->set_query( $field_name => { like => $search_term } ); } # everything else: else { $self->set_query( $field_name => $search_term ); } } # if user is external to local network, are they restricted to own records? # ( skip if lab-staff or part of local_network ): unless ( $profile->{is_local_network} || $self->_is_lab_staff ) { my $cfg = $self->lims_config; if ( $cfg->{settings}->{local_network_restriction} ) { # if users restricted: my $parent_code = $profile->{user_location}->{region_code}; # warn 'HERE'; # only include records from users parent organisation: $self->set_query( parent_code => $parent_code ); } } return $self->query; } #------------------------------------------------------------------------------- sub _process_sql_simple_search { my ($self, $search_field) = @_; my $params = $self->form_fields; my $logic = $params->{logic}; # MATCHES, CONTAINS, LACKS, etc my $search_term = $params->{kwd}; # warn Dumper [$search_field, $logic, $search_term]; =begin # TODO - could allow AND / OR in search term (need to ensure rels load for AND): foo => { like => [ '%bar%', '%baz%' ] }, # foo LIKE '%bar%' OR foo LIKE '%baz% and => [ foo => { like => 'bar' }, foo => { like => 'baz'} ], # foo LIKE '%bar%' AND foo LIKE '%baz% =cut my $constraints_map = { BEGINS => { like => $search_term . '%' }, ENDS => { like => '%' . $search_term }, CONTAINS => { like => '%' . $search_term . '%' }, LACKS => { 'not like' => '%' . $search_term . '%' }, MATCHES => $search_term, }; # get constraint expression for required logic: my $query_constraint = $constraints_map->{$logic}; #=============================================================================== # Sphinx search for full-text (comment, clinical_details, gross_desc + CONTAINS) my @full_text = qw( comment results_summary clinical_details ); # index names MUST match sphinx if ( $logic eq 'CONTAINS' && grep $search_field eq $_, @full_text ) { my $result = $self->_sphinx_search($search_term, $search_field); # warn Dumper $result; if ($result) { # array of request ID's, or hashref { eq => undef } $search_field = 'id'; # request.id $query_constraint = $result; } } #=============================================================================== $self->set_query( $search_field => $query_constraint ); # delete these keys so generate_query() doesn't choke on them: map { delete $params->{$_} } qw(sql_simple_search logic kwd); } #------------------------------------------------------------------------------- sub _is_lab_staff { # don't have access to LIMS::Base::is_lab_staff my $self = shift; my $profile = $self->user_profile; my $config = $self->lims_config; # warn Dumper $config; my $location_name = $profile->{user_location}->{location_name}; # warn Dumper [$lab_name_abbr, $location_name]; if ( my $central_labs = $config->{settings}->{central_labs} ) { # genomics my @labs = split ',', $central_labs; # warn Dumper \@labs; return ( grep $location_name eq $_, @labs ); } my $lab_name_abbr = $config->{settings}->{lab_name_abbreviation}; return ( $lab_name_abbr eq $location_name ); } #------------------------------------------------------------------------------- sub _sphinx_search { my $self = shift; my ($phrase, $index) = @_; # warn Dumper [$phrase, $index]; # need to switch on in config file: return 0 unless $self->lims_config->{settings}->{have_sphinx_search}; my %h = (); # logging generates uninitialized warnings, so only for devel: $h{log} = Log::Log4perl->get_logger('sphinx.search') if $ENV{DEVEL_SERVER}; my $sph = Sphinx::Search->new(\%h); $sph->SetMatchMode(SPH_MATCH_ALL); $sph->SetLimits(0, 1001); my $results = $sph->Query($phrase, $index) || die $sph->GetLastError; # warn Dumper $results; my $count = $results->{total_found}; # if $result exists total_found is INT or 0 # Sphinx limits max count to max_matches in searchd section of .conf if ( $count < 1000 ) { # warn $count; # to trigger "too many" response in caller if > 1K my $matches = $results->{matches}; # get array of request IDs my @request_ids = map { $_->{doc} } @$matches; # warn Dumper \@request_ids; return @request_ids ? \@request_ids : { eq => undef }; # request.id IS NULL - will match 0 hits } return 0; } sub _build_lims_config { LIMS::Local::Config->instance } 1;