Open-ILS/src/perlmods/OpenILS/Application/Acq/Order.pm

   1 package OpenILS::Application::Acq::BatchManager;
   2 use OpenSRF::AppSession;
   3 use OpenSRF::EX qw/:try/;
   4 use strict; use warnings;
   5
   6 sub new {
   7     my($class, %args) = @_;
   8     my $self = bless(\%args, $class);
   9     $self->{args} = {
  10         lid => 0,
  11         li => 0,
  12         copies => 0,
  13         bibs => 0,
  14         progress => 0,
  15         debits_accrued => 0,
  16         purchase_order => undef,
  17         picklist => undef,
  18         complete => 0,
  19         indexed => 0,
  20         total => 0
  21     };
  22     $self->{ingest_queue} = [];
  23     $self->{cache} = {};
  24     return $self;
  25 }
  26
  27 sub conn {
  28     my($self, $val) = @_;
  29     $self->{conn} = $val if $val;
  30     return $self->{conn};
  31 }
  32 sub throttle {
  33     my($self, $val) = @_;
  34     $self->{throttle} = $val if $val;
  35     return $self->{throttle};
  36 }
  37 sub respond {
  38     my($self, %other_args) = @_;
  39     if($self->throttle and not %other_args) {
  40         return unless (
  41             ($self->{args}->{progress} - $self->{last_respond_progress}) >= $self->throttle
  42         );
  43     }
  44     $self->conn->respond({ %{$self->{args}}, %other_args });
  45     $self->{last_respond_progress} = $self->{args}->{progress};
  46 }
  47 sub respond_complete {
  48     my($self, %other_args) = @_;
  49     $self->complete;
  50     $self->conn->respond_complete({ %{$self->{args}}, %other_args });
  51     return undef;
  52 }
  53 sub total {
  54     my($self, $val) = @_;
  55     $self->{args}->{total} = $val if defined $val;
  56     return $self->{args}->{total};
  57 }
  58 sub purchase_order {
  59     my($self, $val) = @_;
  60     $self->{args}->{purchase_order} = $val if $val;
  61     return $self;
  62 }
  63 sub picklist {
  64     my($self, $val) = @_;
  65     $self->{args}->{picklist} = $val if $val;
  66     return $self;
  67 }
  68 sub add_lid {
  69     my $self = shift;
  70     $self->{args}->{lid} += 1;
  71     $self->{args}->{progress} += 1;
  72     return $self;
  73 }
  74 sub add_li {
  75     my $self = shift;
  76     $self->{args}->{li} += 1;
  77     $self->{args}->{progress} += 1;
  78     return $self;
  79 }
  80 sub add_copy {
  81     my $self = shift;
  82     $self->{args}->{copies} += 1;
  83     $self->{args}->{progress} += 1;
  84     return $self;
  85 }
  86 sub add_bib {
  87     my $self = shift;
  88     $self->{args}->{bibs} += 1;
  89     $self->{args}->{progress} += 1;
  90     return $self;
  91 }
  92 sub add_debit {
  93     my($self, $amount) = @_;
  94     $self->{args}->{debits_accrued} += $amount;
  95     $self->{args}->{progress} += 1;
  96     return $self;
  97 }
  98 sub editor {
  99     my($self, $editor) = @_;
 100     $self->{editor} = $editor if defined $editor;
 101     return $self->{editor};
 102 }
 103 sub complete {
 104     my $self = shift;
 105     $self->{args}->{complete} = 1;
 106     return $self;
 107 }
 108
 109 sub ingest_ses {
 110     my($self, $val) = @_;
 111     $self->{ingest_ses} = $val if $val;
 112     return $self->{ingest_ses};
 113 }
 114
 115 sub push_ingest_queue {
 116     my($self, $rec_id) = @_;
 117
 118     $self->ingest_ses(OpenSRF::AppSession->connect('open-ils.ingest'))
 119         unless $self->ingest_ses;
 120
 121     my $req = $self->ingest_ses->request('open-ils.ingest.full.biblio.record', $rec_id);
 122
 123     push(@{$self->{ingest_queue}}, $req);
 124 }
 125
 126 sub process_ingest_records {
 127     my $self = shift;
 128     return unless @{$self->{ingest_queue}};
 129
 130     for my $req (@{$self->{ingest_queue}}) {
 131
 132         try {
 133             $req->gather(1);
 134             $self->{args}->{indexed} += 1;
 135             $self->{args}->{progress} += 1;
 136         } otherwise {};
 137
 138         $self->respond;
 139     }
 140     $self->ingest_ses->disconnect;
 141 }
 142
 143
 144 sub cache {
 145     my($self, $org, $key, $val) = @_;
 146     $self->{cache}->{$org} = {} unless $self->{cache}->{org};
 147     $self->{cache}->{$org}->{$key} = $val if defined $val;
 148     return $self->{cache}->{$org}->{$key};
 149 }
 150
 151
 152 package OpenILS::Application::Acq::Order;
 153 use base qw/OpenILS::Application/;
 154 use strict; use warnings;
 155 # ----------------------------------------------------------------------------
 156 # Break up each component of the order process and pieces into managable
 157 # actions that can be shared across different workflows
 158 # ----------------------------------------------------------------------------
 159 use OpenILS::Event;
 160 use OpenSRF::Utils::Logger qw(:logger);
 161 use OpenSRF::Utils::JSON;
 162 use OpenILS::Utils::Fieldmapper;
 163 use OpenILS::Utils::CStoreEditor q/:funcs/;
 164 use OpenILS::Const qw/:const/;
 165 use OpenSRF::EX q/:try/;
 166 use OpenILS::Application::AppUtils;
 167 use OpenILS::Application::Cat::BibCommon;
 168 use OpenILS::Application::Cat::AssetCommon;
 169 use MARC::Record;
 170 use MARC::Batch;
 171 use MARC::File::XML;
 172 my $U = 'OpenILS::Application::AppUtils';
 173
 174
 175 # ----------------------------------------------------------------------------
 176 # Lineitem
 177 # ----------------------------------------------------------------------------
 178 sub create_lineitem {
 179     my($mgr, %args) = @_;
 180     my $li = Fieldmapper::acq::lineitem->new;
 181     $li->creator($mgr->editor->requestor->id);
 182     $li->selector($li->creator);
 183     $li->editor($li->creator);
 184     $li->create_time('now');
 185     $li->edit_time('now');
 186     $li->state('new');
 187     $li->$_($args{$_}) for keys %args;
 188     if($li->picklist) {
 189         return 0 unless update_picklist($mgr, $li->picklist);
 190     }
 191     $mgr->add_li;
 192     return $mgr->editor->create_acq_lineitem($li);
 193 }
 194
 195 sub update_lineitem {
 196     my($mgr, $li) = @_;
 197     $li->edit_time('now');
 198     $li->editor($mgr->editor->requestor->id);
 199     return $li if $mgr->editor->update_acq_lineitem($li);
 200     $mgr->add_lid;
 201     return undef;
 202 }
 203
 204 sub delete_lineitem {
 205     my($mgr, $li) = @_;
 206     $li = $mgr->editor->retrieve_acq_lineitem($li) unless ref $li;
 207
 208     if($li->picklist) {
 209         return 0 unless update_picklist($mgr, $li->picklist);
 210     }
 211
 212     if($li->purchase_order) {
 213         return 0 unless update_purchase_order($mgr, $li->purchase_order);
 214     }
 215
 216     # delete the attached lineitem_details
 217     my $lid_ids = $mgr->editor->search_acq_lineitem_detail({lineitem => $li->id}, {idlist=>1});
 218     for my $lid_id (@$lid_ids) {
 219         return 0 unless delete_lineitem_detail($mgr, undef, $lid_id);
 220     }
 221
 222     return $mgr->editor->delete_acq_lineitem($li);
 223 }
 224
 225 # begins and commit transactions as it goes
 226 sub create_lineitem_list_assets {
 227     my($mgr, $li_ids) = @_;
 228     # create the bibs/volumes/copies and ingest the records
 229     for my $li_id (@$li_ids) {
 230         $mgr->editor->xact_begin;
 231         my $data = create_lineitem_assets($mgr, $li_id) or return undef;
 232         $mgr->editor->xact_commit;
 233         $mgr->push_ingest_queue($data->{li}->eg_bib_id) if $data->{new_bib};
 234         $mgr->respond;
 235     }
 236     $mgr->process_ingest_records;
 237     return 1;
 238 }
 239
 240
 241 # ----------------------------------------------------------------------------
 242 # Lineitem Detail
 243 # ----------------------------------------------------------------------------
 244 sub create_lineitem_detail {
 245     my($mgr, %args) = @_;
 246     my $lid = Fieldmapper::acq::lineitem_detail->new;
 247     $lid->$_($args{$_}) for keys %args;
 248     $mgr->editor->create_acq_lineitem_detail($lid) or return 0;
 249     $mgr->add_lid;
 250
 251     # create some default values
 252     unless($lid->barcode) {
 253         my $pfx = $U->ou_ancestor_setting_value($lid->owning_lib, 'acq.tmp_barcode_prefix') || 'ACQ';
 254         $lid->barcode($pfx.$lid->id);
 255     }
 256
 257     unless($lid->cn_label) {
 258         my $pfx = $U->ou_ancestor_setting_value($lid->owning_lib, 'acq.tmp_callnumber_prefix') || 'ACQ';
 259         $lid->cn_label($pfx.$lid->id);
 260     }
 261
 262     if(!$lid->location and my $loc = $U->ou_ancestor_setting_value($lid->owning_lib, 'acq.default_copy_location')) {
 263         $lid->location($loc);
 264     }
 265
 266     if(!$lid->circ_modifier and my $mod = get_default_circ_modifier($mgr, $lid->owning_lib)) {
 267         $lid->circ_modifier($mod);
 268     }
 269
 270     $mgr->editor->update_acq_lineitem_detail($lid) or return 0;
 271     my $li = $mgr->editor->retrieve_acq_lineitem($lid->lineitem) or return 0;
 272     update_lineitem($mgr, $li) or return 0;
 273     return $lid;
 274 }
 275
 276 sub get_default_circ_modifier {
 277     my($mgr, $org) = @_;
 278     my $mod = $mgr->cache($org, 'def_circ_mod');
 279     return $mod if $mod;
 280     $mod = $U->ou_ancestor_setting_value($org, 'acq.default_circ_modifier');
 281     return $mgr->cache($org, 'def_circ_mod', $mod) if $mod;
 282     return undef;
 283 }
 284
 285 sub delete_lineitem_detail {
 286     my($mgr, $lid) = @_;
 287     $lid = $mgr->editor->retrieve_acq_lineitem_detail($lid) unless ref $lid;
 288     return $mgr->editor->delete_acq_lineitem_detail($lid);
 289 }
 290
 291
 292 # ----------------------------------------------------------------------------
 293 # Lineitem Attr
 294 # ----------------------------------------------------------------------------
 295 sub set_lineitem_attr {
 296     my($mgr, %args) = @_;
 297     my $attr_type = $args{attr_type};
 298
 299     # first, see if it's already set.  May just need to overwrite it
 300     my $attr = $mgr->editor->search_acq_lineitem_attr({
 301         lineitem => $args{lineitem},
 302         attr_type => $args{attr_type},
 303         attr_name => $args{attr_name}
 304     })->[0];
 305
 306     if($attr) {
 307         $attr->attr_value($args{attr_value});
 308         return $attr if $mgr->editor->update_acq_lineitem_attr($attr);
 309         return undef;
 310
 311     } else {
 312
 313         $attr = Fieldmapper::acq::lineitem_attr->new;
 314         $attr->$_($args{$_}) for keys %args;
 315
 316         unless($attr->definition) {
 317             my $find = "search_acq_$attr_type";
 318             my $attr_def_id = $mgr->editor->$find({code => $attr->attr_name}, {idlist=>1})->[0] or return 0;
 319             $attr->definition($attr_def_id);
 320         }
 321         return $mgr->editor->create_acq_lineitem_attr($attr);
 322     }
 323 }
 324
 325 sub get_li_price {
 326     my $li = shift;
 327     my $attrs = $li->attributes;
 328     my ($marc_estimated, $local_estimated, $local_actual, $prov_estimated, $prov_actual);
 329
 330     for my $attr (@$attrs) {
 331         if($attr->attr_name eq 'estimated_price') {
 332             $local_estimated = $attr->attr_value
 333                 if $attr->attr_type eq 'lineitem_local_attr_definition';
 334             $prov_estimated = $attr->attr_value
 335                 if $attr->attr_type eq 'lineitem_prov_attr_definition';
 336             $marc_estimated = $attr->attr_value
 337                 if $attr->attr_type eq 'lineitem_marc_attr_definition';
 338
 339         } elsif($attr->attr_name eq 'actual_price') {
 340             $local_actual = $attr->attr_value
 341                 if $attr->attr_type eq 'lineitem_local_attr_definition';
 342             $prov_actual = $attr->attr_value
 343                 if $attr->attr_type eq 'lineitem_prov_attr_definition';
 344         }
 345     }
 346
 347     return ($local_actual, 1) if $local_actual;
 348     return ($prov_actual, 2) if $prov_actual;
 349     return ($local_estimated, 1) if $local_estimated;
 350     return ($prov_estimated, 2) if $prov_estimated;
 351     return ($marc_estimated, 3);
 352 }
 353
 354
 355 # ----------------------------------------------------------------------------
 356 # Lineitem Debits
 357 # ----------------------------------------------------------------------------
 358 sub create_lineitem_debits {
 359     my($mgr, $li, $price, $ptype) = @_;
 360
 361     ($price, $ptype) = get_li_price($li) unless $price;
 362
 363     unless($price) {
 364         $mgr->editor->event(OpenILS::Event->new('ACQ_LINEITEM_NO_PRICE', payload => $li->id));
 365         $mgr->editor->rollback;
 366         return 0;
 367     }
 368
 369     unless($li->provider) {
 370         $mgr->editor->event(OpenILS::Event->new('ACQ_LINEITEM_NO_PROVIDER', payload => $li->id));
 371         $mgr->editor->rollback;
 372         return 0;
 373     }
 374
 375     my $lid_ids = $mgr->editor->search_acq_lineitem_detail(
 376         {lineitem => $li->id},
 377         {idlist=>1}
 378     );
 379
 380     for my $lid_id (@$lid_ids) {
 381
 382         my $lid = $mgr->editor->retrieve_acq_lineitem_detail([
 383             $lid_id,
 384             {   flesh => 1,
 385                 flesh_fields => {acqlid => ['fund']}
 386             }
 387         ]);
 388
 389         create_lineitem_detail_debit($mgr, $li, $lid, $price, $ptype) or return 0;
 390     }
 391
 392     return 1;
 393 }
 394
 395
 396 # flesh li->provider
 397 # flesh lid->fund
 398 # ptype 1=local, 2=provider, 3=marc
 399 sub create_lineitem_detail_debit {
 400     my($mgr, $li, $lid, $price, $ptype) = @_;
 401
 402     unless(ref $li and ref $li->provider) {
 403        $li = $mgr->editor->retrieve_acq_lineitem([
 404             $li,
 405             {   flesh => 1,
 406                 flesh_fields => {jub => ['provider']},
 407             }
 408         ]);
 409     }
 410
 411     unless(ref $lid and ref $lid->fund) {
 412         $lid = $mgr->editor->retrieve_acq_lineitem_detail([
 413             $lid,
 414             {   flesh => 1,
 415                 flesh_fields => {acqlid => ['fund']}
 416             }
 417         ]);
 418     }
 419
 420     my $ctype = $lid->fund->currency_type;
 421     my $amount = $price;
 422
 423     if($ptype == 2) { # price from vendor
 424         $ctype = $li->provider->currency_type;
 425         $amount = currency_conversion($mgr, $ctype, $lid->fund->currency_type, $price);
 426     }
 427
 428     my $debit = create_fund_debit(
 429         $mgr,
 430         fund => $lid->fund->id,
 431         origin_amount => $price,
 432         origin_currency_type => $ctype,
 433         amount => $amount
 434     ) or return 0;
 435
 436     $lid->fund_debit($debit->id);
 437     $lid->fund($lid->fund->id);
 438     $mgr->editor->update_acq_lineitem_detail($lid) or return 0;
 439     return $debit;
 440 }
 441
 442
 443 # ----------------------------------------------------------------------------
 444 # Fund Debit
 445 # ----------------------------------------------------------------------------
 446 sub create_fund_debit {
 447     my($mgr, %args) = @_;
 448     my $debit = Fieldmapper::acq::fund_debit->new;
 449     $debit->debit_type('purchase');
 450     $debit->encumbrance('t');
 451     $debit->$_($args{$_}) for keys %args;
 452     $mgr->add_debit($debit->amount);
 453     return $mgr->editor->create_acq_fund_debit($debit);
 454 }
 455
 456 sub currency_conversion {
 457     my($mgr, $src_currency, $dest_currency, $amount) = @_;
 458     my $result = $mgr->editor->json_query(
 459         {from => ['acq.exchange_ratio', $src_currency, $dest_currency, $amount]});
 460     return $result->[0]->{'acq.exchange_ratio'};
 461 }
 462
 463
 464 # ----------------------------------------------------------------------------
 465 # Picklist
 466 # ----------------------------------------------------------------------------
 467 sub create_picklist {
 468     my($mgr, %args) = @_;
 469     my $picklist = Fieldmapper::acq::picklist->new;
 470     $picklist->creator($mgr->editor->requestor->id);
 471     $picklist->owner($picklist->creator);
 472     $picklist->editor($picklist->creator);
 473     $picklist->create_time('now');
 474     $picklist->edit_time('now');
 475     $picklist->org_unit($mgr->editor->requestor->ws_ou);
 476     $picklist->owner($mgr->editor->requestor->id);
 477     $picklist->$_($args{$_}) for keys %args;
 478     $mgr->picklist($picklist);
 479     return $mgr->editor->create_acq_picklist($picklist);
 480 }
 481
 482 sub update_picklist {
 483     my($mgr, $picklist) = @_;
 484     $picklist = $mgr->editor->retrieve_acq_picklist($picklist) unless ref $picklist;
 485     $picklist->edit_time('now');
 486     $picklist->editor($mgr->editor->requestor->id);
 487     $mgr->picklist($picklist);
 488     return $picklist if $mgr->editor->update_acq_picklist($picklist);
 489     return undef;
 490 }
 491
 492 sub delete_picklist {
 493     my($mgr, $picklist) = @_;
 494     $picklist = $mgr->editor->retrieve_acq_picklist($picklist) unless ref $picklist;
 495
 496     # delete all 'new' lineitems
 497     my $lis = $mgr->editor->search_acq_lineitem({picklist => $picklist->id, state => 'new'});
 498     for my $li (@$lis) {
 499         return 0 unless delete_lineitem($mgr, $li);
 500     }
 501
 502     # detach all non-'new' lineitems
 503     $lis = $mgr->editor->search_acq_lineitem({picklist => $picklist->id, state => {'!=' => 'new'}});
 504     for my $li (@$lis) {
 505         $li->clear_picklist;
 506         return 0 unless update_lineitem($li);
 507     }
 508
 509     # remove any picklist-specific object perms
 510     my $ops = $mgr->editor->search_permission_usr_object_perm_map({object_type => 'acqpl', object_id => ''.$picklist->id});
 511     for my $op (@$ops) {
 512         return 0 unless $mgr->editor->delete_usr_object_perm_map($op);
 513     }
 514
 515     return $mgr->editor->delete_acq_picklist($picklist);
 516 }
 517
 518 # ----------------------------------------------------------------------------
 519 # Purchase Order
 520 # ----------------------------------------------------------------------------
 521 sub update_purchase_order {
 522     my($mgr, $po) = @_;
 523     $po = $mgr->editor->retrieve_acq_purchase_order($po) unless ref $po;
 524     $po->editor($mgr->editor->requestor->id);
 525     $po->edit_time('now');
 526     $mgr->purchase_order($po);
 527     return $po if $mgr->editor->update_acq_purchase_order($po);
 528     return undef;
 529 }
 530
 531 sub create_purchase_order {
 532     my($mgr, %args) = @_;
 533     my $po = Fieldmapper::acq::purchase_order->new;
 534     $po->creator($mgr->editor->requestor->id);
 535     $po->editor($mgr->editor->requestor->id);
 536     $po->owner($mgr->editor->requestor->id);
 537     $po->edit_time('now');
 538     $po->create_time('now');
 539     $po->ordering_agency($mgr->editor->requestor->ws_ou);
 540     $po->$_($args{$_}) for keys %args;
 541     $mgr->purchase_order($po);
 542     return $mgr->editor->create_acq_purchase_order($po);
 543 }
 544
 545
 546 # ----------------------------------------------------------------------------
 547 # Bib, Callnumber, and Copy data
 548 # ----------------------------------------------------------------------------
 549
 550 sub create_lineitem_assets {
 551     my($mgr, $li_id) = @_;
 552     my $evt;
 553
 554     my $li = $mgr->editor->retrieve_acq_lineitem([
 555         $li_id,
 556         {   flesh => 1,
 557             flesh_fields => {jub => ['purchase_order', 'attributes']}
 558         }
 559     ]) or return 0;
 560
 561     # -----------------------------------------------------------------
 562     # first, create the bib record if necessary
 563     # -----------------------------------------------------------------
 564     my $new_bib = 0;
 565     unless($li->eg_bib_id) {
 566         create_bib($mgr, $li) or return 0;
 567         $new_bib = 1;
 568     }
 569
 570     my $li_details = $mgr->editor->search_acq_lineitem_detail({lineitem => $li_id}, {idlist=>1});
 571
 572     # -----------------------------------------------------------------
 573     # for each lineitem_detail, create the volume if necessary, create
 574     # a copy, and link them all together.
 575     # -----------------------------------------------------------------
 576     for my $lid_id (@{$li_details}) {
 577
 578         my $lid = $mgr->editor->retrieve_acq_lineitem_detail($lid_id) or return 0;
 579         next if $lid->eg_copy_id;
 580
 581         my $org = $lid->owning_lib;
 582         my $label = $lid->cn_label;
 583         my $bibid = $li->eg_bib_id;
 584
 585         my $volume = $mgr->cache($org, "cn.$bibid.$label");
 586         unless($volume) {
 587             $volume = create_volume($mgr, $li, $lid) or return 0;
 588             $mgr->cache($org, "cn.$bibid.$label", $volume);
 589         }
 590         create_copy($mgr, $volume, $lid) or return 0;
 591     }
 592
 593     return { li => $li, new_bib => $new_bib };
 594 }
 595
 596 sub create_bib {
 597     my($mgr, $li) = @_;
 598
 599     my $record = OpenILS::Application::Cat::BibCommon->biblio_record_xml_import(
 600         $mgr->editor,
 601         $li->marc,
 602         undef,
 603         undef,
 604         1, # override tcn collisions
 605         1, # no-ingest
 606         undef # $rec->bib_source
 607     );
 608
 609     if($U->event_code($record)) {
 610         $mgr->editor->event($record);
 611         $mgr->editor->rollback;
 612         return 0;
 613     }
 614
 615     $li->eg_bib_id($record->id);
 616     $mgr->add_bib;
 617     return update_lineitem($mgr, $li);
 618 }
 619
 620 sub create_volume {
 621     my($mgr, $li, $lid) = @_;
 622
 623     my ($volume, $evt) =
 624         OpenILS::Application::Cat::AssetCommon->find_or_create_volume(
 625             $mgr->editor,
 626             $lid->cn_label,
 627             $li->eg_bib_id,
 628             $lid->owning_lib
 629         );
 630
 631     if($evt) {
 632         $mgr->editor->event($evt);
 633         return 0;
 634     }
 635
 636     return $volume;
 637 }
 638
 639 sub create_copy {
 640     my($mgr, $volume, $lid) = @_;
 641     my $copy = Fieldmapper::asset::copy->new;
 642     $copy->isnew(1);
 643     $copy->loan_duration(2);
 644     $copy->fine_level(2);
 645     $copy->status(OILS_COPY_STATUS_ON_ORDER);
 646     $copy->barcode($lid->barcode);
 647     $copy->location($lid->location);
 648     $copy->call_number($volume->id);
 649     $copy->circ_lib($volume->owning_lib);
 650     $copy->circ_modifier($lid->circ_modifier);
 651
 652     my $evt = OpenILS::Application::Cat::AssetCommon->create_copy($mgr->editor, $volume, $copy);
 653     if($evt) {
 654         $mgr->editor->event($evt);
 655         return 0;
 656     }
 657
 658     $mgr->add_copy;
 659     $lid->eg_copy_id($copy->id);
 660     $mgr->editor->update_acq_lineitem_detail($lid) or return 0;
 661 }
 662
 663
 664
 665
 666
 667
 668 # ----------------------------------------------------------------------------
 669 # Workflow: Build a selection list from a Z39.50 search
 670 # ----------------------------------------------------------------------------
 671
 672 __PACKAGE__->register_method(
 673         method => 'zsearch',
 674         api_name => 'open-ils.acq.picklist.search.z3950',
 675     stream => 1,
 676         signature => {
 677         desc => 'Performs a z3950 federated search and creates a picklist and associated lineitems',
 678         params => [
 679             {desc => 'Authentication token', type => 'string'},
 680             {desc => 'Search definition', type => 'object'},
 681             {desc => 'Picklist name, optional', type => 'string'},
 682         ]
 683     }
 684 );
 685
 686 sub zsearch {
 687     my($self, $conn, $auth, $search, $name, $options) = @_;
 688     my $e = new_editor(authtoken=>$auth);
 689     return $e->event unless $e->checkauth;
 690     return $e->event unless $e->allowed('CREATE_PICKLIST');
 691
 692     $search->{limit} ||= 10;
 693     $options ||= {};
 694
 695     my $ses = OpenSRF::AppSession->create('open-ils.search');
 696     my $req = $ses->request('open-ils.search.z3950.search_class', $auth, $search);
 697
 698     my $first = 1;
 699     my $picklist;
 700     my $mgr;
 701     while(my $resp = $req->recv(timeout=>60)) {
 702
 703         if($first) {
 704             my $e = new_editor(requestor=>$e->requestor, xact=>1);
 705             $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
 706             $picklist = zsearch_build_pl($mgr, $name);
 707             $first = 0;
 708         }
 709
 710         my $result = $resp->content;
 711         my $count = $result->{count};
 712         $mgr->total( (($count < $search->{limit}) ? $count : $search->{limit})+1 );
 713
 714         for my $rec (@{$result->{records}}) {
 715
 716             my $li = create_lineitem($mgr,
 717                 picklist => $picklist->id,
 718                 source_label => $result->{service},
 719                 marc => $rec->{marcxml},
 720                 eg_bib_id => $rec->{bibid}
 721             );
 722
 723             if($$options{respond_li}) {
 724                 $li->attributes($mgr->editor->search_acq_lineitem_attr({lineitem => $li->id}))
 725                     if $$options{flesh_attrs};
 726                 $li->clear_marc if $$options{clear_marc};
 727                 $mgr->respond(lineitem => $li);
 728             } else {
 729                 $mgr->respond;
 730             }
 731         }
 732     }
 733
 734     $mgr->editor->commit;
 735     return $mgr->respond_complete;
 736 }
 737
 738 sub zsearch_build_pl {
 739     my($mgr, $name) = @_;
 740     $name ||= '';
 741
 742     my $picklist = $mgr->editor->search_acq_picklist({
 743         owner => $mgr->editor->requestor->id,
 744         name => $name
 745     })->[0];
 746
 747     if($name eq '' and $picklist) {
 748         return 0 unless delete_picklist($mgr, $picklist);
 749         $picklist = undef;
 750     }
 751
 752     return update_picklist($mgr, $picklist) if $picklist;
 753     return create_picklist($mgr, name => $name);
 754 }
 755
 756
 757 # ----------------------------------------------------------------------------
 758 # Workflow: Build a selection list / PO by importing a batch of MARC records
 759 # ----------------------------------------------------------------------------
 760
 761 __PACKAGE__->register_method(
 762     method => 'upload_records',
 763     api_name => 'open-ils.acq.process_upload_records',
 764     stream => 1,
 765 );
 766
 767 sub upload_records {
 768     my($self, $conn, $auth, $key) = @_;
 769
 770         my $e = new_editor(authtoken => $auth, xact => 1);
 771     return $e->die_event unless $e->checkauth;
 772
 773     my $mgr = OpenILS::Application::Acq::BatchManager->new(
 774         editor => $e,
 775         conn => $conn,
 776         throttle => 5
 777     );
 778
 779     my $cache = OpenSRF::Utils::Cache->new;
 780
 781     my $data = $cache->get_cache("vandelay_import_spool_$key");
 782         my $purpose = $data->{purpose};
 783     my $filename = $data->{path};
 784     my $provider = $data->{provider};
 785     my $picklist = $data->{picklist};
 786     my $create_po = $data->{create_po};
 787     my $ordering_agency = $data->{ordering_agency};
 788     my $create_assets = $data->{create_assets};
 789     my $po;
 790     my $evt;
 791
 792     unless(-r $filename) {
 793         $logger->error("unable to read MARC file $filename");
 794         $e->rollback;
 795         return OpenILS::Event->new('FILE_UPLOAD_ERROR', payload => {filename => $filename});
 796     }
 797
 798     $provider = $e->retrieve_acq_provider($provider) or return $e->die_event;
 799
 800     if($picklist) {
 801         $picklist = $e->retrieve_acq_picklist($picklist) or return $e->die_event;
 802         if($picklist->owner != $e->requestor->id) {
 803             return $e->die_event unless
 804                 $e->allowed('CREATE_PICKLIST', $picklist->org_unit, $picklist);
 805         }
 806     }
 807
 808     if($create_po) {
 809         $po = create_purchase_order($mgr,
 810             ordering_agency => $ordering_agency,
 811             provider => $provider->id
 812         ) or return $mgr->editor->die_event;
 813     }
 814
 815     $logger->info("acq processing MARC file=$filename");
 816
 817     my $marctype = 'USMARC'; # ?
 818         my $batch = new MARC::Batch ($marctype, $filename);
 819         $batch->strict_off;
 820
 821         my $count = 0;
 822     my @li_list;
 823
 824         while(1) {
 825
 826             my $err;
 827         my $xml;
 828                 $count++;
 829         my $r;
 830
 831                 try {
 832             $r = $batch->next;
 833         } catch Error with {
 834             $err = shift;
 835                         $logger->warn("Proccessing of record $count in set $key failed with error $err.  Skipping this record");
 836         };
 837
 838         next if $err;
 839         last unless $r;
 840
 841                 try {
 842             ($xml = $r->as_xml_record()) =~ s/\n//sog;
 843             $xml =~ s/^<\?xml.+\?\s*>//go;
 844             $xml =~ s/>\s+</></go;
 845             $xml =~ s/\p{Cc}//go;
 846             $xml = $U->entityize($xml);
 847             $xml =~ s/[\x00-\x1f]//go;
 848
 849                 } catch Error with {
 850                         $err = shift;
 851                         $logger->warn("Proccessing XML of record $count in set $key failed with error $err.  Skipping this record");
 852                 };
 853
 854         next if $err or not $xml;
 855
 856         my %args = (
 857             source_label => $provider->code,
 858             provider => $provider->id,
 859             marc => $xml,
 860         );
 861
 862         $args{picklist} = $picklist->id if $picklist;
 863         if($po) {
 864             $args{purchase_order} = $po->id;
 865             $args{state} = 'on-order';
 866         }
 867
 868         my $li = create_lineitem($mgr, %args) or return $mgr->editor->die_event;
 869         $mgr->respond;
 870         $li->provider($provider); # flesh it, we'll need it later
 871
 872         import_lineitem_details($mgr, $ordering_agency, $li) or return $mgr->editor->die_event;
 873         $mgr->respond;
 874
 875         push(@li_list, $li->id);
 876         $mgr->respond;
 877         }
 878
 879         $e->commit;
 880     unlink($filename);
 881     $cache->delete_cache('vandelay_import_spool_' . $key);
 882
 883     if($create_assets) {
 884         create_lineitem_list_assets($mgr, \@li_list) or return $e->die_event;
 885     }
 886
 887     return $mgr->respond_complete;
 888 }
 889
 890 sub import_lineitem_details {
 891     my($mgr, $ordering_agency, $li) = @_;
 892
 893     my $holdings = $mgr->editor->json_query({from => ['acq.extract_provider_holding_data', $li->id]});
 894     return 1 unless @$holdings;
 895     my $org_path = $U->get_org_ancestors($ordering_agency);
 896     $org_path = [ reverse (@$org_path) ];
 897     my $price;
 898
 899     my $idx = 1;
 900     while(1) {
 901         # create a lineitem detail for each copy in the data
 902
 903         my $compiled = extract_lineitem_detail_data($mgr, $org_path, $holdings, $idx);
 904         last unless defined $compiled;
 905         return 0 unless $compiled;
 906
 907         # this takes the price of the last copy and uses it as the lineitem price
 908         # need to determine if a given record would include different prices for the same item
 909         $price = $$compiled{price};
 910
 911         for(1..$$compiled{quantity}) {
 912             my $lid = create_lineitem_detail($mgr,
 913                 lineitem => $li->id,
 914                 owning_lib => $$compiled{owning_lib},
 915                 cn_label => $$compiled{call_number},
 916                 fund => $$compiled{fund},
 917                 circ_modifier => $$compiled{circ_modifier},
 918                 note => $$compiled{note},
 919                 location => $$compiled{copy_location}
 920             ) or return 0;
 921         }
 922
 923         $mgr->respond;
 924         $idx++;
 925     }
 926
 927     # set the price attr so we'll know the source of the price
 928     set_lineitem_attr(
 929         $mgr,
 930         attr_name => 'estimated_price',
 931         attr_type => 'lineitem_local_attr_definition',
 932         attr_value => $price,
 933         lineitem => $li->id
 934     ) or return 0;
 935
 936     # if we're creating a purchase order, create the debits
 937     if($li->purchase_order) {
 938         create_lineitem_debits($mgr, $li, $price, 2) or return 0;
 939         $mgr->respond;
 940     }
 941
 942     return 1;
 943 }
 944
 945 # return hash on success, 0 on error, undef on no more holdings
 946 sub extract_lineitem_detail_data {
 947     my($mgr, $org_path, $holdings, $index) = @_;
 948
 949     my @data_list = grep { $_->{holding} eq $index } @$holdings;
 950     return undef unless @data_list;
 951
 952     my %compiled = map { $_->{attr} => $_->{data} } @data_list;
 953     my $base_org = $$org_path[0];
 954
 955     my $killme = sub {
 956         my $msg = shift;
 957         $logger->error("Item import extraction error: $msg");
 958         $logger->error('Holdings Data: ' . OpenSRF::Utils::JSON->perl2JSON(\%compiled));
 959         $mgr->editor->rollback;
 960         $mgr->editor->event(OpenILS::Event->new('ACQ_IMPORT_ERROR', payload => $msg));
 961         return 0;
 962     };
 963
 964     $compiled{quantity} ||= 1;
 965
 966     # ---------------------------------------------------------------------
 967     # Fund
 968     my $code = $compiled{fund_code};
 969     return $killme->('no fund code provided') unless $code;
 970
 971     my $fund = $mgr->cache($base_org, "fund.$code");
 972     unless($fund) {
 973         # search up the org tree for the most appropriate fund
 974         for my $org (@$org_path) {
 975             $fund = $mgr->editor->search_acq_fund(
 976                 {org => $org, code => $code, year => DateTime->now->year}, {idlist => 1})->[0];
 977             last if $fund;
 978         }
 979     }
 980     return $killme->("no fund with code $code at orgs [@$org_path]") unless $fund;
 981     $compiled{fund} = $fund;
 982     $mgr->cache($base_org, "fund.$code", $fund);
 983
 984
 985     # ---------------------------------------------------------------------
 986     # Owning lib
 987     my $sn = $compiled{owning_lib};
 988     return $killme->('no owning_lib defined') unless $sn;
 989     my $org_id =
 990         $mgr->cache($base_org, "orgsn.$sn") ||
 991             $mgr->editor->search_actor_org_unit({shortname => $sn}, {idlist => 1})->[0];
 992     return $killme->("invalid owning_lib defined: $sn") unless $org_id;
 993     $compiled{owning_lib} = $org_id;
 994     $mgr->cache($$org_path[0], "orgsn.$sn", $org_id);
 995
 996
 997     # ---------------------------------------------------------------------
 998     # Circ Modifier
 999     my $mod;
1000     $code = $compiled{circ_modifier};
1001
1002     if($code) {
1003
1004         $mod = $mgr->cache($base_org, "mod.$code") ||
1005             $mgr->editor->retrieve_config_circ_modifier($code);
1006         return $killme->("invlalid circ_modifier $code") unless $mod;
1007         $mgr->cache($base_org, "mod.$code", $mod);
1008
1009     } else {
1010         # try the default
1011         $mod = get_default_circ_modifier($mgr, $base_org)
1012             or return $killme->('no circ_modifier defined');
1013     }
1014
1015     $compiled{circ_modifier} = $mod;
1016
1017
1018     # ---------------------------------------------------------------------
1019     # Shelving Location
1020     my $name = $compiled{copy_location};
1021     return $killme->('no copy_location defined') unless $name;
1022     my $loc = $mgr->cache($base_org, "copy_loc.$name");
1023     unless($loc) {
1024         for my $org (@$org_path) {
1025             $loc = $mgr->editor->search_asset_copy_location(
1026                 {owning_lib => $org, name => $name}, {idlist => 1})->[0];
1027             last if $loc;
1028         }
1029     }
1030     return $killme->("Invalid copy location $name") unless $loc;
1031     $compiled{copy_location} = $loc;
1032     $mgr->cache($base_org, "copy_loc.$name", $loc);
1033
1034     return \%compiled;
1035 }
1036
1037
1038
1039 # ----------------------------------------------------------------------------
1040 # Workflow: Given an existing purchase order, import/create the bibs,
1041 # callnumber and copy objects
1042 # ----------------------------------------------------------------------------
1043
1044 __PACKAGE__->register_method(
1045         method => 'create_po_assets',
1046         api_name        => 'open-ils.acq.purchase_order.assets.create',
1047         signature => {
1048         desc => q/Creates assets for each lineitem in the purchase order/,
1049         params => [
1050             {desc => 'Authentication token', type => 'string'},
1051             {desc => 'The purchase order id', type => 'number'},
1052         ],
1053         return => {desc => 'Streams a total versus completed counts object, event on error'}
1054     }
1055 );
1056
1057 sub create_po_assets {
1058     my($self, $conn, $auth, $po_id) = @_;
1059     my $e = new_editor(authtoken=>$auth, xact=>1);
1060     return $e->die_event unless $e->checkauth;
1061
1062     my $mgr = OpenILS::Application::Acq::BatchManager->new(
1063         editor => $e,
1064         conn => $conn,
1065         throttle => 5
1066     );
1067
1068     my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->die_event;
1069     return $e->die_event unless $e->allowed('IMPORT_PURCHASE_ORDER_ASSETS', $po->ordering_agency);
1070
1071     my $li_ids = $e->search_acq_lineitem({purchase_order => $po_id}, {idlist => 1});
1072
1073     # it's ugly, but it's fast.  Get the total count of lineitem detail objects to process
1074     my $lid_total = $e->json_query({
1075         select => { acqlid => [{aggregate => 1, transform => 'count', column => 'id'}] },
1076         from => {
1077             acqlid => {
1078                 jub => {
1079                     fkey => 'lineitem',
1080                     field => 'id',
1081                     join => {acqpo => {fkey => 'purchase_order', field => 'id'}}
1082                 }
1083             }
1084         },
1085         where => {'+acqpo' => {id => $po_id}}
1086     })->[0]->{id};
1087
1088     $mgr->total(scalar(@$li_ids) + $lid_total);
1089
1090     create_lineitem_list_assets($mgr, $li_ids) or return $e->die_event;
1091
1092     $e->xact_begin;
1093     update_purchase_order($mgr, $po) or return $e->die_event;
1094     $e->commit;
1095
1096     return $mgr->respond_complete;
1097 }
1098
1099
1100
1101 __PACKAGE__->register_method(
1102         method => 'create_purchase_order_api',
1103         api_name        => 'open-ils.acq.purchase_order.create',
1104         signature => {
1105         desc => 'Creates a new purchase order',
1106         params => [
1107             {desc => 'Authentication token', type => 'string'},
1108             {desc => 'purchase_order to create', type => 'object'}
1109         ],
1110         return => {desc => 'The purchase order id, Event on failure'}
1111     }
1112 );
1113
1114 sub create_purchase_order_api {
1115     my($self, $conn, $auth, $po, $args) = @_;
1116     $args ||= {};
1117
1118     my $e = new_editor(xact=>1, authtoken=>$auth);
1119     return $e->die_event unless $e->checkauth;
1120     return $e->die_event unless $e->allowed('CREATE_PURCHASE_ORDER', $po->ordering_agency);
1121
1122     my $mgr = OpenILS::Application::Acq::BatchManager->new(
1123         editor => $e,
1124         conn => $conn,
1125         throttle => 5
1126     );
1127
1128     # create the PO
1129     my %pargs = (ordering_agency => $e->requestor->ws_ou);
1130     $pargs{provider} = $po->provider if $po->provider;
1131     $po = create_purchase_order($mgr, %pargs) or return $e->die_event;
1132
1133     my $li_ids = $$args{lineitems};
1134
1135     if($li_ids) {
1136
1137         for my $li_id (@$li_ids) {
1138
1139             my $li = $e->retrieve_acq_lineitem([
1140                 $li_id,
1141                 {flesh => 1, flesh_fields => {jub => ['attributes']}}
1142             ]) or return $e->die_event;
1143
1144             $li->provider($po->provider);
1145             $li->purchase_order($po->id);
1146             update_lineitem($mgr, $li) or return $e->die_event;
1147             $mgr->respond;
1148
1149             create_lineitem_debits($mgr, $li) or return $e->die_event;
1150         }
1151     }
1152
1153     # commit before starting the asset creation
1154     $e->xact_commit;
1155
1156     if($li_ids and $$args{create_assets}) {
1157         create_lineitem_list_assets($mgr, $li_ids) or return $e->die_event;
1158     }
1159
1160     return $mgr->respond_complete;
1161 }
1162
1163
1164 1;