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