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 $subquery = {
  53             "select" => {"acqlia" => ["id"]},
  54             "from" => "acqlia",
  55             "where" => {"-and" => [{"lineitem" => {"=" => {"+jub" => "id"}}}]}
  56         };
  57
  58         my ($k, $v, $fuzzy, $between, $not) = breakdown_term($unit);
  59         my $point = $subquery->{"where"}->{"-and"};
  60         my $term_clause;
  61
  62         push @$point, {"definition" => $k};
  63
  64         if ($fuzzy and not ref $v) {
  65             push @$point, {"attr_value" => {"ilike" => "%" . $v . "%"}};
  66         } elsif ($between and could_be_range($v)) {
  67             push @$point, {"attr_value" => {"between" => $v}};
  68         } elsif (check_1d_max($v)) {
  69             push @$point, {"attr_value" => $v};
  70         } else {
  71             next;
  72         }
  73
  74         my $operator = $not ? "-not-exists" : "-exists";
  75         push @phrases, {$operator => $subquery};
  76     }
  77     @phrases;
  78 }
  79
  80 sub prepare_acqlia_search_or {
  81     my ($acqlia) = @_;
  82
  83     my $point = [];
  84     my $result = {"+acqlia" => {"-or" => $point}};
  85
  86     foreach my $unit (@$acqlia) {
  87         my ($k, $v, $fuzzy, $between, $not) = breakdown_term($unit);
  88         my $term_clause;
  89         if ($fuzzy and not ref $v) {
  90             $term_clause = {
  91                 "-and" => {
  92                     "definition" => $k,
  93                     "attr_value" => {"ilike" => "%" . $v . "%"}
  94                 }
  95             };
  96         } elsif ($between and could_be_range($v)) {
  97             $term_clause = {
  98                 "-and" => {
  99                     "definition" => $k, "attr_value" => {"between" => $v}
 100                 }
 101             };
 102         } elsif (check_1d_max($v)) {
 103             $term_clause = {
 104                 "-and" => {"definition" => $k, "attr_value" => $v}
 105             };
 106         } else {
 107             next;
 108         }
 109
 110         push @$point, $not ? {"-not" => $term_clause} : $term_clause;
 111     }
 112     $result;
 113 }
 114
 115 sub breakdown_term {
 116     my ($term) = @_;
 117
 118     my $key = (grep { !/^__/ } keys %$term)[0];
 119     (
 120         $key, $term->{$key},
 121         $term->{"__fuzzy"} ? 1 : 0,
 122         $term->{"__between"} ? 1 : 0,
 123         $term->{"__not"} ? 1 : 0
 124     );
 125 }
 126
 127 sub get_fm_links_by_hint {
 128     my ($hint) = @_;
 129     foreach my $field (values %{$Fieldmapper::fieldmap}) {
 130         return $field->{"links"} if $field->{"hint"} eq $hint;
 131     }
 132     undef;
 133 }
 134
 135 sub gen_au_term {
 136     my ($value, $n) = @_;
 137     +{
 138         "-or" => {
 139             "+au$n" => {
 140                 "-or" => {
 141                     "usrname" => $value,
 142                     "alias" => $value,
 143                     "first_given_name" => $value,
 144                     "second_given_name" => $value,
 145                     "family_name" => $value
 146                 }
 147             },
 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 # alias, 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) = breakdown_term($unit);
 217             my $term_clause;
 218             if ($fuzzy and not ref $v) {
 219                 $term_clause = {$k => {"ilike" => "%" . $v . "%"}};
 220             } elsif ($between and could_be_range($v)) {
 221                 $term_clause = {$k => {"between" => $v}};
 222             } elsif (check_1d_max($v)) {
 223                 $term_clause = {$k => $v};
 224             } else {
 225                 next;
 226             }
 227
 228             my $clause = {"+" . $class => $term_clause};
 229             $clause = {"-not" => $clause} if $not;
 230             push @{$outer_clause->{$conj}}, $clause;
 231         }
 232     }
 233
 234     if ($terms->{"acqlia"}) {
 235         push @{$outer_clause->{$conj}},
 236             $is_and ? prepare_acqlia_search_and($terms->{"acqlia"}) :
 237                 prepare_acqlia_search_or($terms->{"acqlia"});
 238     }
 239
 240     return undef unless scalar keys %$outer_clause;
 241     $outer_clause;
 242 }
 243
 244 sub add_au_joins {
 245     my ($from) = shift;
 246
 247     my $n = 0;
 248     foreach my $join (@_) {
 249         my ($hint, $attr, $num) = @$join;
 250         my $start = $hint eq "jub" ? $from->{$hint} : $from->{"jub"}->{$hint};
 251         my $clause = {
 252             "class" => "au",
 253             "type" => "left",
 254             "field" => "id",
 255             "fkey" => $attr,
 256             "join" => {
 257                 "ac$num" => {
 258                     "class" => "ac",
 259                     "type" => "left",
 260                     "field" => "id",
 261                     "fkey" => "card"
 262                 }
 263             }
 264         };
 265         if ($hint eq "jub") {
 266             $start->{"au$num"} = $clause;
 267         } else {
 268             $start->{"join"} ||= {};
 269             $start->{"join"}->{"au$num"} = $clause;
 270         }
 271         $n++;
 272     }
 273     $n;
 274 }
 275
 276 __PACKAGE__->register_method(
 277     method    => "unified_search",
 278     api_name  => "open-ils.acq.lineitem.unified_search",
 279     stream    => 1,
 280     signature => {
 281         desc   => q/Returns lineitems based on flexible search terms./,
 282         params => [
 283             {desc => "Authentication token", type => "string"},
 284             {desc => "Field/value pairs for AND'ing", type => "object"},
 285             {desc => "Field/value pairs for OR'ing", type => "object"},
 286             {desc => "Conjunction between AND pairs and OR pairs " .
 287                 "(can be 'and' or 'or')", type => "string"},
 288             {desc => "Retrieval options (clear_marc, flesh_notes, etc) " .
 289                 "- XXX detail all the options",
 290                 type => "object"}
 291         ],
 292         return => {desc => "A stream of LIs on success, Event on failure"}
 293     }
 294 );
 295
 296 __PACKAGE__->register_method(
 297     method    => "unified_search",
 298     api_name  => "open-ils.acq.purchase_order.unified_search",
 299     stream    => 1,
 300     signature => {
 301         desc   => q/Returns purchase orders based on flexible search terms.
 302             See open-ils.acq.lineitem.unified_search/,
 303         return => {desc => "A stream of POs on success, Event on failure"}
 304     }
 305 );
 306
 307 __PACKAGE__->register_method(
 308     method    => "unified_search",
 309     api_name  => "open-ils.acq.picklist.unified_search",
 310     stream    => 1,
 311     signature => {
 312         desc   => q/Returns pick lists based on flexible search terms.
 313             See open-ils.acq.lineitem.unified_search/,
 314         return => {desc => "A stream of PLs on success, Event on failure"}
 315     }
 316 );
 317
 318 sub unified_search {
 319     my ($self, $conn, $auth, $and_terms, $or_terms, $conj, $options) = @_;
 320     $options ||= {};
 321
 322     my $e = new_editor("authtoken" => $auth);
 323     return $e->die_event unless $e->checkauth;
 324
 325     # What kind of object are we returning? Important: (\w+) had better be
 326     # a legit acq classname particle, so don't register any crazy api_names.
 327     my $ret_type = ($self->api_name =~ /cq.(\w+).un/)[0];
 328     my $retriever = $RETRIEVERS{$ret_type};
 329     my $hint = F("acq::$ret_type")->{"hint"};
 330
 331     my $query = {
 332         "select" => {
 333             $hint =>
 334                 [{"column" => "id", "transform" => "distinct"}]
 335         },
 336         "from" => {
 337             "jub" => {
 338                 "acqpo" => {
 339                     "type" => "full",
 340                     "field" => "id",
 341                     "fkey" => "purchase_order"
 342                 },
 343                 "acqpl" => {
 344                     "type" => "full",
 345                     "field" => "id",
 346                     "fkey" => "picklist"
 347                 }
 348             }
 349         },
 350         "order_by" => { $hint => {"id" => {}}},
 351         "offset" => ($options->{"offset"} || 0)
 352     };
 353
 354     $query->{"limit"} = $options->{"limit"} if $options->{"limit"};
 355
 356     $and_terms = prepare_terms($and_terms, 1);
 357     $or_terms = prepare_terms($or_terms, 0) and do {
 358         $query->{"from"}->{"jub"}->{"acqlia"} = {
 359             "type" => "left", "field" => "lineitem", "fkey" => "id",
 360         };
 361     };
 362
 363     # TODO find instances of fields of type "timestamp" and massage the
 364     # comparison to match search input (which is only at date precision,
 365     # not timestamp).
 366     my $offset = add_au_joins($query->{"from"}, prepare_au_terms($and_terms));
 367     add_au_joins($query->{"from"}, prepare_au_terms($or_terms, $offset));
 368
 369     if ($and_terms and $or_terms) {
 370         $query->{"where"} = {
 371             "-" . (lc $conj eq "or" ? "or" : "and") => [$and_terms, $or_terms]
 372         };
 373     } elsif ($and_terms) {
 374         $query->{"where"} = $and_terms;
 375     } elsif ($or_terms) {
 376         $query->{"where"} = $or_terms;
 377     } else {
 378         $e->disconnect;
 379         return new OpenILS::Event("BAD_PARAMS", "desc" => "No usable terms");
 380     }
 381
 382     my $results = $e->json_query($query) or return $e->die_event;
 383     if ($options->{"id_list"}) {
 384         foreach (@$results) {
 385             $conn->respond($_->{"id"}) if $_->{"id"};
 386         }
 387     } else {
 388         foreach (@$results) {
 389             $conn->respond($retriever->($e, $_->{"id"}, $options))
 390                 if $_->{"id"};
 391         }
 392     }
 393     $e->disconnect;
 394     undef;
 395 }
 396
 397 1;