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