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