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