f8db6ea1eeb8e378989326626fbe7abcaec31aa5
[Evergreen.git] / Open-ILS / src / perlmods / OpenILS / Application / Storage / FTS.pm
1 use OpenSRF::Utils::Logger qw/:level/;
2 my $log = 'OpenSRF::Utils::Logger';
3
4 #-------------------------------------------------------------------------------
5 package OpenILS::Application::Storage::FTS;
6 use OpenSRF::Utils::Logger qw/:level/;
7 use Parse::RecDescent;
8
9 my $_default_grammar_parser = new Parse::RecDescent ( <<'GRAMMAR' );
10
11 <autotree>
12
13 search_expression: or_expr(s) | and_expr(s) | expr(s)
14 or_expr: lexpr '||' rexpr
15 and_expr: lexpr '&&' rexpr
16 lexpr: expr
17 rexpr: expr
18 expr: phrase(s) | group(s) | word(s)
19 joiner: '||' | '&&'
20 phrase: '"' token(s) '"'
21 group : '(' search_expression ')'
22 word: numeric_range | negative_token | token
23 negative_token: '-' .../\D+/ token
24 token: /[-\w]+/
25 numeric_range: /\d+-\d*/
26
27 GRAMMAR
28
29 sub compile {
30
31         $log->debug("You must override me somewhere, or I will make searching really slow!!!!",ERROR);;
32
33         my $self = shift;
34         my $class = shift;
35         my $term = shift;
36
37         $self = ref($self) || $self;
38         $self = bless {} => $self;
39
40         $self->decompose($term);
41
42         for my $part ( $self->words, $self->phrases ) {
43                 $part = OpenILS::Application::Storage::CDBI->quote($part);
44                 push @{ $self->{ fts_query } },   "'\%$part\%'";
45         }
46
47         for my $part ( $self->nots ) {
48                 $part = OpenILS::Application::Storage::CDBI->quote($part);
49                 push @{ $self->{ fts_query_not } },   "'\%$part\%'";
50         }
51 }
52
53 sub decompose {
54         my $self = shift;
55         my $term = shift;
56         my $parser = shift || $_default_grammar_parser;
57
58         $term =~ s/:/ /go;
59         $term =~ s/\s+--\s+/ /go;
60         $term =~ s/(?:&[^;]+;)//go;
61         $term =~ s/\s+/ /go;
62         $term =~ s/(^|\s+)-(\w+)/$1!$2/go;
63         $term =~ s/\b(\+)(\w+)/$2/go;
64         $term =~ s/^\s*\b(.+)\b\s*$/$1/o;
65         #$term =~ s/^(?:an?|the)\b(.*)/$1/o;
66
67         $log->debug("Stripped search term string is [$term]",DEBUG);
68
69         my $parsetree = $parser->search_expression( $term );
70         my @words = $term =~ /\b((?<!!)\w+)\b/go;
71         my @nots = $term =~ /\b(?<=!)(\w+)\b/go;
72
73         $log->debug("Stripped words are[".join(', ',@words)."]",DEBUG);
74         $log->debug("Stripped nots are[".join(', ',@nots)."]",DEBUG);
75
76         my @parts;
77         while ($term =~ s/ ((?<!\\)"{1}) (.*?) ((?<!\\)"){1} //x) {
78                 my $part = $2;
79                 $part =~ s/^\s*//o;
80                 $part =~ s/\s*$//o;
81                 next unless $part;
82                 push @parts, lc($part);
83         }
84
85         $self->{ fts_op } = 'ILIKE';
86         $self->{ fts_col } = $self->{ text_col } = 'value';
87         $self->{ raw } = $term;
88         $self->{ parsetree } = $parsetree;
89         $self->{ words } = \@words;
90         $self->{ nots } = \@nots;
91         $self->{ phrases } = \@parts;
92
93         return $self;
94 }
95
96 sub fts_query_not {
97         my $self = shift;
98         return wantarray ? @{ $self->{fts_query_not} } : $self->{fts_query_not};
99 }
100
101 sub fts_rank {
102         my $self = shift;
103         return wantarray ? @{ $self->{fts_rank} } : $self->{fts_rank};
104 }
105
106 sub fts_query {
107         my $self = shift;
108         return wantarray ? @{ $self->{fts_query} } : $self->{fts_query};
109 }
110
111 sub raw {
112         my $self = shift;
113         return $self->{raw};
114 }
115
116 sub parse_tree {
117         my $self = shift;
118         return $self->{parsetree};
119 }
120
121 sub fts_col {
122         my $self = shift;
123         return $self->{fts_col};
124 }
125
126 sub text_col {
127         my $self = shift;
128         return $self->{text_col};
129 }
130
131 sub phrases {
132         my $self = shift;
133         return wantarray ? @{ $self->{phrases} } : $self->{phrases};
134 }
135
136 sub words {
137         my $self = shift;
138         return wantarray ? @{ $self->{words} } : $self->{words};
139 }
140
141 sub nots {
142         my $self = shift;
143         return wantarray ? @{ $self->{nots} } : $self->{nots};
144 }
145
146 sub sql_exact_phrase_match {
147         my $self = shift;
148         my $column = $self->text_col;
149         my $output = '';
150         for my $phrase ( $self->phrases ) {
151                 $phrase =~ s/%/\\%/go;
152                 $phrase =~ s/_/\\_/go;
153                 $phrase =~ s/'/\\'/go;
154                 $log->debug("Adding phrase [$phrase] to the match list", DEBUG);
155                 $output .= " AND $column ILIKE '\%$phrase\%'";
156         }
157         $log->debug("Phrase list is [$output]", DEBUG);
158         return $output;
159 }
160
161 sub sql_exact_word_bump {
162         my $self = shift;
163         my $bump = shift || '0.1';
164
165         my $column = $self->text_col;
166         my $output = '';
167         for my $word ( $self->words ) {
168                 $word =~ s/%/\\%/go;
169                 $word =~ s/_/\\_/go;
170                 $word =~ s/'/''/go;
171                 $log->debug("Adding word [$word] to the relevancy bump list", DEBUG);
172                 $output .= " + CASE WHEN $column ILIKE '\%$word\%' THEN $bump ELSE 0 END";
173         }
174         $log->debug("Word bump list is [$output]", DEBUG);
175         return $output;
176 }
177
178 sub sql_where_clause {
179         my $self = shift;
180         my @output;
181
182         for my $fts ( $self->fts_query ) {
183                 push @output, join(' ', $self->fts_col, $self->{fts_op}, $fts);
184         }
185
186         for my $fts ( $self->fts_query_not ) {
187                 push @output, 'NOT (' . join(' ', $self->fts_col, $self->{fts_op}, $fts) . ')';
188         }
189
190         my $phrase_match = $self->sql_exact_phrase_match();
191         return join(' AND ', @output); 
192 }
193
194 #-------------------------------------------------------------------------------
195 use Class::DBI;
196
197 package Class::DBI;
198
199 {
200         no warnings;
201         no strict;
202         sub _do_search {
203                 my ($proto, $search_type, @args) = @_;
204                 my $class = ref $proto || $proto;
205                 
206                 my (@cols, @vals);
207                 my $search_opts = (@args > 1 and ref($args[-1]) eq 'HASH') ? pop @args : {};
208
209                 @args = %{ $args[0] } if ref $args[0] eq "HASH";
210
211                 $search_opts->{offset} = int($search_opts->{page} - 1) * int($search_opts->{page_size})  if ($search_opts->{page_size});
212                 $search_opts->{_placeholder} ||= '?';
213
214                 my @frags;
215                 while (my ($col, $val) = splice @args, 0, 2) {
216                         my $column = $class->find_column($col)
217                                 || (List::Util::first { $_->accessor eq $col } $class->columns)
218                                 || $class->_croak("$col is not a column of $class");
219
220                         if (!defined($val)) {
221                                 push @frags, "$col IS NULL";
222                         } elsif (ref($val) and ref($val) eq 'ARRAY') {
223                                 push @frags, "$col IN (".join(',',map{'?'}@$val).")";
224                                 for my $v (@$val) {
225                                         push @vals, ''.$class->_deflated_column($column, $v);
226                                 }
227                         } else {
228                                 push @frags, "$col $search_type $$search_opts{_placeholder}";
229                                 push @vals, $class->_deflated_column($column, $val);
230                         }
231                 }
232
233                 my $frag = join " AND ", @frags;
234
235                 $frag .= " ORDER BY $search_opts->{order_by}"
236                         if $search_opts->{order_by};
237                 $frag .= " LIMIT $search_opts->{limit}"
238                         if $search_opts->{limit};
239                 $frag .= " OFFSET $search_opts->{offset}"
240                         if ($search_opts->{limit} && defined($search_opts->{offset}));
241
242                 return $class->sth_to_objects($class->sql_Retrieve($frag), \@vals);
243         }
244 }
245
246 1;
247