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