Open-ILS/src/perlmods/lib/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 OpenSRF::Utils::Logger qw/:logger/;
   9 use OpenILS::Event;
  10 use OpenILS::Utils::CStoreEditor q/:funcs/;
  11 use OpenILS::Utils::Fieldmapper;
  12 use OpenILS::Application::Acq::Lineitem;
  13 use OpenILS::Application::Acq::Financials;
  14 use OpenILS::Application::Acq::Picklist;
  15 use OpenILS::Application::Acq::Invoice;
  16 use OpenILS::Application::Acq::Order;
  17
  18 my %RETRIEVERS = (
  19     "lineitem" =>
  20         \&{"OpenILS::Application::Acq::Lineitem::retrieve_lineitem_impl"},
  21     "picklist" =>
  22         \&{"OpenILS::Application::Acq::Picklist::retrieve_picklist_impl"},
  23     "purchase_order" => \&{
  24         "OpenILS::Application::Acq::Financials::retrieve_purchase_order_impl"
  25     },
  26     "invoice" => \&{
  27         "OpenILS::Application::Acq::Invoice::fetch_invoice_impl"
  28     },
  29 );
  30
  31 sub F { $Fieldmapper::fieldmap->{"Fieldmapper::" . $_[0]}; }
  32
  33 # This subroutine returns 1 if the argument is a) a scalar OR
  34 # b) an array of ONLY scalars. Otherwise it returns 0.
  35 sub check_1d_max {
  36     my ($o) = @_;
  37     return 1 unless ref $o;
  38     if (ref($o) eq "ARRAY") {
  39         foreach (@$o) { return 0 if ref $_; }
  40         return 1;
  41     }
  42     0;
  43 }
  44
  45 # Returns 1 if and only if argument is an array of exactly two scalars.
  46 sub could_be_range {
  47     my ($o) = @_;
  48     if (ref $o eq "ARRAY") {
  49         return 1 if (scalar(@$o) == 2 && (!ref $o->[0] && !ref $o->[1]));
  50     }
  51     0;
  52 }
  53
  54 sub castdate {
  55     my ($value, $gte, $lte) = @_;
  56
  57     my $op = "=";
  58     $op = ">=" if $gte;
  59     $op = "<=" if $lte;
  60
  61     # avoid transforming a date if the match value is NULL.
  62     return {'=' => undef} if $op eq '=' and not $value;
  63
  64     +{$op => {"transform" => "date", "value" => $value}};
  65 }
  66
  67 sub prepare_acqlia_search_and {
  68     my ($acqlia) = @_;
  69
  70     my @phrases = ();
  71     foreach my $unit (@{$acqlia}) {
  72         my $subquery = {
  73             "select" => {"acqlia" => ["id"]},
  74             "from" => "acqlia",
  75             "where" => {"-and" => [{"lineitem" => {"=" => {"+jub" => "id"}}}]}
  76         };
  77
  78         # castdate not supported for acqlia fields: they're all type text
  79         my ($k, $v, $fuzzy, $between, $not) = breakdown_term($unit);
  80         my $point = $subquery->{"where"}->{"-and"};
  81         my $term_clause;
  82
  83         push @$point, {"definition" => $k};
  84
  85         if ($fuzzy and not ref $v) {
  86             push @$point, {"attr_value" => {"ilike" => "%" . $v . "%"}};
  87         } elsif ($between and could_be_range($v)) {
  88             push @$point, {"attr_value" => {"between" => $v}};
  89         } elsif (check_1d_max($v)) {
  90             push @$point, {"attr_value" => $v};
  91         } else {
  92             next;
  93         }
  94
  95         my $operator = $not ? "-not-exists" : "-exists";
  96         push @phrases, {$operator => $subquery};
  97     }
  98     @phrases;
  99 }
 100
 101 sub prepare_acqlia_search_or {
 102     my ($acqlia) = @_;
 103
 104     my $point = [];
 105     my $result = {"+acqlia" => {"-or" => $point}};
 106
 107     foreach my $unit (@$acqlia) {
 108         # castdate not supported for acqlia fields: they're all type text
 109         my ($k, $v, $fuzzy, $between, $not) = breakdown_term($unit);
 110         my $term_clause;
 111         if ($fuzzy and not ref $v) {
 112             $term_clause = {
 113                 "-and" => {
 114                     "definition" => $k,
 115                     "attr_value" => {"ilike" => "%" . $v . "%"}
 116                 }
 117             };
 118         } elsif ($between and could_be_range($v)) {
 119             $term_clause = {
 120                 "-and" => {
 121                     "definition" => $k, "attr_value" => {"between" => $v}
 122                 }
 123             };
 124         } elsif (check_1d_max($v)) {
 125             $term_clause = {
 126                 "-and" => {"definition" => $k, "attr_value" => $v}
 127             };
 128         } else {
 129             next;
 130         }
 131
 132         push @$point, $not ? {"-not" => $term_clause} : $term_clause;
 133     }
 134     $result;
 135 }
 136
 137 sub breakdown_term {
 138     my ($term) = @_;
 139
 140     my $key = (grep { !/^__/ } keys %$term)[0];
 141     (
 142         $key, $term->{$key},
 143         $term->{"__fuzzy"} ? 1 : 0,
 144         $term->{"__between"} ? 1 : 0,
 145         $term->{"__not"} ? 1 : 0,
 146         $term->{"__castdate"} ? 1 : 0,
 147         $term->{"__gte"} ? 1 : 0,
 148         $term->{"__lte"} ? 1 : 0
 149     );
 150 }
 151
 152 sub get_fm_links_by_hint {
 153     my ($hint) = @_;
 154     foreach my $field (values %{$Fieldmapper::fieldmap}) {
 155         return $field->{"links"} if $field->{"hint"} eq $hint;
 156     }
 157     undef;
 158 }
 159
 160 sub gen_au_term {
 161     my ($value, $n) = @_;
 162     my $lc_value = {
 163         "=" => { transform => "lowercase", value => lc($value) }
 164     };
 165
 166     +{
 167         "-or" => [
 168             {"+au$n" => {"usrname" => $value}},
 169             {"+au$n" => {"first_given_name" => $lc_value}},
 170             {"+au$n" => {"second_given_name" => $lc_value}},
 171             {"+au$n" => {"family_name" => $lc_value}},
 172             {"+ac$n" => {"barcode" => $value}}
 173         ]
 174     };
 175 }
 176
 177 # go through the terms hash, find keys that correspond to fields links
 178 # to actor.usr, and rewrite the search as one that searches not by
 179 # actor.usr.id but by any of these user properties: card barcode, username,
 180 # given names and family name.
 181 sub prepare_au_terms {
 182     my ($terms, $join_num) = @_;
 183
 184     my @joins = ();
 185     my $nots = 0;
 186     $join_num ||= 0;
 187
 188     foreach my $conj (qw/-and -or/) {
 189         next unless exists $terms->{$conj};
 190
 191         my @new_outer_terms = ();
 192         HINT_UNIT: foreach my $hint_unit (@{$terms->{$conj}}) {
 193             my $hint = (keys %$hint_unit)[0];
 194             (my $plain_hint = $hint) =~ y/+//d;
 195             if ($hint eq "-not") {
 196                 $hint_unit = $hint_unit->{$hint};
 197                 $nots++;
 198                 redo HINT_UNIT;
 199             }
 200
 201             if (my $links = get_fm_links_by_hint($plain_hint) and
 202                 $plain_hint ne "acqlia") {
 203                 my @new_terms = ();
 204                 my ($attr, $value) = breakdown_term($hint_unit->{$hint});
 205                 if ($links->{$attr} and
 206                     $links->{$attr}->{"class"} eq "au") {
 207                     push @joins, [$plain_hint, $attr, $join_num];
 208                     my $au_term = gen_au_term($value, $join_num);
 209                     if ($nots > 0) {
 210                         $au_term = {"-not" => $au_term};
 211                         $nots--;
 212                     }
 213                     push @new_outer_terms, $au_term;
 214                     $join_num++;
 215                     delete $hint_unit->{$hint};
 216                 }
 217             }
 218             if ($nots > 0) {
 219                 $hint_unit = {"-not" => $hint_unit};
 220                 $nots--;
 221             }
 222             push @new_outer_terms, $hint_unit if scalar keys %$hint_unit;
 223         }
 224         $terms->{$conj} = [ @new_outer_terms ];
 225     }
 226     @joins;
 227 }
 228
 229 sub prepare_terms {
 230     my ($terms, $is_and) = @_;
 231
 232     my $conj = $is_and ? "-and" : "-or";
 233     my $outer_clause = {};
 234
 235     foreach my $class (qw/acqpo acqpl acqinv jub acqlid acqlisum acqlisumi/) {
 236         next if not exists $terms->{$class};
 237
 238         $outer_clause->{$conj} = [] unless $outer_clause->{$conj};
 239         foreach my $unit (@{$terms->{$class}}) {
 240             my $special_clause;
 241             my ($k, $v, $fuzzy, $between, $not, $castdate, $gte, $lte) =
 242                 breakdown_term($unit);
 243
 244             my $term_clause;
 245             if ($fuzzy and not ref $v) {
 246                 $term_clause = {$k => {"ilike" => "%" . $v . "%"}};
 247             } elsif ($between and could_be_range($v)) {
 248                 $term_clause = {$k => {"between" => $v}};
 249             } elsif (check_1d_max($v)) {
 250                 if ($castdate) {
 251                     $v = castdate($v, $gte, $lte) if $castdate;
 252                 } elsif ($gte or $lte) {
 253                     my $op = $gte ? '>=' : '<=';
 254                     $v = {$op => $v};
 255                 } elsif (not ref $v and $not) {
 256                     # the old way, NOT (blah.id = $v) needs to be
 257                     # (blah.id <> $x OR blah.id IS NULL)
 258                     $not = 0;   # avoid the regular negative transformation
 259                     $special_clause = {
 260                         "-or" => [
 261                             {"+$class" => {$k => {"!=" => $v}}},
 262                             {"+$class" => {$k => undef}}
 263                         ]
 264                     };
 265                 }
 266                 $term_clause = {$k => $v};
 267             } else {
 268                 next;
 269             }
 270
 271             if ($special_clause) {
 272                 push @{$outer_clause->{$conj}}, $special_clause;
 273             } else {
 274                 my $clause = {"+" . $class => $term_clause};
 275                 $clause = {"-not" => $clause} if $not;
 276                 push @{$outer_clause->{$conj}}, $clause;
 277             }
 278         }
 279     }
 280
 281     if ($terms->{"acqlia"}) {
 282         push @{$outer_clause->{$conj}},
 283             $is_and ? prepare_acqlia_search_and($terms->{"acqlia"}) :
 284                 prepare_acqlia_search_or($terms->{"acqlia"});
 285     }
 286
 287     return undef unless scalar keys %$outer_clause;
 288     $outer_clause;
 289 }
 290
 291 sub add_au_joins {
 292     my $graft_map = shift;
 293     my $core_hint = shift;
 294
 295     my $n = 0;
 296     foreach my $join (@_) {
 297         my ($hint, $attr, $num) = @$join;
 298         my $start = $graft_map->{$hint};
 299         my $clause = {
 300             "class" => "au",
 301             "type" => "left",
 302             "field" => "id",
 303             "fkey" => $attr,
 304             "join" => {
 305                 "ac$num" => {
 306                     "class" => "ac",
 307                     "type" => "left",
 308                     "field" => "id",
 309                     "fkey" => "card"
 310                 }
 311             }
 312         };
 313
 314         if ($hint eq $core_hint) {
 315             $start->{"au$num"} = $clause;
 316         } else {
 317             $start->{"join"} ||= {};
 318             $start->{"join"}->{"au$num"} = $clause;
 319         }
 320
 321         $n++;
 322     }
 323     $n;
 324 }
 325
 326 sub build_from_clause_and_joins {
 327     my ($query, $core, $and_terms, $or_terms) = @_;
 328
 329     my %graft_map = ();
 330
 331     $graft_map{$core} = $query->{from}{$core} = {};
 332
 333     my $join_type = keys(%$or_terms) ? "left" : "inner";
 334
 335     my @classes = grep { $core ne $_ } (keys(%$and_terms), keys(%$or_terms));
 336     my %classes_uniq = map { $_ => 1 } @classes;
 337     @classes = keys(%classes_uniq);
 338
 339     my $acqlia_join = sub {
 340         return {"type" => "left", "field" => "lineitem", "fkey" => "id"};
 341     };
 342
 343     foreach my $class (@classes) {
 344         if ($class eq 'acqlia') {
 345             if ($core eq 'acqinv') {
 346                 $graft_map{acqlia} =
 347                     $query->{from}{$core}{acqmapinv}{join}{jub}{join}{acqlia} =
 348                     $acqlia_join->();
 349             } elsif ($core eq 'jub') {
 350                 $graft_map{acqlia} =
 351                     $query->{from}{$core}{acqlia} =
 352                     $acqlia_join->();
 353             } else {
 354                 $graft_map{acqlia} =
 355                     $query->{from}{$core}{jub}{join}{acqlia} =
 356                     $acqlia_join->();
 357             }
 358         } elsif ($class eq 'acqinv' or $core eq 'acqinv') {
 359             $graft_map{$class} =
 360                 $query->{from}{$core}{acqmapinv}{join}{$class} ||= {};
 361             $graft_map{$class}{type} = "left"; # $join_type
 362         } else {
 363             $graft_map{$class} = $query->{from}{$core}{$class} ||= {};
 364             $graft_map{$class}{type} = $join_type;
 365
 366             # without this, the SQL attempts to join on
 367             # jub.order_summary, which is a virtual field.
 368             $graft_map{$class}{field} = 'lineitem'
 369                 if $class eq 'acqlisum' or $class eq 'acqlisumi';
 370         }
 371     }
 372
 373     return \%graft_map;
 374 }
 375
 376 __PACKAGE__->register_method(
 377     method    => "unified_search",
 378     api_name  => "open-ils.acq.lineitem.unified_search",
 379     stream    => 1,
 380     signature => {
 381         desc   => q/Returns lineitems based on flexible search terms./,
 382         params => [
 383             {desc => "Authentication token", type => "string"},
 384             {desc => "Field/value pairs for AND'ing", type => "object"},
 385             {desc => "Field/value pairs for OR'ing", type => "object"},
 386             {desc => "Conjunction between AND pairs and OR pairs " .
 387                 "(can be 'and' or 'or')", type => "string"},
 388             {desc => "Retrieval options (clear_marc, flesh_notes, etc) " .
 389                 "- XXX detail all the options",
 390                 type => "object"}
 391         ],
 392         return => {desc => "A stream of LIs on success, Event on failure"}
 393     }
 394 );
 395
 396 __PACKAGE__->register_method(
 397     method    => "unified_search",
 398     api_name  => "open-ils.acq.purchase_order.unified_search",
 399     stream    => 1,
 400     signature => {
 401         desc   => q/Returns purchase orders based on flexible search terms.
 402             See open-ils.acq.lineitem.unified_search/,
 403         return => {desc => "A stream of POs on success, Event on failure"}
 404     }
 405 );
 406
 407 __PACKAGE__->register_method(
 408     method    => "unified_search",
 409     api_name  => "open-ils.acq.picklist.unified_search",
 410     stream    => 1,
 411     signature => {
 412         desc   => q/Returns pick lists based on flexible search terms.
 413             See open-ils.acq.lineitem.unified_search/,
 414         return => {desc => "A stream of PLs on success, Event on failure"}
 415     }
 416 );
 417
 418 __PACKAGE__->register_method(
 419     method    => "unified_search",
 420     api_name  => "open-ils.acq.invoice.unified_search",
 421     stream    => 1,
 422     signature => {
 423         desc   => q/Returns invoices lists based on flexible search terms.
 424             See open-ils.acq.lineitem.unified_search/,
 425         return => {desc => "A stream of invoices on success, Event on failure"}
 426     }
 427 );
 428
 429 sub unified_search {
 430     my ($self, $conn, $auth, $and_terms, $or_terms, $conj, $options) = @_;
 431     $options ||= {};
 432
 433     my $e = new_editor("authtoken" => $auth);
 434     return $e->die_event unless $e->checkauth;
 435
 436     # What kind of object are we returning? Important: (\w+) had better be
 437     # a legit acq classname particle, so don't register any crazy api_names.
 438     my $ret_type = ($self->api_name =~ /cq.(\w+).un/)[0];
 439     my $retriever = $RETRIEVERS{$ret_type};
 440     my $hint = F("acq::$ret_type")->{"hint"};
 441
 442     my $select_clause = {
 443         $hint => [{"column" => "id", "transform" => "distinct"}]
 444     };
 445
 446     my $attr_from_filter;
 447     if ($options->{"order_by"}) {
 448         # What's the point of this block?  When using ORDER BY in conjuction
 449         # with SELECT DISTINCT, the fields present in ORDER BY have to also
 450         # be in the SELECT clause.  This will take _one_ such field and add
 451         # it to the SELECT clause as needed.
 452         my ($order_by, $class, $field);
 453         unless (
 454             ($order_by = $options->{"order_by"}->[0]) &&
 455             ($class = $order_by->{"class"}) =~ /^[\da-z_]+$/ &&
 456             ($field = $order_by->{"field"}) =~ /^[\da-z_]+$/
 457         ) {
 458             $e->disconnect;
 459             return new OpenILS::Event(
 460                 "BAD_PARAMS", "note" =>
 461 q/order_by clause must be of the long form, like:
 462 "order_by": [{"class": "foo", "field": "bar", "direction": "asc"}]/
 463             );
 464
 465         } else {
 466
 467             # we can't combine distinct(id) with another select column,
 468             # since the non-distinct column may arbitrarily (via hash keys)
 469             # sort to the front of the final SQL, which PG will complain about.
 470             $select_clause = { $hint => ["id"] };
 471             $select_clause->{$class} ||= [];
 472             push @{$select_clause->{$class}},
 473                 {column => $field, transform => 'first', aggregate => 1};
 474
 475             # when sorting by LI attr values, we have to limit
 476             # to a specific type of attr value to sort on.
 477             if ($class eq 'acqlia') {
 478                 $attr_from_filter = {
 479                     "fkey" => "id",
 480                     "filter" => {
 481                         "attr_type" => "lineitem_marc_attr_definition",
 482                         "attr_name" => $options->{"order_by_attr"} || "title"
 483                     },
 484                     "type" => "left",
 485                     "field" =>"lineitem"
 486                 };
 487             }
 488         }
 489     }
 490
 491     my $query = {
 492         select => $select_clause,
 493         order_by => ($options->{order_by} || {$hint => {id => {}}}),
 494         offset => ($options->{offset} || 0)
 495     };
 496
 497     $query->{"limit"} = $options->{"limit"} if $options->{"limit"};
 498
 499     my $graft_map = build_from_clause_and_joins(
 500         $query, $hint, $and_terms, $or_terms
 501     );
 502
 503     $and_terms = prepare_terms($and_terms, 1);
 504     $or_terms = prepare_terms($or_terms, 0);
 505
 506     my $offset = add_au_joins($graft_map, $hint, prepare_au_terms($and_terms));
 507     add_au_joins($graft_map, $hint, prepare_au_terms($or_terms, $offset));
 508
 509     # The join to acqmapinv needs to be a left join when present.
 510     if ($query->{from}{$hint}{acqmapinv}) {
 511         $query->{from}{$hint}{acqmapinv}{type} = "left";
 512     }
 513
 514     if ($and_terms and $or_terms) {
 515         $query->{"where"} = {
 516             "-" . (lc $conj eq "or" ? "or" : "and") => [$and_terms, $or_terms]
 517         };
 518     } elsif ($and_terms) {
 519         $query->{"where"} = $and_terms;
 520     } elsif ($or_terms) {
 521         $query->{"where"} = $or_terms;
 522     } else {
 523         $e->disconnect;
 524         return new OpenILS::Event("BAD_PARAMS", "desc" => "No usable terms");
 525     }
 526
 527
 528     # if ordering by acqlia, insert the from clause
 529     # filter to limit to one type of attr.
 530     if ($attr_from_filter) {
 531         $query->{from}->{jub} = {} unless $query->{from}->{jub};
 532         $query->{from}->{jub}->{acqlia} = $attr_from_filter;
 533     }
 534
 535     my $results = $e->json_query($query) or return $e->die_event;
 536     my @id_list = map { $_->{"id"} } (grep { $_->{"id"} } @$results);
 537
 538     foreach(@id_list){
 539         my $resp = $retriever->($e, $_, $options);
 540         next if(ref($resp) ne "Fieldmapper::acq::$ret_type");
 541         $conn->respond($options->{"id_list"} ? $_ : $resp);
 542     }
 543
 544     $e->disconnect;
 545     undef;
 546 }
 547
 548 __PACKAGE__->register_method(
 549     method    => "bib_search",
 550     api_name  => "open-ils.acq.biblio.wrapped_search",
 551     stream    => 1,
 552     signature => {
 553         desc   => q/Returns new lineitems for each matching bib record/,
 554         params => [
 555             {desc => "Authentication token", type => "string"},
 556             {desc => "search string", type => "string"},
 557             {desc => "search options", type => "object"}
 558         ],
 559         return => {desc => "A stream of LIs on success, Event on failure"}
 560     }
 561 );
 562
 563 __PACKAGE__->register_method(
 564     method    => "bib_search",
 565     api_name  => "open-ils.acq.biblio.create_by_id",
 566     stream    => 1,
 567     signature => {
 568         desc   => q/Returns new lineitems for each matching bib record/,
 569         params => [
 570             {desc => "Authentication token", type => "string"},
 571             {desc => "list of bib IDs", type => "array"},
 572             {desc => "options (for lineitem fleshing)", type => "object"}
 573         ],
 574         return => {desc => "A stream of LIs on success, Event on failure"}
 575     }
 576 );
 577
 578 # This is very similar to zsearch() in Order.pm
 579 sub bib_search {
 580     my ($self, $conn, $auth, $search, $opts) = @_;
 581
 582     my $e = new_editor("authtoken" => $auth, "xact" => 1);
 583     return $e->die_event unless $e->checkauth;
 584     return $e->die_event unless $e->allowed("CREATE_PICKLIST");
 585
 586     my $mgr = new OpenILS::Application::Acq::BatchManager(
 587         "editor" => $e, "conn" => $conn
 588     );
 589
 590     $opts ||= {};
 591
 592     my $picklist;
 593     my @li_ids = ();
 594     if ($self->api_name =~ /create_by_id/) {
 595         $search = [ sort @$search ]; # for consitency
 596         my $bibs = $e->search_biblio_record_entry(
 597             {"id" => $search}, {"order_by" => {"bre" => ["id"]}}
 598         ) or return $e->die_event;
 599
 600         if ($opts->{"reuse_picklist"}) {
 601             $picklist = $e->retrieve_acq_picklist($opts->{"reuse_picklist"}) or
 602                 return $e->die_event;
 603             return $e->die_event unless
 604                 $e->allowed("UPDATE_PICKLIST", $picklist->org_unit);
 605
 606             # If we're reusing an existing picklist, we don't need to
 607             # create new lineitems for any bib records for which we already
 608
 609             my $already_have = $e->search_acq_lineitem({
 610                 "picklist" => $picklist->id,
 611                 "eg_bib_id" => [ map { $_->id } @$bibs ]
 612             }) or return $e->die_event;
 613
 614             # So in that case we a) save the lineitem id's of the relevant
 615             # items that already exist so that we can return those items later,
 616             # and b) remove the bib id's in question from our list of bib
 617             # id's to lineitemize.
 618             if (@$already_have) {
 619                 push @li_ids, $_->id foreach (@$already_have);
 620                 my @new_bibs = ();
 621                 foreach my $bib (@$bibs) {
 622                     push @new_bibs, $bib unless
 623                         grep { $_->eg_bib_id == $bib->id } @$already_have;
 624                 }
 625                 $bibs = [ @new_bibs ];
 626             }
 627         } else {
 628             $picklist = OpenILS::Application::Acq::Order::zsearch_build_pl($mgr, undef)
 629                 or return $e->die_event;
 630         }
 631
 632         $conn->respond($picklist->id);
 633
 634         push @li_ids, map {
 635             OpenILS::Application::Acq::Order::create_lineitem(
 636                 $mgr,
 637                 "picklist" => $picklist->id,
 638                 "source_label" => "native-evergreen-catalog",
 639                 "marc" => $_->marc,
 640                 "eg_bib_id" => $_->id
 641             )->id;
 642         } (@$bibs);
 643     } else {
 644         $opts->{"limit"} ||= 10;
 645
 646         my $ses = create OpenSRF::AppSession("open-ils.search");
 647         my $req = $ses->request(
 648             "open-ils.search.biblio.multiclass.query.staff", $opts, $search
 649         );
 650
 651         my $count = 0;
 652         while (my $resp = $req->recv("timeout" => 60)) {
 653             $picklist = OpenILS::Application::Acq::Order::zsearch_build_pl(
 654                 $mgr, undef
 655             ) unless $count++;
 656
 657             my $result = $resp->content;
 658             next if not ref $result;
 659
 660             # The result object contains a whole heck of a lot more information
 661             # than just bib IDs, so maybe we could tell the client something
 662             # useful (progress meter at least) in the future...
 663             push @li_ids, map {
 664                 my $bib = $_->[0];
 665                 OpenILS::Application::Acq::Order::create_lineitem(
 666                     $mgr,
 667                     "picklist" => $picklist->id,
 668                     "source_label" => "native-evergreen-catalog",
 669                     "marc" => $e->retrieve_biblio_record_entry($bib)->marc,
 670                     "eg_bib_id" => $bib
 671                 )->id;
 672             } (@{$result->{"ids"}});
 673         }
 674         $ses->disconnect;
 675     }
 676
 677     $e->commit;
 678
 679     $logger->info("created @li_ids new lineitems for picklist $picklist");
 680
 681     # new editor, but still using transaction to ensure correct retrieval
 682     # in a replicated setup
 683     $e = new_editor("authtoken" => $auth, xact => 1) or return $e->die_event;
 684     return $e->die_event unless $e->checkauth;
 685     $conn->respond($RETRIEVERS{"lineitem"}->($e, $_, $opts)) foreach @li_ids;
 686     $e->rollback;
 687     $e->disconnect;
 688
 689     undef;
 690 }
 691
 692 1;