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