Acq: in acquistions unified search, make timestamp fields searchable
[working/Evergreen.git] / Open-ILS / src / perlmods / OpenILS / Application / Acq / Search.pm
1 package OpenILS::Application::Acq::Search;
2 use base "OpenILS::Application";
3
4 use strict;
5 use warnings;
6
7 use OpenILS::Event;
8 use OpenILS::Utils::CStoreEditor q/:funcs/;
9 use OpenILS::Utils::Fieldmapper;
10 use OpenILS::Application::Acq::Lineitem;
11 use OpenILS::Application::Acq::Financials;
12 use OpenILS::Application::Acq::Picklist;
13
14 my %RETRIEVERS = (
15     "lineitem" =>
16         \&{"OpenILS::Application::Acq::Lineitem::retrieve_lineitem_impl"},
17     "picklist" =>
18         \&{"OpenILS::Application::Acq::Picklist::retrieve_picklist_impl"},
19     "purchase_order" => \&{
20         "OpenILS::Application::Acq::Financials::retrieve_purchase_order_impl"
21     }
22 );
23
24 sub F { $Fieldmapper::fieldmap->{"Fieldmapper::" . $_[0]}; }
25
26 # This subroutine returns 1 if the argument is a) a scalar OR
27 # b) an array of ONLY scalars. Otherwise it returns 0.
28 sub check_1d_max {
29     my ($o) = @_;
30     return 1 unless ref $o;
31     if (ref($o) eq "ARRAY") {
32         foreach (@$o) { return 0 if ref $_; }
33         return 1;
34     }
35     0;
36 }
37
38 # Returns 1 if and only if argument is an array of exactly two scalars.
39 sub could_be_range {
40     my ($o) = @_;
41     if (ref $o eq "ARRAY") {
42         return 1 if (scalar(@$o) == 2 && (!ref $o->[0] && !ref $o->[1]));
43     }
44     0;
45 }
46
47 sub castdate { +{"=" => {"transform" => "date", "value" => $_[0]}}; }
48
49 sub prepare_acqlia_search_and {
50     my ($acqlia) = @_;
51
52     my @phrases = ();
53     foreach my $unit (@{$acqlia}) {
54         my $subquery = {
55             "select" => {"acqlia" => ["id"]},
56             "from" => "acqlia",
57             "where" => {"-and" => [{"lineitem" => {"=" => {"+jub" => "id"}}}]}
58         };
59
60         # castdate not supported for acqlia fields: they're all type text
61         my ($k, $v, $fuzzy, $between, $not) = breakdown_term($unit);
62         my $point = $subquery->{"where"}->{"-and"};
63         my $term_clause;
64
65         push @$point, {"definition" => $k};
66
67         if ($fuzzy and not ref $v) {
68             push @$point, {"attr_value" => {"ilike" => "%" . $v . "%"}};
69         } elsif ($between and could_be_range($v)) {
70             push @$point, {"attr_value" => {"between" => $v}};
71         } elsif (check_1d_max($v)) {
72             push @$point, {"attr_value" => $v};
73         } else {
74             next;
75         }
76
77         my $operator = $not ? "-not-exists" : "-exists";
78         push @phrases, {$operator => $subquery};
79     }
80     @phrases;
81 }
82
83 sub prepare_acqlia_search_or {
84     my ($acqlia) = @_;
85
86     my $point = [];
87     my $result = {"+acqlia" => {"-or" => $point}};
88
89     foreach my $unit (@$acqlia) {
90         # castdate not supported for acqlia fields: they're all type text
91         my ($k, $v, $fuzzy, $between, $not) = breakdown_term($unit);
92         my $term_clause;
93         if ($fuzzy and not ref $v) {
94             $term_clause = {
95                 "-and" => {
96                     "definition" => $k,
97                     "attr_value" => {"ilike" => "%" . $v . "%"}
98                 }
99             };
100         } elsif ($between and could_be_range($v)) {
101             $term_clause = {
102                 "-and" => {
103                     "definition" => $k, "attr_value" => {"between" => $v}
104                 }
105             };
106         } elsif (check_1d_max($v)) {
107             $term_clause = {
108                 "-and" => {"definition" => $k, "attr_value" => $v}
109             };
110         } else {
111             next;
112         }
113
114         push @$point, $not ? {"-not" => $term_clause} : $term_clause;
115     }
116     $result;
117 }
118
119 sub breakdown_term {
120     my ($term) = @_;
121
122     my $key = (grep { !/^__/ } keys %$term)[0];
123     (
124         $key, $term->{$key},
125         $term->{"__fuzzy"} ? 1 : 0,
126         $term->{"__between"} ? 1 : 0,
127         $term->{"__not"} ? 1 : 0,
128         $term->{"__castdate"} ? 1 : 0
129     );
130 }
131
132 sub get_fm_links_by_hint {
133     my ($hint) = @_;
134     foreach my $field (values %{$Fieldmapper::fieldmap}) {
135         return $field->{"links"} if $field->{"hint"} eq $hint;
136     }
137     undef;
138 }
139
140 sub gen_au_term {
141     my ($value, $n) = @_;
142     +{
143         "-or" => [
144             {"+au$n" => {"usrname" => $value}},
145             {"+au$n" => {"first_given_name" => $value}},
146             {"+au$n" => {"second_given_name" => $value}},
147             {"+au$n" => {"family_name" => $value}},
148             {"+ac$n" => {"barcode" => $value}}
149         ]
150     };
151 }
152
153 # go through the terms hash, find keys that correspond to fields links
154 # to actor.usr, and rewrite the search as one that searches not by
155 # actor.usr.id but by any of these user properties: card barcode, username,
156 # given names and family name.
157 sub prepare_au_terms {
158     my ($terms, $join_num) = @_;
159
160     my @joins = ();
161     my $nots = 0;
162     $join_num ||= 0;
163
164     foreach my $conj (qw/-and -or/) {
165         next unless exists $terms->{$conj};
166
167         my @new_outer_terms = ();
168         HINT_UNIT: foreach my $hint_unit (@{$terms->{$conj}}) {
169             my $hint = (keys %$hint_unit)[0];
170             (my $plain_hint = $hint) =~ y/+//d;
171             if ($hint eq "-not") {
172                 $hint_unit = $hint_unit->{$hint};
173                 $nots++;
174                 redo HINT_UNIT;
175             }
176
177             if (my $links = get_fm_links_by_hint($plain_hint) and
178                 $plain_hint ne "acqlia") {
179                 my @new_terms = ();
180                 my ($attr, $value) = breakdown_term($hint_unit->{$hint});
181                 if ($links->{$attr} and
182                     $links->{$attr}->{"class"} eq "au") {
183                     push @joins, [$plain_hint, $attr, $join_num];
184                     my $au_term = gen_au_term($value, $join_num);
185                     if ($nots > 0) {
186                         $au_term = {"-not" => $au_term};
187                         $nots--;
188                     }
189                     push @new_outer_terms, $au_term;
190                     $join_num++;
191                     delete $hint_unit->{$hint};
192                 }
193             }
194             if ($nots > 0) {
195                 $hint_unit = {"-not" => $hint_unit};
196                 $nots--;
197             }
198             push @new_outer_terms, $hint_unit if scalar keys %$hint_unit;
199         }
200         $terms->{$conj} = [ @new_outer_terms ];
201     }
202     @joins;
203 }
204
205 sub prepare_terms {
206     my ($terms, $is_and) = @_;
207
208     my $conj = $is_and ? "-and" : "-or";
209     my $outer_clause = {};
210
211     foreach my $class (qw/acqpo acqpl jub/) {
212         next if not exists $terms->{$class};
213
214         $outer_clause->{$conj} = [] unless $outer_clause->{$conj};
215         foreach my $unit (@{$terms->{$class}}) {
216             my ($k, $v, $fuzzy, $between, $not, $castdate) =
217                 breakdown_term($unit);
218
219             my $term_clause;
220             if ($fuzzy and not ref $v) {
221                 $term_clause = {$k => {"ilike" => "%" . $v . "%"}};
222             } elsif ($between and could_be_range($v)) {
223                 $term_clause = {$k => {"between" => $v}};
224             } elsif (check_1d_max($v)) {
225                 $v = castdate($v) if $castdate;
226                 $term_clause = {$k => $v};
227             } else {
228                 next;
229             }
230
231             my $clause = {"+" . $class => $term_clause};
232             $clause = {"-not" => $clause} if $not;
233             push @{$outer_clause->{$conj}}, $clause;
234         }
235     }
236
237     if ($terms->{"acqlia"}) {
238         push @{$outer_clause->{$conj}},
239             $is_and ? prepare_acqlia_search_and($terms->{"acqlia"}) :
240                 prepare_acqlia_search_or($terms->{"acqlia"});
241     }
242
243     return undef unless scalar keys %$outer_clause;
244     $outer_clause;
245 }
246
247 sub add_au_joins {
248     my ($from) = shift;
249
250     my $n = 0;
251     foreach my $join (@_) {
252         my ($hint, $attr, $num) = @$join;
253         my $start = $hint eq "jub" ? $from->{$hint} : $from->{"jub"}->{$hint};
254         my $clause = {
255             "class" => "au",
256             "type" => "left",
257             "field" => "id",
258             "fkey" => $attr,
259             "join" => {
260                 "ac$num" => {
261                     "class" => "ac",
262                     "type" => "left",
263                     "field" => "id",
264                     "fkey" => "card"
265                 }
266             }
267         };
268         if ($hint eq "jub") {
269             $start->{"au$num"} = $clause;
270         } else {
271             $start->{"join"} ||= {};
272             $start->{"join"}->{"au$num"} = $clause;
273         }
274         $n++;
275     }
276     $n;
277 }
278
279 __PACKAGE__->register_method(
280     method    => "unified_search",
281     api_name  => "open-ils.acq.lineitem.unified_search",
282     stream    => 1,
283     signature => {
284         desc   => q/Returns lineitems based on flexible search terms./,
285         params => [
286             {desc => "Authentication token", type => "string"},
287             {desc => "Field/value pairs for AND'ing", type => "object"},
288             {desc => "Field/value pairs for OR'ing", type => "object"},
289             {desc => "Conjunction between AND pairs and OR pairs " .
290                 "(can be 'and' or 'or')", type => "string"},
291             {desc => "Retrieval options (clear_marc, flesh_notes, etc) " .
292                 "- XXX detail all the options",
293                 type => "object"}
294         ],
295         return => {desc => "A stream of LIs on success, Event on failure"}
296     }
297 );
298
299 __PACKAGE__->register_method(
300     method    => "unified_search",
301     api_name  => "open-ils.acq.purchase_order.unified_search",
302     stream    => 1,
303     signature => {
304         desc   => q/Returns purchase orders based on flexible search terms.
305             See open-ils.acq.lineitem.unified_search/,
306         return => {desc => "A stream of POs on success, Event on failure"}
307     }
308 );
309
310 __PACKAGE__->register_method(
311     method    => "unified_search",
312     api_name  => "open-ils.acq.picklist.unified_search",
313     stream    => 1,
314     signature => {
315         desc   => q/Returns pick lists based on flexible search terms.
316             See open-ils.acq.lineitem.unified_search/,
317         return => {desc => "A stream of PLs on success, Event on failure"}
318     }
319 );
320
321 sub unified_search {
322     my ($self, $conn, $auth, $and_terms, $or_terms, $conj, $options) = @_;
323     $options ||= {};
324
325     my $e = new_editor("authtoken" => $auth);
326     return $e->die_event unless $e->checkauth;
327
328     # What kind of object are we returning? Important: (\w+) had better be
329     # a legit acq classname particle, so don't register any crazy api_names.
330     my $ret_type = ($self->api_name =~ /cq.(\w+).un/)[0];
331     my $retriever = $RETRIEVERS{$ret_type};
332     my $hint = F("acq::$ret_type")->{"hint"};
333
334     my $query = {
335         "select" => {
336             $hint =>
337                 [{"column" => "id", "transform" => "distinct"}]
338         },
339         "from" => {
340             "jub" => {
341                 "acqpo" => {
342                     "type" => "full",
343                     "field" => "id",
344                     "fkey" => "purchase_order"
345                 },
346                 "acqpl" => {
347                     "type" => "full",
348                     "field" => "id",
349                     "fkey" => "picklist"
350                 }
351             }
352         },
353         "order_by" => { $hint => {"id" => {}}},
354         "offset" => ($options->{"offset"} || 0)
355     };
356
357     $query->{"limit"} = $options->{"limit"} if $options->{"limit"};
358
359     $and_terms = prepare_terms($and_terms, 1);
360     $or_terms = prepare_terms($or_terms, 0) and do {
361         $query->{"from"}->{"jub"}->{"acqlia"} = {
362             "type" => "left", "field" => "lineitem", "fkey" => "id",
363         };
364     };
365
366     # TODO find instances of fields of type "timestamp" and massage the
367     # comparison to match search input (which is only at date precision,
368     # not timestamp).
369     my $offset = add_au_joins($query->{"from"}, prepare_au_terms($and_terms));
370     add_au_joins($query->{"from"}, prepare_au_terms($or_terms, $offset));
371
372     if ($and_terms and $or_terms) {
373         $query->{"where"} = {
374             "-" . (lc $conj eq "or" ? "or" : "and") => [$and_terms, $or_terms]
375         };
376     } elsif ($and_terms) {
377         $query->{"where"} = $and_terms;
378     } elsif ($or_terms) {
379         $query->{"where"} = $or_terms;
380     } else {
381         $e->disconnect;
382         return new OpenILS::Event("BAD_PARAMS", "desc" => "No usable terms");
383     }
384
385     my $results = $e->json_query($query) or return $e->die_event;
386     if ($options->{"id_list"}) {
387         foreach (@$results) {
388             $conn->respond($_->{"id"}) if $_->{"id"};
389         }
390     } else {
391         foreach (@$results) {
392             $conn->respond($retriever->($e, $_->{"id"}, $options))
393                 if $_->{"id"};
394         }
395     }
396     $e->disconnect;
397     undef;
398 }
399
400 1;