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     $self->throttle(5) unless $self->throttle;
  25     return $self;
  26 }
  27
  28 sub conn {
  29     my($self, $val) = @_;
  30     $self->{conn} = $val if $val;
  31     return $self->{conn};
  32 }
  33 sub throttle {
  34     my($self, $val) = @_;
  35     $self->{throttle} = $val if $val;
  36     return $self->{throttle};
  37 }
  38 sub respond {
  39     my($self, %other_args) = @_;
  40     if($self->throttle and not %other_args) {
  41         return unless (
  42             ($self->{args}->{progress} - $self->{last_respond_progress}) >= $self->throttle
  43         );
  44     }
  45     $self->conn->respond({ %{$self->{args}}, %other_args });
  46     $self->{last_respond_progress} = $self->{args}->{progress};
  47 }
  48 sub respond_complete {
  49     my($self, %other_args) = @_;
  50     $self->complete;
  51     $self->conn->respond_complete({ %{$self->{args}}, %other_args });
  52     return undef;
  53 }
  54 sub total {
  55     my($self, $val) = @_;
  56     $self->{args}->{total} = $val if defined $val;
  57     $self->{args}->{maximum} = $self->{args}->{total};
  58     return $self->{args}->{total};
  59 }
  60 sub purchase_order {
  61     my($self, $val) = @_;
  62     $self->{args}->{purchase_order} = $val if $val;
  63     return $self;
  64 }
  65 sub picklist {
  66     my($self, $val) = @_;
  67     $self->{args}->{picklist} = $val if $val;
  68     return $self;
  69 }
  70 sub add_lid {
  71     my $self = shift;
  72     $self->{args}->{lid} += 1;
  73     $self->{args}->{progress} += 1;
  74     return $self;
  75 }
  76 sub add_li {
  77     my $self = shift;
  78     $self->{args}->{li} += 1;
  79     $self->{args}->{progress} += 1;
  80     return $self;
  81 }
  82 sub add_copy {
  83     my $self = shift;
  84     $self->{args}->{copies} += 1;
  85     $self->{args}->{progress} += 1;
  86     return $self;
  87 }
  88 sub add_bib {
  89     my $self = shift;
  90     $self->{args}->{bibs} += 1;
  91     $self->{args}->{progress} += 1;
  92     return $self;
  93 }
  94 sub add_debit {
  95     my($self, $amount) = @_;
  96     $self->{args}->{debits_accrued} += $amount;
  97     $self->{args}->{progress} += 1;
  98     return $self;
  99 }
 100 sub editor {
 101     my($self, $editor) = @_;
 102     $self->{editor} = $editor if defined $editor;
 103     return $self->{editor};
 104 }
 105 sub complete {
 106     my $self = shift;
 107     $self->{args}->{complete} = 1;
 108     return $self;
 109 }
 110
 111 sub ingest_ses {
 112     my($self, $val) = @_;
 113     $self->{ingest_ses} = $val if $val;
 114     return $self->{ingest_ses};
 115 }
 116
 117 sub push_ingest_queue {
 118     my($self, $rec_id) = @_;
 119
 120     $self->ingest_ses(OpenSRF::AppSession->connect('open-ils.ingest'))
 121         unless $self->ingest_ses;
 122
 123     my $req = $self->ingest_ses->request('open-ils.ingest.full.biblio.record', $rec_id);
 124
 125     push(@{$self->{ingest_queue}}, $req);
 126 }
 127
 128 sub process_ingest_records {
 129     my $self = shift;
 130     return unless @{$self->{ingest_queue}};
 131
 132     for my $req (@{$self->{ingest_queue}}) {
 133
 134         try {
 135             $req->gather(1);
 136             $self->{args}->{indexed} += 1;
 137             $self->{args}->{progress} += 1;
 138         } otherwise {};
 139
 140         $self->respond;
 141     }
 142     $self->ingest_ses->disconnect;
 143 }
 144
 145
 146 sub cache {
 147     my($self, $org, $key, $val) = @_;
 148     $self->{cache}->{$org} = {} unless $self->{cache}->{org};
 149     $self->{cache}->{$org}->{$key} = $val if defined $val;
 150     return $self->{cache}->{$org}->{$key};
 151 }
 152
 153
 154 package OpenILS::Application::Acq::Order;
 155 use base qw/OpenILS::Application/;
 156 use strict; use warnings;
 157 # ----------------------------------------------------------------------------
 158 # Break up each component of the order process and pieces into managable
 159 # actions that can be shared across different workflows
 160 # ----------------------------------------------------------------------------
 161 use OpenILS::Event;
 162 use OpenSRF::Utils::Logger qw(:logger);
 163 use OpenSRF::Utils::JSON;
 164 use OpenILS::Utils::Fieldmapper;
 165 use OpenILS::Utils::CStoreEditor q/:funcs/;
 166 use OpenILS::Const qw/:const/;
 167 use OpenSRF::EX q/:try/;
 168 use OpenILS::Application::AppUtils;
 169 use OpenILS::Application::Cat::BibCommon;
 170 use OpenILS::Application::Cat::AssetCommon;
 171 use MARC::Record;
 172 use MARC::Batch;
 173 use MARC::File::XML;
 174 my $U = 'OpenILS::Application::AppUtils';
 175
 176
 177 # ----------------------------------------------------------------------------
 178 # Lineitem
 179 # ----------------------------------------------------------------------------
 180 sub create_lineitem {
 181     my($mgr, %args) = @_;
 182     my $li = Fieldmapper::acq::lineitem->new;
 183     $li->creator($mgr->editor->requestor->id);
 184     $li->selector($li->creator);
 185     $li->editor($li->creator);
 186     $li->create_time('now');
 187     $li->edit_time('now');
 188     $li->state('new');
 189     $li->$_($args{$_}) for keys %args;
 190     $li->clear_id;
 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     $mgr->add_li;
 200     return $li if $mgr->editor->update_acq_lineitem($li);
 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     # delete the attached lineitem_details
 209     my $lid_ids = $mgr->editor->search_acq_lineitem_detail({lineitem => $li->id}, {idlist=>1});
 210     for my $lid_id (@$lid_ids) {
 211         return 0 unless delete_lineitem_detail($mgr, $lid_id);
 212     }
 213
 214     $mgr->add_li;
 215     return $mgr->editor->delete_acq_lineitem($li);
 216 }
 217
 218 # begins and commit transactions as it goes
 219 sub create_lineitem_list_assets {
 220     my($mgr, $li_ids) = @_;
 221     return undef if check_import_li_marc_perms($mgr, $li_ids);
 222
 223     # create the bibs/volumes/copies and ingest the records
 224     for my $li_id (@$li_ids) {
 225         $mgr->editor->xact_begin;
 226         my $data = create_lineitem_assets($mgr, $li_id) or return undef;
 227         $mgr->editor->xact_commit;
 228         $mgr->push_ingest_queue($data->{li}->eg_bib_id) if $data->{new_bib};
 229         $mgr->respond;
 230     }
 231     $mgr->process_ingest_records;
 232     return 1;
 233 }
 234
 235 # returns event on error, undef on success
 236 sub check_import_li_marc_perms {
 237     my($mgr, $li_ids) = @_;
 238
 239     # if there are any order records that are not linked to
 240     # in-db bib records, verify staff has perms to import order records
 241     my $order_li = $mgr->editor->search_acq_lineitem(
 242         [{id => $li_ids, eg_bib_id => undef}, {limit => 1}], {idlist => 1})->[0];
 243
 244     if($order_li) {
 245         return $mgr->editor->die_event unless
 246             $mgr->editor->allowed('IMPORT_ACQ_LINEITEM_BIB_RECORD');
 247     }
 248
 249     return undef;
 250 }
 251
 252
 253 # ----------------------------------------------------------------------------
 254 # if all of the lineitem details for this lineitem have
 255 # been received, mark the lineitem as received
 256 # returns 1 on non-received, li on received, 0 on error
 257 # ----------------------------------------------------------------------------
 258 sub check_lineitem_received {
 259     my($mgr, $li_id) = @_;
 260
 261     my $non_recv = $mgr->editor->search_acq_lineitem_detail(
 262         {recv_time => undef, lineitem => $li_id}, {idlist=>1});
 263
 264     return 1 if @$non_recv;
 265
 266     my $li = $mgr->editor->retrieve_acq_lineitem($li_id);
 267     $li->state('received');
 268     return update_lineitem($mgr, $li);
 269 }
 270
 271 sub receive_lineitem {
 272     my($mgr, $li_id, $skip_complete_check) = @_;
 273     my $li = $mgr->editor->retrieve_acq_lineitem($li_id) or return 0;
 274
 275     my $lid_ids = $mgr->editor->search_acq_lineitem_detail(
 276         {lineitem => $li_id, recv_time => undef}, {idlist => 1});
 277
 278     for my $lid_id (@$lid_ids) {
 279        receive_lineitem_detail($mgr, $lid_id, 1) or return 0;
 280     }
 281
 282     $mgr->add_li;
 283     $li->state('received');
 284     update_lineitem($mgr, $li) or return 0;
 285     return 1 if $skip_complete_check;
 286
 287     return check_purchase_order_received($mgr, $li->purchase_order);
 288 }
 289
 290 sub rollback_receive_lineitem {
 291     my($mgr, $li_id) = @_;
 292     my $li = $mgr->editor->retrieve_acq_lineitem($li_id) or return 0;
 293
 294     my $lid_ids = $mgr->editor->search_acq_lineitem_detail(
 295         {lineitem => $li_id, recv_time => {'!=' => undef}}, {idlist => 1});
 296
 297     for my $lid_id (@$lid_ids) {
 298        rollback_receive_lineitem_detail($mgr, $lid_id, 1) or return 0;
 299     }
 300
 301     $mgr->add_li;
 302     $li->state('on-order');
 303     return update_lineitem($mgr, $li);
 304 }
 305
 306 # ----------------------------------------------------------------------------
 307 # Lineitem Detail
 308 # ----------------------------------------------------------------------------
 309 sub create_lineitem_detail {
 310     my($mgr, %args) = @_;
 311     my $lid = Fieldmapper::acq::lineitem_detail->new;
 312     $lid->$_($args{$_}) for keys %args;
 313     $lid->clear_id;
 314     $mgr->add_lid;
 315     return $mgr->editor->create_acq_lineitem_detail($lid);
 316 }
 317
 318
 319 # flesh out any required data with default values where appropriate
 320 sub complete_lineitem_detail {
 321     my($mgr, $lid) = @_;
 322     unless($lid->barcode) {
 323         my $pfx = $U->ou_ancestor_setting_value($lid->owning_lib, 'acq.tmp_barcode_prefix') || 'ACQ';
 324         $lid->barcode($pfx.$lid->id);
 325     }
 326
 327     unless($lid->cn_label) {
 328         my $pfx = $U->ou_ancestor_setting_value($lid->owning_lib, 'acq.tmp_callnumber_prefix') || 'ACQ';
 329         $lid->cn_label($pfx.$lid->id);
 330     }
 331
 332     if(!$lid->location and my $loc = $U->ou_ancestor_setting_value($lid->owning_lib, 'acq.default_copy_location')) {
 333         $lid->location($loc);
 334     }
 335
 336     if(!$lid->circ_modifier and my $mod = get_default_circ_modifier($mgr, $lid->owning_lib)) {
 337         $lid->circ_modifier($mod);
 338     }
 339
 340     $mgr->editor->update_acq_lineitem_detail($lid) or return 0;
 341     return $lid;
 342 }
 343
 344 sub get_default_circ_modifier {
 345     my($mgr, $org) = @_;
 346     my $mod = $mgr->cache($org, 'def_circ_mod');
 347     return $mod if $mod;
 348     $mod = $U->ou_ancestor_setting_value($org, 'acq.default_circ_modifier');
 349     return $mgr->cache($org, 'def_circ_mod', $mod) if $mod;
 350     return undef;
 351 }
 352
 353 sub delete_lineitem_detail {
 354     my($mgr, $lid) = @_;
 355     $lid = $mgr->editor->retrieve_acq_lineitem_detail($lid) unless ref $lid;
 356     return $mgr->editor->delete_acq_lineitem_detail($lid);
 357 }
 358
 359
 360 sub receive_lineitem_detail {
 361     my($mgr, $lid_id, $skip_complete_check) = @_;
 362     my $e = $mgr->editor;
 363
 364     my $lid = $e->retrieve_acq_lineitem_detail([
 365         $lid_id,
 366         {   flesh => 1,
 367             flesh_fields => {
 368                 acqlid => ['fund_debit']
 369             }
 370         }
 371     ]) or return 0;
 372
 373     return 1 if $lid->recv_time;
 374
 375     $lid->recv_time('now');
 376     $e->update_acq_lineitem_detail($lid) or return 0;
 377
 378     my $copy = $e->retrieve_asset_copy($lid->eg_copy_id) or return 0;
 379     $copy->status(OILS_COPY_STATUS_IN_PROCESS);
 380     $copy->edit_date('now');
 381     $copy->editor($e->requestor->id);
 382     $e->update_asset_copy($copy) or return 0;
 383
 384     if($lid->fund_debit) {
 385         $lid->fund_debit->encumbrance('f');
 386         $e->update_acq_fund_debit($lid->fund_debit) or return 0;
 387     }
 388
 389     $mgr->add_lid;
 390
 391     return 1 if $skip_complete_check;
 392
 393     my $li = check_lineitem_received($mgr, $lid->lineitem) or return 0;
 394     return 1 if $li == 1; # li not received
 395
 396     return check_purchase_order_received($mgr, $li->purchase_order);
 397 }
 398
 399
 400 sub rollback_receive_lineitem_detail {
 401     my($mgr, $lid_id) = @_;
 402     my $e = $mgr->editor;
 403
 404     my $lid = $e->retrieve_acq_lineitem_detail([
 405         $lid_id,
 406         {   flesh => 1,
 407             flesh_fields => {
 408                 acqlid => ['fund_debit']
 409             }
 410         }
 411     ]) or return 0;
 412
 413     return 1 unless $lid->recv_time;
 414
 415     $lid->clear_recv_time;
 416     $e->update_acq_lineitem_detail($lid) or return 0;
 417
 418     my $copy = $e->retrieve_asset_copy($lid->eg_copy_id) or return 0;
 419     $copy->status(OILS_COPY_STATUS_ON_ORDER);
 420     $copy->edit_date('now');
 421     $copy->editor($e->requestor->id);
 422     $e->update_asset_copy($copy) or return 0;
 423
 424     if($lid->fund_debit) {
 425         $lid->fund_debit->encumbrance('t');
 426         $e->update_acq_fund_debit($lid->fund_debit) or return 0;
 427     }
 428
 429     $mgr->add_lid;
 430     return $lid;
 431 }
 432
 433 # ----------------------------------------------------------------------------
 434 # Lineitem Attr
 435 # ----------------------------------------------------------------------------
 436 sub set_lineitem_attr {
 437     my($mgr, %args) = @_;
 438     my $attr_type = $args{attr_type};
 439
 440     # first, see if it's already set.  May just need to overwrite it
 441     my $attr = $mgr->editor->search_acq_lineitem_attr({
 442         lineitem => $args{lineitem},
 443         attr_type => $args{attr_type},
 444         attr_name => $args{attr_name}
 445     })->[0];
 446
 447     if($attr) {
 448         $attr->attr_value($args{attr_value});
 449         return $attr if $mgr->editor->update_acq_lineitem_attr($attr);
 450         return undef;
 451
 452     } else {
 453
 454         $attr = Fieldmapper::acq::lineitem_attr->new;
 455         $attr->$_($args{$_}) for keys %args;
 456
 457         unless($attr->definition) {
 458             my $find = "search_acq_$attr_type";
 459             my $attr_def_id = $mgr->editor->$find({code => $attr->attr_name}, {idlist=>1})->[0] or return 0;
 460             $attr->definition($attr_def_id);
 461         }
 462         return $mgr->editor->create_acq_lineitem_attr($attr);
 463     }
 464 }
 465
 466 sub get_li_price {
 467     my $li = shift;
 468     my $attrs = $li->attributes;
 469     my ($marc_estimated, $local_estimated, $local_actual, $prov_estimated, $prov_actual);
 470
 471     for my $attr (@$attrs) {
 472         if($attr->attr_name eq 'estimated_price') {
 473             $local_estimated = $attr->attr_value
 474                 if $attr->attr_type eq 'lineitem_local_attr_definition';
 475             $prov_estimated = $attr->attr_value
 476                 if $attr->attr_type eq 'lineitem_prov_attr_definition';
 477             $marc_estimated = $attr->attr_value
 478                 if $attr->attr_type eq 'lineitem_marc_attr_definition';
 479
 480         } elsif($attr->attr_name eq 'actual_price') {
 481             $local_actual = $attr->attr_value
 482                 if $attr->attr_type eq 'lineitem_local_attr_definition';
 483             $prov_actual = $attr->attr_value
 484                 if $attr->attr_type eq 'lineitem_prov_attr_definition';
 485         }
 486     }
 487
 488     return ($local_actual, 1) if $local_actual;
 489     return ($prov_actual, 2) if $prov_actual;
 490     return ($local_estimated, 1) if $local_estimated;
 491     return ($prov_estimated, 2) if $prov_estimated;
 492     return ($marc_estimated, 3);
 493 }
 494
 495
 496 # ----------------------------------------------------------------------------
 497 # Lineitem Debits
 498 # ----------------------------------------------------------------------------
 499 sub create_lineitem_debits {
 500     my($mgr, $li, $price, $ptype) = @_;
 501
 502     ($price, $ptype) = get_li_price($li) unless $price;
 503
 504     unless($price) {
 505         $mgr->editor->event(OpenILS::Event->new('ACQ_LINEITEM_NO_PRICE', payload => $li->id));
 506         $mgr->editor->rollback;
 507         return 0;
 508     }
 509
 510     unless($li->provider) {
 511         $mgr->editor->event(OpenILS::Event->new('ACQ_LINEITEM_NO_PROVIDER', payload => $li->id));
 512         $mgr->editor->rollback;
 513         return 0;
 514     }
 515
 516     my $lid_ids = $mgr->editor->search_acq_lineitem_detail(
 517         {lineitem => $li->id},
 518         {idlist=>1}
 519     );
 520
 521     for my $lid_id (@$lid_ids) {
 522
 523         my $lid = $mgr->editor->retrieve_acq_lineitem_detail([
 524             $lid_id,
 525             {   flesh => 1,
 526                 flesh_fields => {acqlid => ['fund']}
 527             }
 528         ]);
 529
 530         create_lineitem_detail_debit($mgr, $li, $lid, $price, $ptype) or return 0;
 531     }
 532
 533     return 1;
 534 }
 535
 536
 537 # flesh li->provider
 538 # flesh lid->fund
 539 # ptype 1=local, 2=provider, 3=marc
 540 sub create_lineitem_detail_debit {
 541     my($mgr, $li, $lid, $price, $ptype) = @_;
 542
 543     unless(ref $li and ref $li->provider) {
 544        $li = $mgr->editor->retrieve_acq_lineitem([
 545             $li,
 546             {   flesh => 1,
 547                 flesh_fields => {jub => ['provider']},
 548             }
 549         ]);
 550     }
 551
 552     unless(ref $lid and ref $lid->fund) {
 553         $lid = $mgr->editor->retrieve_acq_lineitem_detail([
 554             $lid,
 555             {   flesh => 1,
 556                 flesh_fields => {acqlid => ['fund']}
 557             }
 558         ]);
 559     }
 560
 561     my $ctype = $lid->fund->currency_type;
 562     my $amount = $price;
 563
 564     if($ptype == 2) { # price from vendor
 565         $ctype = $li->provider->currency_type;
 566         $amount = currency_conversion($mgr, $ctype, $lid->fund->currency_type, $price);
 567     }
 568
 569     my $debit = create_fund_debit(
 570         $mgr,
 571         fund => $lid->fund->id,
 572         origin_amount => $price,
 573         origin_currency_type => $ctype,
 574         amount => $amount
 575     ) or return 0;
 576
 577     $lid->fund_debit($debit->id);
 578     $lid->fund($lid->fund->id);
 579     $mgr->editor->update_acq_lineitem_detail($lid) or return 0;
 580     return $debit;
 581 }
 582
 583
 584 # ----------------------------------------------------------------------------
 585 # Fund Debit
 586 # ----------------------------------------------------------------------------
 587 sub create_fund_debit {
 588     my($mgr, %args) = @_;
 589     my $debit = Fieldmapper::acq::fund_debit->new;
 590     $debit->debit_type('purchase');
 591     $debit->encumbrance('t');
 592     $debit->$_($args{$_}) for keys %args;
 593     $debit->clear_id;
 594     $mgr->add_debit($debit->amount);
 595     return $mgr->editor->create_acq_fund_debit($debit);
 596 }
 597
 598 sub currency_conversion {
 599     my($mgr, $src_currency, $dest_currency, $amount) = @_;
 600     my $result = $mgr->editor->json_query(
 601         {from => ['acq.exchange_ratio', $src_currency, $dest_currency, $amount]});
 602     return $result->[0]->{'acq.exchange_ratio'};
 603 }
 604
 605
 606 # ----------------------------------------------------------------------------
 607 # Picklist
 608 # ----------------------------------------------------------------------------
 609 sub create_picklist {
 610     my($mgr, %args) = @_;
 611     my $picklist = Fieldmapper::acq::picklist->new;
 612     $picklist->creator($mgr->editor->requestor->id);
 613     $picklist->owner($picklist->creator);
 614     $picklist->editor($picklist->creator);
 615     $picklist->create_time('now');
 616     $picklist->edit_time('now');
 617     $picklist->org_unit($mgr->editor->requestor->ws_ou);
 618     $picklist->owner($mgr->editor->requestor->id);
 619     $picklist->$_($args{$_}) for keys %args;
 620     $picklist->clear_id;
 621     $mgr->picklist($picklist);
 622     return $mgr->editor->create_acq_picklist($picklist);
 623 }
 624
 625 sub update_picklist {
 626     my($mgr, $picklist) = @_;
 627     $picklist = $mgr->editor->retrieve_acq_picklist($picklist) unless ref $picklist;
 628     $picklist->edit_time('now');
 629     $picklist->editor($mgr->editor->requestor->id);
 630     $mgr->picklist($picklist);
 631     return $picklist if $mgr->editor->update_acq_picklist($picklist);
 632     return undef;
 633 }
 634
 635 sub delete_picklist {
 636     my($mgr, $picklist) = @_;
 637     $picklist = $mgr->editor->retrieve_acq_picklist($picklist) unless ref $picklist;
 638
 639     # delete all 'new' lineitems
 640     my $li_ids = $mgr->editor->search_acq_lineitem({picklist => $picklist->id, state => 'new'}, {idlist => 1});
 641     for my $li_id (@$li_ids) {
 642         my $li = $mgr->editor->retrieve_acq_lineitem($li_id);
 643         return 0 unless delete_lineitem($mgr, $li);
 644         $mgr->respond;
 645     }
 646
 647     # detach all non-'new' lineitems
 648     $li_ids = $mgr->editor->search_acq_lineitem({picklist => $picklist->id, state => {'!=' => 'new'}}, {idlist => 1});
 649     for my $li_id (@$li_ids) {
 650         my $li = $mgr->editor->retrieve_acq_lineitem($li_id);
 651         $li->clear_picklist;
 652         return 0 unless update_lineitem($mgr, $li);
 653         $mgr->respond;
 654     }
 655
 656     # remove any picklist-specific object perms
 657     my $ops = $mgr->editor->search_permission_usr_object_perm_map({object_type => 'acqpl', object_id => ''.$picklist->id});
 658     for my $op (@$ops) {
 659         return 0 unless $mgr->editor->delete_usr_object_perm_map($op);
 660     }
 661
 662     return $mgr->editor->delete_acq_picklist($picklist);
 663 }
 664
 665 # ----------------------------------------------------------------------------
 666 # Purchase Order
 667 # ----------------------------------------------------------------------------
 668 sub update_purchase_order {
 669     my($mgr, $po) = @_;
 670     $po = $mgr->editor->retrieve_acq_purchase_order($po) unless ref $po;
 671     $po->editor($mgr->editor->requestor->id);
 672     $po->edit_time('now');
 673     $mgr->purchase_order($po);
 674     return $po if $mgr->editor->update_acq_purchase_order($po);
 675     return undef;
 676 }
 677
 678 sub create_purchase_order {
 679     my($mgr, %args) = @_;
 680     my $po = Fieldmapper::acq::purchase_order->new;
 681     $po->creator($mgr->editor->requestor->id);
 682     $po->editor($mgr->editor->requestor->id);
 683     $po->owner($mgr->editor->requestor->id);
 684     $po->edit_time('now');
 685     $po->create_time('now');
 686     $po->state('pending');
 687     $po->ordering_agency($mgr->editor->requestor->ws_ou);
 688     $po->$_($args{$_}) for keys %args;
 689     $po->clear_id;
 690     $mgr->purchase_order($po);
 691     return $mgr->editor->create_acq_purchase_order($po);
 692 }
 693
 694 # ----------------------------------------------------------------------------
 695 # if all of the lineitems for this PO are received,
 696 # mark the PO as received
 697 # ----------------------------------------------------------------------------
 698 sub check_purchase_order_received {
 699     my($mgr, $po_id) = @_;
 700
 701     my $non_recv_li = $mgr->editor->search_acq_lineitem(
 702         {   purchase_order => $po_id,
 703             state => {'!=' => 'received'}
 704         }, {idlist=>1});
 705
 706     return 1 if @$non_recv_li;
 707
 708     my $po = $mgr->editor->retrieve_acq_purchase_order($po_id);
 709     $po->state('received');
 710     return update_purchase_order($mgr, $po);
 711 }
 712
 713
 714 # ----------------------------------------------------------------------------
 715 # Bib, Callnumber, and Copy data
 716 # ----------------------------------------------------------------------------
 717
 718 sub create_lineitem_assets {
 719     my($mgr, $li_id) = @_;
 720     my $evt;
 721
 722     my $li = $mgr->editor->retrieve_acq_lineitem([
 723         $li_id,
 724         {   flesh => 1,
 725             flesh_fields => {jub => ['purchase_order', 'attributes']}
 726         }
 727     ]) or return 0;
 728
 729     # -----------------------------------------------------------------
 730     # first, create the bib record if necessary
 731     # -----------------------------------------------------------------
 732     my $new_bib = 0;
 733     unless($li->eg_bib_id) {
 734         create_bib($mgr, $li) or return 0;
 735         $new_bib = 1;
 736     }
 737
 738     my $li_details = $mgr->editor->search_acq_lineitem_detail({lineitem => $li_id}, {idlist=>1});
 739
 740     # -----------------------------------------------------------------
 741     # for each lineitem_detail, create the volume if necessary, create
 742     # a copy, and link them all together.
 743     # -----------------------------------------------------------------
 744     my $first_cn;
 745     for my $lid_id (@{$li_details}) {
 746
 747         my $lid = $mgr->editor->retrieve_acq_lineitem_detail($lid_id) or return 0;
 748         next if $lid->eg_copy_id;
 749
 750         # use the same callnumber label for all items within this lineitem
 751         $lid->cn_label($first_cn) if $first_cn and not $lid->cn_label;
 752
 753         # apply defaults if necessary
 754         return 0 unless complete_lineitem_detail($mgr, $lid);
 755
 756         $first_cn = $lid->cn_label unless $first_cn;
 757
 758         my $org = $lid->owning_lib;
 759         my $label = $lid->cn_label;
 760         my $bibid = $li->eg_bib_id;
 761
 762         my $volume = $mgr->cache($org, "cn.$bibid.$label");
 763         unless($volume) {
 764             $volume = create_volume($mgr, $li, $lid) or return 0;
 765             $mgr->cache($org, "cn.$bibid.$label", $volume);
 766         }
 767         create_copy($mgr, $volume, $lid) or return 0;
 768     }
 769
 770     return { li => $li, new_bib => $new_bib };
 771 }
 772
 773 sub create_bib {
 774     my($mgr, $li) = @_;
 775
 776     my $record = OpenILS::Application::Cat::BibCommon->biblio_record_xml_import(
 777         $mgr->editor,
 778         $li->marc,
 779         undef, # bib source
 780         undef,
 781         1, # override tcn collisions
 782     );
 783
 784     if($U->event_code($record)) {
 785         $mgr->editor->event($record);
 786         $mgr->editor->rollback;
 787         return 0;
 788     }
 789
 790     $li->eg_bib_id($record->id);
 791     $mgr->add_bib;
 792     return update_lineitem($mgr, $li);
 793 }
 794
 795 sub create_volume {
 796     my($mgr, $li, $lid) = @_;
 797
 798     my ($volume, $evt) =
 799         OpenILS::Application::Cat::AssetCommon->find_or_create_volume(
 800             $mgr->editor,
 801             $lid->cn_label,
 802             $li->eg_bib_id,
 803             $lid->owning_lib
 804         );
 805
 806     if($evt) {
 807         $mgr->editor->event($evt);
 808         return 0;
 809     }
 810
 811     return $volume;
 812 }
 813
 814 sub create_copy {
 815     my($mgr, $volume, $lid) = @_;
 816     my $copy = Fieldmapper::asset::copy->new;
 817     $copy->isnew(1);
 818     $copy->loan_duration(2);
 819     $copy->fine_level(2);
 820     $copy->status(OILS_COPY_STATUS_ON_ORDER);
 821     $copy->barcode($lid->barcode);
 822     $copy->location($lid->location);
 823     $copy->call_number($volume->id);
 824     $copy->circ_lib($volume->owning_lib);
 825     $copy->circ_modifier($lid->circ_modifier);
 826
 827     my $evt = OpenILS::Application::Cat::AssetCommon->create_copy($mgr->editor, $volume, $copy);
 828     if($evt) {
 829         $mgr->editor->event($evt);
 830         return 0;
 831     }
 832
 833     $mgr->add_copy;
 834     $lid->eg_copy_id($copy->id);
 835     $mgr->editor->update_acq_lineitem_detail($lid) or return 0;
 836 }
 837
 838
 839
 840
 841
 842
 843 # ----------------------------------------------------------------------------
 844 # Workflow: Build a selection list from a Z39.50 search
 845 # ----------------------------------------------------------------------------
 846
 847 __PACKAGE__->register_method(
 848         method => 'zsearch',
 849         api_name => 'open-ils.acq.picklist.search.z3950',
 850     stream => 1,
 851         signature => {
 852         desc => 'Performs a z3950 federated search and creates a picklist and associated lineitems',
 853         params => [
 854             {desc => 'Authentication token', type => 'string'},
 855             {desc => 'Search definition', type => 'object'},
 856             {desc => 'Picklist name, optional', type => 'string'},
 857         ]
 858     }
 859 );
 860
 861 sub zsearch {
 862     my($self, $conn, $auth, $search, $name, $options) = @_;
 863     my $e = new_editor(authtoken=>$auth);
 864     return $e->event unless $e->checkauth;
 865     return $e->event unless $e->allowed('CREATE_PICKLIST');
 866
 867     $search->{limit} ||= 10;
 868     $options ||= {};
 869
 870     my $ses = OpenSRF::AppSession->create('open-ils.search');
 871     my $req = $ses->request('open-ils.search.z3950.search_class', $auth, $search);
 872
 873     my $first = 1;
 874     my $picklist;
 875     my $mgr;
 876     while(my $resp = $req->recv(timeout=>60)) {
 877
 878         if($first) {
 879             my $e = new_editor(requestor=>$e->requestor, xact=>1);
 880             $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
 881             $picklist = zsearch_build_pl($mgr, $name);
 882             $first = 0;
 883         }
 884
 885         my $result = $resp->content;
 886         my $count = $result->{count};
 887         $mgr->total( (($count < $search->{limit}) ? $count : $search->{limit})+1 );
 888
 889         for my $rec (@{$result->{records}}) {
 890
 891             my $li = create_lineitem($mgr,
 892                 picklist => $picklist->id,
 893                 source_label => $result->{service},
 894                 marc => $rec->{marcxml},
 895                 eg_bib_id => $rec->{bibid}
 896             );
 897
 898             if($$options{respond_li}) {
 899                 $li->attributes($mgr->editor->search_acq_lineitem_attr({lineitem => $li->id}))
 900                     if $$options{flesh_attrs};
 901                 $li->clear_marc if $$options{clear_marc};
 902                 $mgr->respond(lineitem => $li);
 903             } else {
 904                 $mgr->respond;
 905             }
 906         }
 907     }
 908
 909     $mgr->editor->commit;
 910     return $mgr->respond_complete;
 911 }
 912
 913 sub zsearch_build_pl {
 914     my($mgr, $name) = @_;
 915     $name ||= '';
 916
 917     my $picklist = $mgr->editor->search_acq_picklist({
 918         owner => $mgr->editor->requestor->id,
 919         name => $name
 920     })->[0];
 921
 922     if($name eq '' and $picklist) {
 923         return 0 unless delete_picklist($mgr, $picklist);
 924         $picklist = undef;
 925     }
 926
 927     return update_picklist($mgr, $picklist) if $picklist;
 928     return create_picklist($mgr, name => $name);
 929 }
 930
 931
 932 # ----------------------------------------------------------------------------
 933 # Workflow: Build a selection list / PO by importing a batch of MARC records
 934 # ----------------------------------------------------------------------------
 935
 936 __PACKAGE__->register_method(
 937     method => 'upload_records',
 938     api_name => 'open-ils.acq.process_upload_records',
 939     stream => 1,
 940 );
 941
 942 sub upload_records {
 943     my($self, $conn, $auth, $key) = @_;
 944
 945         my $e = new_editor(authtoken => $auth, xact => 1);
 946     return $e->die_event unless $e->checkauth;
 947     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
 948
 949     my $cache = OpenSRF::Utils::Cache->new;
 950
 951     my $data = $cache->get_cache("vandelay_import_spool_$key");
 952         my $purpose = $data->{purpose};
 953     my $filename = $data->{path};
 954     my $provider = $data->{provider};
 955     my $picklist = $data->{picklist};
 956     my $create_po = $data->{create_po};
 957     my $ordering_agency = $data->{ordering_agency};
 958     my $create_assets = $data->{create_assets};
 959     my $po;
 960     my $evt;
 961
 962     unless(-r $filename) {
 963         $logger->error("unable to read MARC file $filename");
 964         $e->rollback;
 965         return OpenILS::Event->new('FILE_UPLOAD_ERROR', payload => {filename => $filename});
 966     }
 967
 968     $provider = $e->retrieve_acq_provider($provider) or return $e->die_event;
 969
 970     if($picklist) {
 971         $picklist = $e->retrieve_acq_picklist($picklist) or return $e->die_event;
 972         if($picklist->owner != $e->requestor->id) {
 973             return $e->die_event unless
 974                 $e->allowed('CREATE_PICKLIST', $picklist->org_unit, $picklist);
 975         }
 976         $mgr->picklist($picklist);
 977     }
 978
 979     if($create_po) {
 980         $po = create_purchase_order($mgr,
 981             ordering_agency => $ordering_agency,
 982             provider => $provider->id,
 983             state => 'on-order'
 984         ) or return $mgr->editor->die_event;
 985     }
 986
 987     $logger->info("acq processing MARC file=$filename");
 988
 989     my $marctype = 'USMARC'; # ?
 990         my $batch = new MARC::Batch ($marctype, $filename);
 991         $batch->strict_off;
 992
 993         my $count = 0;
 994     my @li_list;
 995
 996         while(1) {
 997
 998             my $err;
 999         my $xml;
1000                 $count++;
1001         my $r;
1002
1003                 try {
1004             $r = $batch->next;
1005         } catch Error with {
1006             $err = shift;
1007                         $logger->warn("Proccessing of record $count in set $key failed with error $err.  Skipping this record");
1008         };
1009
1010         next if $err;
1011         last unless $r;
1012
1013                 try {
1014             ($xml = $r->as_xml_record()) =~ s/\n//sog;
1015             $xml =~ s/^<\?xml.+\?\s*>//go;
1016             $xml =~ s/>\s+</></go;
1017             $xml =~ s/\p{Cc}//go;
1018             $xml = $U->entityize($xml);
1019             $xml =~ s/[\x00-\x1f]//go;
1020
1021                 } catch Error with {
1022                         $err = shift;
1023                         $logger->warn("Proccessing XML of record $count in set $key failed with error $err.  Skipping this record");
1024                 };
1025
1026         next if $err or not $xml;
1027
1028         my %args = (
1029             source_label => $provider->code,
1030             provider => $provider->id,
1031             marc => $xml,
1032         );
1033
1034         $args{picklist} = $picklist->id if $picklist;
1035         if($po) {
1036             $args{purchase_order} = $po->id;
1037             $args{state} = 'on-order';
1038         }
1039
1040         my $li = create_lineitem($mgr, %args) or return $mgr->editor->die_event;
1041         $mgr->respond;
1042         $li->provider($provider); # flesh it, we'll need it later
1043
1044         import_lineitem_details($mgr, $ordering_agency, $li) or return $mgr->editor->die_event;
1045         $mgr->respond;
1046
1047         push(@li_list, $li->id);
1048         $mgr->respond;
1049         }
1050
1051         $e->commit;
1052     unlink($filename);
1053     $cache->delete_cache('vandelay_import_spool_' . $key);
1054
1055     if($create_assets) {
1056         create_lineitem_list_assets($mgr, \@li_list) or return $e->die_event;
1057     }
1058
1059     return $mgr->respond_complete;
1060 }
1061
1062 sub import_lineitem_details {
1063     my($mgr, $ordering_agency, $li) = @_;
1064
1065     my $holdings = $mgr->editor->json_query({from => ['acq.extract_provider_holding_data', $li->id]});
1066     return 1 unless @$holdings;
1067     my $org_path = $U->get_org_ancestors($ordering_agency);
1068     $org_path = [ reverse (@$org_path) ];
1069     my $price;
1070
1071     my $idx = 1;
1072     while(1) {
1073         # create a lineitem detail for each copy in the data
1074
1075         my $compiled = extract_lineitem_detail_data($mgr, $org_path, $holdings, $idx);
1076         last unless defined $compiled;
1077         return 0 unless $compiled;
1078
1079         # this takes the price of the last copy and uses it as the lineitem price
1080         # need to determine if a given record would include different prices for the same item
1081         $price = $$compiled{price};
1082
1083         for(1..$$compiled{quantity}) {
1084             my $lid = create_lineitem_detail($mgr,
1085                 lineitem => $li->id,
1086                 owning_lib => $$compiled{owning_lib},
1087                 cn_label => $$compiled{call_number},
1088                 fund => $$compiled{fund},
1089                 circ_modifier => $$compiled{circ_modifier},
1090                 note => $$compiled{note},
1091                 location => $$compiled{copy_location},
1092                 collection_code => $$compiled{collection_code}
1093             ) or return 0;
1094         }
1095
1096         $mgr->respond;
1097         $idx++;
1098     }
1099
1100     # set the price attr so we'll know the source of the price
1101     set_lineitem_attr(
1102         $mgr,
1103         attr_name => 'estimated_price',
1104         attr_type => 'lineitem_local_attr_definition',
1105         attr_value => $price,
1106         lineitem => $li->id
1107     ) or return 0;
1108
1109     # if we're creating a purchase order, create the debits
1110     if($li->purchase_order) {
1111         create_lineitem_debits($mgr, $li, $price, 2) or return 0;
1112         $mgr->respond;
1113     }
1114
1115     return 1;
1116 }
1117
1118 # return hash on success, 0 on error, undef on no more holdings
1119 sub extract_lineitem_detail_data {
1120     my($mgr, $org_path, $holdings, $index) = @_;
1121
1122     my @data_list = grep { $_->{holding} eq $index } @$holdings;
1123     return undef unless @data_list;
1124
1125     my %compiled = map { $_->{attr} => $_->{data} } @data_list;
1126     my $base_org = $$org_path[0];
1127
1128     my $killme = sub {
1129         my $msg = shift;
1130         $logger->error("Item import extraction error: $msg");
1131         $logger->error('Holdings Data: ' . OpenSRF::Utils::JSON->perl2JSON(\%compiled));
1132         $mgr->editor->rollback;
1133         $mgr->editor->event(OpenILS::Event->new('ACQ_IMPORT_ERROR', payload => $msg));
1134         return 0;
1135     };
1136
1137     $compiled{quantity} ||= 1;
1138
1139     # ---------------------------------------------------------------------
1140     # Fund
1141     my $code = $compiled{fund_code};
1142     return $killme->('no fund code provided') unless $code;
1143
1144     my $fund = $mgr->cache($base_org, "fund.$code");
1145     unless($fund) {
1146         # search up the org tree for the most appropriate fund
1147         for my $org (@$org_path) {
1148             $fund = $mgr->editor->search_acq_fund(
1149                 {org => $org, code => $code, year => DateTime->now->year}, {idlist => 1})->[0];
1150             last if $fund;
1151         }
1152     }
1153     return $killme->("no fund with code $code at orgs [@$org_path]") unless $fund;
1154     $compiled{fund} = $fund;
1155     $mgr->cache($base_org, "fund.$code", $fund);
1156
1157
1158     # ---------------------------------------------------------------------
1159     # Owning lib
1160     my $sn = $compiled{owning_lib};
1161     return $killme->('no owning_lib defined') unless $sn;
1162     my $org_id =
1163         $mgr->cache($base_org, "orgsn.$sn") ||
1164             $mgr->editor->search_actor_org_unit({shortname => $sn}, {idlist => 1})->[0];
1165     return $killme->("invalid owning_lib defined: $sn") unless $org_id;
1166     $compiled{owning_lib} = $org_id;
1167     $mgr->cache($$org_path[0], "orgsn.$sn", $org_id);
1168
1169
1170     # ---------------------------------------------------------------------
1171     # Circ Modifier
1172     my $mod;
1173     $code = $compiled{circ_modifier};
1174
1175     if($code) {
1176
1177         $mod = $mgr->cache($base_org, "mod.$code") ||
1178             $mgr->editor->retrieve_config_circ_modifier($code);
1179         return $killme->("invlalid circ_modifier $code") unless $mod;
1180         $mgr->cache($base_org, "mod.$code", $mod);
1181
1182     } else {
1183         # try the default
1184         $mod = get_default_circ_modifier($mgr, $base_org)
1185             or return $killme->('no circ_modifier defined');
1186     }
1187
1188     $compiled{circ_modifier} = $mod;
1189
1190
1191     # ---------------------------------------------------------------------
1192     # Shelving Location
1193     my $name = $compiled{copy_location};
1194     if($name) {
1195         my $loc = $mgr->cache($base_org, "copy_loc.$name");
1196         unless($loc) {
1197             for my $org (@$org_path) {
1198                 $loc = $mgr->editor->search_asset_copy_location(
1199                     {owning_lib => $org, name => $name}, {idlist => 1})->[0];
1200                 last if $loc;
1201             }
1202         }
1203         return $killme->("Invalid copy location $name") unless $loc;
1204         $compiled{copy_location} = $loc;
1205         $mgr->cache($base_org, "copy_loc.$name", $loc);
1206     }
1207
1208     return \%compiled;
1209 }
1210
1211
1212
1213 # ----------------------------------------------------------------------------
1214 # Workflow: Given an existing purchase order, import/create the bibs,
1215 # callnumber and copy objects
1216 # ----------------------------------------------------------------------------
1217
1218 __PACKAGE__->register_method(
1219         method => 'create_po_assets',
1220         api_name        => 'open-ils.acq.purchase_order.assets.create',
1221         signature => {
1222         desc => q/Creates assets for each lineitem in the purchase order/,
1223         params => [
1224             {desc => 'Authentication token', type => 'string'},
1225             {desc => 'The purchase order id', type => 'number'},
1226         ],
1227         return => {desc => 'Streams a total versus completed counts object, event on error'}
1228     }
1229 );
1230
1231 sub create_po_assets {
1232     my($self, $conn, $auth, $po_id) = @_;
1233
1234     my $e = new_editor(authtoken=>$auth, xact=>1);
1235     return $e->die_event unless $e->checkauth;
1236     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1237
1238     my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->die_event;
1239
1240     my $li_ids = $e->search_acq_lineitem({purchase_order => $po_id}, {idlist => 1});
1241
1242     # it's ugly, but it's fast.  Get the total count of lineitem detail objects to process
1243     my $lid_total = $e->json_query({
1244         select => { acqlid => [{aggregate => 1, transform => 'count', column => 'id'}] },
1245         from => {
1246             acqlid => {
1247                 jub => {
1248                     fkey => 'lineitem',
1249                     field => 'id',
1250                     join => {acqpo => {fkey => 'purchase_order', field => 'id'}}
1251                 }
1252             }
1253         },
1254         where => {'+acqpo' => {id => $po_id}}
1255     })->[0]->{id};
1256
1257     $mgr->total(scalar(@$li_ids) + $lid_total);
1258
1259     create_lineitem_list_assets($mgr, $li_ids) or return $e->die_event;
1260
1261     $e->xact_begin;
1262     update_purchase_order($mgr, $po) or return $e->die_event;
1263     $e->commit;
1264
1265     return $mgr->respond_complete;
1266 }
1267
1268
1269
1270 __PACKAGE__->register_method(
1271         method => 'create_purchase_order_api',
1272         api_name        => 'open-ils.acq.purchase_order.create',
1273         signature => {
1274         desc => 'Creates a new purchase order',
1275         params => [
1276             {desc => 'Authentication token', type => 'string'},
1277             {desc => 'purchase_order to create', type => 'object'}
1278         ],
1279         return => {desc => 'The purchase order id, Event on failure'}
1280     }
1281 );
1282
1283 sub create_purchase_order_api {
1284     my($self, $conn, $auth, $po, $args) = @_;
1285     $args ||= {};
1286
1287     my $e = new_editor(xact=>1, authtoken=>$auth);
1288     return $e->die_event unless $e->checkauth;
1289     return $e->die_event unless $e->allowed('CREATE_PURCHASE_ORDER', $po->ordering_agency);
1290     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1291
1292     # create the PO
1293     my %pargs = (ordering_agency => $e->requestor->ws_ou);
1294     $pargs{provider} = $po->provider if $po->provider;
1295     $po = create_purchase_order($mgr, %pargs) or return $e->die_event;
1296
1297     my $li_ids = $$args{lineitems};
1298
1299     if($li_ids) {
1300
1301         for my $li_id (@$li_ids) {
1302
1303             my $li = $e->retrieve_acq_lineitem([
1304                 $li_id,
1305                 {flesh => 1, flesh_fields => {jub => ['attributes']}}
1306             ]) or return $e->die_event;
1307
1308             $li->provider($po->provider);
1309             $li->purchase_order($po->id);
1310             $li->state('pending-order');
1311             update_lineitem($mgr, $li) or return $e->die_event;
1312             $mgr->respond;
1313
1314             create_lineitem_debits($mgr, $li) or return $e->die_event;
1315         }
1316     }
1317
1318     # commit before starting the asset creation
1319     $e->xact_commit;
1320
1321     if($li_ids and $$args{create_assets}) {
1322         create_lineitem_list_assets($mgr, $li_ids) or return $e->die_event;
1323     }
1324
1325     return $mgr->respond_complete;
1326 }
1327
1328
1329 __PACKAGE__->register_method(
1330         method => 'lineitem_detail_CUD_batch',
1331         api_name => 'open-ils.acq.lineitem_detail.cud.batch',
1332     stream => 1,
1333         signature => {
1334         desc => q/Creates a new purchase order line item detail.
1335             Additionally creates the associated fund_debit/,
1336         params => [
1337             {desc => 'Authentication token', type => 'string'},
1338             {desc => 'List of lineitem_details to create', type => 'array'},
1339         ],
1340         return => {desc => 'Streaming response of current position in the array'}
1341     }
1342 );
1343
1344 sub lineitem_detail_CUD_batch {
1345     my($self, $conn, $auth, $li_details) = @_;
1346
1347     my $e = new_editor(xact=>1, authtoken=>$auth);
1348     return $e->die_event unless $e->checkauth;
1349     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1350
1351     # XXX perms
1352
1353     $mgr->total(scalar(@$li_details));
1354
1355     my %li_cache;
1356
1357     for my $lid (@$li_details) {
1358
1359         my $li = $li_cache{$lid->lineitem} || $e->retrieve_acq_lineitem($lid->lineitem);
1360
1361         if($lid->isnew) {
1362             create_lineitem_detail($mgr, %{$lid->to_bare_hash}) or return $e->die_event;
1363
1364         } elsif($lid->ischanged) {
1365             $e->update_acq_lineitem_detail($lid) or return $e->die_event;
1366
1367         } elsif($lid->isdeleted) {
1368             delete_lineitem_detail($mgr, $lid) or return $e->die_event;
1369         }
1370
1371         $mgr->respond(li => $li);
1372         $li_cache{$lid->lineitem} = $li;
1373     }
1374
1375     $e->commit;
1376     return $mgr->respond_complete;
1377 }
1378
1379
1380 __PACKAGE__->register_method(
1381         method => 'receive_po_api',
1382         api_name        => 'open-ils.acq.purchase_order.receive'
1383 );
1384
1385 sub receive_po_api {
1386     my($self, $conn, $auth, $po_id) = @_;
1387     my $e = new_editor(xact => 1, authtoken => $auth);
1388     return $e->die_event unless $e->checkauth;
1389     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1390
1391     my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->die_event;
1392     return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency);
1393
1394     my $li_ids = $e->search_acq_lineitem({purchase_order => $po_id}, {idlist => 1});
1395
1396     for my $li_id (@$li_ids) {
1397         receive_lineitem($mgr, $li_id) or return $e->die_event;
1398         $mgr->respond;
1399     }
1400
1401     $po->state('received');
1402     update_purchase_order($mgr, $po) or return $e->die_event;
1403
1404     $e->commit;
1405     return $mgr->respond_complete;
1406 }
1407
1408
1409 __PACKAGE__->register_method(
1410         method => 'receive_lineitem_detail_api',
1411         api_name        => 'open-ils.acq.lineitem_detail.receive',
1412         signature => {
1413         desc => 'Mark a lineitem_detail as received',
1414         params => [
1415             {desc => 'Authentication token', type => 'string'},
1416             {desc => 'lineitem detail ID', type => 'number'}
1417         ],
1418         return => {desc => '1 on success, Event on error'}
1419     }
1420 );
1421
1422 sub receive_lineitem_detail_api {
1423     my($self, $conn, $auth, $lid_id) = @_;
1424
1425     my $e = new_editor(xact=>1, authtoken=>$auth);
1426     return $e->die_event unless $e->checkauth;
1427     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1428
1429     my $lid = $e->retrieve_acq_lineitem_detail([
1430         $lid_id, {
1431             flesh => 2,
1432             flesh_fields => {
1433                 acqlid => ['lineitem'],
1434                 jub => ['purchase_order']
1435             }
1436         }
1437     ]);
1438
1439     return $e->die_event unless $e->allowed(
1440         'RECEIVE_PURCHASE_ORDER', $lid->lineitem->purchase_order->ordering_agency);
1441
1442     receive_lineitem_detail($mgr, $lid_id) or return $e->die_event;
1443     $e->commit;
1444     return 1;
1445 }
1446
1447 __PACKAGE__->register_method(
1448         method => 'receive_lineitem_api',
1449         api_name        => 'open-ils.acq.lineitem.receive',
1450         signature => {
1451         desc => 'Mark a lineitem as received',
1452         params => [
1453             {desc => 'Authentication token', type => 'string'},
1454             {desc => 'lineitem detail ID', type => 'number'}
1455         ],
1456         return => {desc => '1 on success, Event on error'}
1457     }
1458 );
1459
1460 sub receive_lineitem_api {
1461     my($self, $conn, $auth, $li_id) = @_;
1462
1463     my $e = new_editor(xact=>1, authtoken=>$auth);
1464     return $e->die_event unless $e->checkauth;
1465     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1466
1467     my $li = $e->retrieve_acq_lineitem([
1468         $li_id, {
1469             flesh => 1,
1470             flesh_fields => {
1471                 jub => ['purchase_order']
1472             }
1473         }
1474     ]) or return $e->die_event;
1475
1476     return $e->die_event unless $e->allowed(
1477         'RECEIVE_PURCHASE_ORDER', $li->purchase_order->ordering_agency);
1478
1479     receive_lineitem($mgr, $li_id) or return $e->die_event;
1480     $e->commit;
1481     return 1;
1482 }
1483
1484
1485 __PACKAGE__->register_method(
1486         method => 'rollback_receive_po_api',
1487         api_name        => 'open-ils.acq.purchase_order.receive.rollback'
1488 );
1489
1490 sub rollback_receive_po_api {
1491     my($self, $conn, $auth, $po_id) = @_;
1492     my $e = new_editor(xact => 1, authtoken => $auth);
1493     return $e->die_event unless $e->checkauth;
1494     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1495
1496     my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->die_event;
1497     return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency);
1498
1499     my $li_ids = $e->search_acq_lineitem({purchase_order => $po_id}, {idlist => 1});
1500
1501     for my $li_id (@$li_ids) {
1502         rollback_receive_lineitem($mgr, $li_id) or return $e->die_event;
1503         $mgr->respond;
1504     }
1505
1506     $po->state('on-order');
1507     update_purchase_order($mgr, $po) or return $e->die_event;
1508
1509     $e->commit;
1510     return $mgr->respond_complete;
1511 }
1512
1513
1514 __PACKAGE__->register_method(
1515         method => 'rollback_receive_lineitem_detail_api',
1516         api_name        => 'open-ils.acq.lineitem_detail.receive.rollback',
1517         signature => {
1518         desc => 'Mark a lineitem_detail as received',
1519         params => [
1520             {desc => 'Authentication token', type => 'string'},
1521             {desc => 'lineitem detail ID', type => 'number'}
1522         ],
1523         return => {desc => '1 on success, Event on error'}
1524     }
1525 );
1526
1527 sub rollback_receive_lineitem_detail_api {
1528     my($self, $conn, $auth, $lid_id) = @_;
1529
1530     my $e = new_editor(xact=>1, authtoken=>$auth);
1531     return $e->die_event unless $e->checkauth;
1532     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1533
1534     my $lid = $e->retrieve_acq_lineitem_detail([
1535         $lid_id, {
1536             flesh => 2,
1537             flesh_fields => {
1538                 acqlid => ['lineitem'],
1539                 jub => ['purchase_order']
1540             }
1541         }
1542     ]);
1543     my $li = $lid->lineitem;
1544     my $po = $li->purchase_order;
1545
1546     return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency);
1547     rollback_receive_lineitem_detail($mgr, $lid_id) or return $e->die_event;
1548
1549     $li->state('on-order');
1550     $po->state('on-order');
1551     udpate_lineitem($mgr, $li) or return $e->die_event;
1552     udpate_purchase_order($mgr, $po) or return $e->die_event;
1553
1554     $e->commit;
1555     return 1;
1556 }
1557
1558 __PACKAGE__->register_method(
1559         method => 'rollback_receive_lineitem_api',
1560         api_name        => 'open-ils.acq.lineitem.receive.rollback',
1561         signature => {
1562         desc => 'Mark a lineitem as received',
1563         params => [
1564             {desc => 'Authentication token', type => 'string'},
1565             {desc => 'lineitem detail ID', type => 'number'}
1566         ],
1567         return => {desc => '1 on success, Event on error'}
1568     }
1569 );
1570
1571 sub rollback_receive_lineitem_api {
1572     my($self, $conn, $auth, $li_id) = @_;
1573
1574     my $e = new_editor(xact=>1, authtoken=>$auth);
1575     return $e->die_event unless $e->checkauth;
1576     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1577
1578     my $li = $e->retrieve_acq_lineitem_detail([
1579         $li_id, {
1580             flesh => 1,
1581             flesh_fields => {
1582                 jub => ['purchase_order']
1583             }
1584         }
1585     ]);
1586     my $po = $li->purchase_order;
1587
1588     return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency);
1589
1590     rollback_receive_lineitem($mgr, $li_id) or return $e->die_event;
1591
1592     $po->state('on-order');
1593     update_purchase_order($mgr, $po) or return $e->die_event;
1594
1595     $e->commit;
1596     return 1;
1597 }
1598
1599
1600 __PACKAGE__->register_method(
1601         method => 'set_lineitem_price_api',
1602         api_name        => 'open-ils.acq.lineitem.price.set',
1603         signature => {
1604         desc => 'Set lineitem price.  If debits already exist, update them as well',
1605         params => [
1606             {desc => 'Authentication token', type => 'string'},
1607             {desc => 'lineitem ID', type => 'number'}
1608         ],
1609         return => {desc => 'status blob, Event on error'}
1610     }
1611 );
1612
1613 sub set_lineitem_price_api {
1614     my($self, $conn, $auth, $li_id, $price, $currency) = @_;
1615
1616     my $e = new_editor(xact=>1, authtoken=>$auth);
1617     return $e->die_event unless $e->checkauth;
1618     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1619
1620     # XXX perms
1621
1622     my $li = $e->retrieve_acq_lineitem($li_id) or return $e->die_event;
1623
1624     # update the local attr for estimated price
1625     set_lineitem_attr(
1626         $mgr,
1627         attr_name => 'estimated_price',
1628         attr_type => 'lineitem_local_attr_definition',
1629         attr_value => $price,
1630         lineitem => $li_id
1631     ) or return $e->die_event;
1632
1633     my $lid_ids = $e->search_acq_lineitem_detail(
1634         {lineitem => $li_id, fund_debit => {'!=' => undef}},
1635         {idlist => 1}
1636     );
1637
1638     for my $lid_id (@$lid_ids) {
1639
1640         my $lid = $e->retrieve_acq_lineitem_detail([
1641             $lid_id, {
1642             flesh => 1, flesh_fields => {acqlid => ['fund', 'fund_debit']}}
1643         ]);
1644
1645         # onless otherwise specified, assume currency of new price is same as currency type of the fund
1646         $currency ||= $lid->fund->currency_type;
1647         my $amount = $price;
1648
1649         if($lid->fund->currency_type ne $currency) {
1650             $amount = currency_conversion($mgr, $currency, $lid->fund->currency_type, $price);
1651         }
1652
1653         $lid->fund_debit->origin_currency_type($currency);
1654         $lid->fund_debit->origin_amount($price);
1655         $lid->fund_debit->amount($amount);
1656
1657         $e->update_acq_fund_debit($lid->fund_debit) or return $e->die_event;
1658         $mgr->add_lid;
1659         $mgr->respond;
1660     }
1661
1662     $e->commit;
1663     return $mgr->respond_complete;
1664 }
1665
1666
1667 __PACKAGE__->register_method(
1668         method => 'clone_picklist_api',
1669         api_name        => 'open-ils.acq.picklist.clone',
1670         signature => {
1671         desc => 'Clones a picklist, including lineitem and lineitem details',
1672         params => [
1673             {desc => 'Authentication token', type => 'string'},
1674             {desc => 'Picklist ID', type => 'number'},
1675             {desc => 'New Picklist Name', type => 'string'}
1676         ],
1677         return => {desc => 'status blob, Event on error'}
1678     }
1679 );
1680
1681 sub clone_picklist_api {
1682     my($self, $conn, $auth, $pl_id, $name) = @_;
1683
1684     my $e = new_editor(xact=>1, authtoken=>$auth);
1685     return $e->die_event unless $e->checkauth;
1686     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1687
1688     my $old_pl = $e->retrieve_acq_picklist($pl_id);
1689     my $new_pl = create_picklist($mgr, %{$old_pl->to_bare_hash}, name => $name) or return $e->die_event;
1690
1691     my $li_ids = $e->search_acq_lineitem({picklist => $pl_id}, {idlist => 1});
1692
1693     for my $li_id (@$li_ids) {
1694
1695         # copy the lineitems
1696         my $li = $e->retrieve_acq_lineitem($li_id);
1697         my $new_li = create_lineitem($mgr, %{$li->to_bare_hash}, picklist => $new_pl->id) or return $e->die_event;
1698
1699         my $lid_ids = $e->search_acq_lineitem_detail({lineitem => $li_id}, {idlist => 1});
1700         for my $lid_id (@$lid_ids) {
1701
1702             # copy the lineitem details
1703             my $lid = $e->retrieve_acq_lineitem_detail($lid_id);
1704             create_lineitem_detail($mgr, %{$lid->to_bare_hash}, lineitem => $new_li->id) or return $e->die_event;
1705         }
1706
1707         $mgr->respond;
1708     }
1709
1710     $e->commit;
1711     return $mgr->respond_complete;
1712 }
1713
1714
1715 __PACKAGE__->register_method(
1716         method => 'merge_picklist_api',
1717         api_name        => 'open-ils.acq.picklist.merge',
1718         signature => {
1719         desc => 'Merges 2 or more picklists into a single list',
1720         params => [
1721             {desc => 'Authentication token', type => 'string'},
1722             {desc => 'Lead Picklist ID', type => 'number'},
1723             {desc => 'List of subordinate picklist IDs', type => 'array'}
1724         ],
1725         return => {desc => 'status blob, Event on error'}
1726     }
1727 );
1728
1729 sub merge_picklist_api {
1730     my($self, $conn, $auth, $lead_pl, $pl_list) = @_;
1731
1732     my $e = new_editor(xact=>1, authtoken=>$auth);
1733     return $e->die_event unless $e->checkauth;
1734     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1735
1736     # XXX perms on each picklist modified
1737
1738     # point all of the lineitems at the lead picklist
1739     my $li_ids = $e->search_acq_lineitem({picklist => $pl_list}, {idlist => 1});
1740
1741     for my $li_id (@$li_ids) {
1742         my $li = $e->retrieve_acq_lineitem($li_id);
1743         $li->picklist($lead_pl);
1744         update_lineitem($mgr, $li) or return $e->die_event;
1745         $mgr->respond;
1746     }
1747
1748     # now delete the subordinate lists
1749     for my $pl_id (@$pl_list) {
1750         my $pl = $e->retrieve_acq_picklist($pl_id);
1751         $e->delete_acq_picklist($pl) or return $e->die_event;
1752     }
1753
1754     $e->commit;
1755     return $mgr->respond_complete;
1756 }
1757
1758
1759 __PACKAGE__->register_method(
1760         method => 'delete_picklist_api',
1761         api_name        => 'open-ils.acq.picklist.delete',
1762         signature => {
1763         desc => q/Deletes a picklist.  It also deletes any lineitems in the "new" state.
1764             Other attached lineitems are detached'/,
1765         params => [
1766             {desc => 'Authentication token', type => 'string'},
1767             {desc => 'Picklist ID to delete', type => 'number'}
1768         ],
1769         return => {desc => '1 on success, Event on error'}
1770     }
1771 );
1772
1773 sub delete_picklist_api {
1774     my($self, $conn, $auth, $picklist_id) = @_;
1775     my $e = new_editor(xact=>1, authtoken=>$auth);
1776     return $e->die_event unless $e->checkauth;
1777     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1778     my $pl = $e->retrieve_acq_picklist($picklist_id) or return $e->die_event;
1779     delete_picklist($mgr, $pl) or return $e->die_event;
1780     $e->commit;
1781     return $mgr->respond_complete;
1782 }
1783
1784
1785
1786 __PACKAGE__->register_method(
1787         method => 'activate_purchase_order',
1788         api_name        => 'open-ils.acq.purchase_order.activate',
1789         signature => {
1790         desc => q/Activates a purchase order.  This updates the status of the PO
1791             and Lineitems to 'on-order'.  Activated PO's are ready for EDI delivery
1792             if appropriate./,
1793         params => [
1794             {desc => 'Authentication token', type => 'string'},
1795             {desc => 'Purchase ID', type => 'number'}
1796         ],
1797         return => {desc => '1 on success, Event on error'}
1798     }
1799 );
1800
1801 sub activate_purchase_order {
1802     my($self, $conn, $auth, $po_id) = @_;
1803     my $e = new_editor(xact=>1, authtoken=>$auth);
1804     return $e->die_event unless $e->checkauth;
1805     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1806
1807     my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->die_event;
1808     return $e->die_event unless $e->allowed('CREATE_PURCHASE_ORDER', $po->ordering_agency);
1809
1810     $po->state('on-order');
1811     update_purchase_order($mgr, $po) or return $e->die_event;
1812
1813     my $query = [
1814         {purchase_order => $po_id, state => 'pending-order'},
1815         {limit => 1}
1816     ];
1817
1818     while( my $li = $e->search_acq_lineitem($query)->[0] ) {
1819         $li->state('on-order');
1820         update_lineitem($mgr, $li) or return $e->die_event;
1821         $mgr->respond;
1822     }
1823
1824     $e->commit;
1825     return 1;
1826 }
1827
1828
1829 1;