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     if($li->picklist) {
 191         return 0 unless update_picklist($mgr, $li->picklist);
 192     }
 193     $mgr->add_li;
 194     return $mgr->editor->create_acq_lineitem($li);
 195 }
 196
 197 sub update_lineitem {
 198     my($mgr, $li) = @_;
 199     $li->edit_time('now');
 200     $li->editor($mgr->editor->requestor->id);
 201     return $li if $mgr->editor->update_acq_lineitem($li);
 202     $mgr->add_lid;
 203     return undef;
 204 }
 205
 206 sub delete_lineitem {
 207     my($mgr, $li) = @_;
 208     $li = $mgr->editor->retrieve_acq_lineitem($li) unless ref $li;
 209
 210     # delete the attached lineitem_details
 211     my $lid_ids = $mgr->editor->search_acq_lineitem_detail({lineitem => $li->id}, {idlist=>1});
 212     for my $lid_id (@$lid_ids) {
 213         return 0 unless delete_lineitem_detail($mgr, $lid_id);
 214     }
 215
 216     return $mgr->editor->delete_acq_lineitem($li);
 217 }
 218
 219 # begins and commit transactions as it goes
 220 sub create_lineitem_list_assets {
 221     my($mgr, $li_ids) = @_;
 222     # create the bibs/volumes/copies and ingest the records
 223     for my $li_id (@$li_ids) {
 224         $mgr->editor->xact_begin;
 225         my $data = create_lineitem_assets($mgr, $li_id) or return undef;
 226         $mgr->editor->xact_commit;
 227         $mgr->push_ingest_queue($data->{li}->eg_bib_id) if $data->{new_bib};
 228         $mgr->respond;
 229     }
 230     $mgr->process_ingest_records;
 231     return 1;
 232 }
 233
 234 # ----------------------------------------------------------------------------
 235 # if all of the lineitem details for this lineitem have
 236 # been received, mark the lineitem as received
 237 # returns 1 on non-received, li on received, 0 on error
 238 # ----------------------------------------------------------------------------
 239 sub check_lineitem_received {
 240     my($mgr, $li_id) = @_;
 241
 242     my $non_recv = $mgr->editor->search_acq_lineitem_detail(
 243         {recv_time => undef, lineitem => $li_id}, {idlist=>1});
 244
 245     return 1 if @$non_recv;
 246
 247     my $li = $mgr->editor->retrieve_acq_lineitem($li_id);
 248     $li->state('received');
 249     return update_lineitem($mgr, $li);
 250 }
 251
 252 sub receive_lineitem {
 253     my($mgr, $li_id, $skip_complete_check) = @_;
 254     my $li = $mgr->editor->retrieve_acq_lineitem($li_id) or return 0;
 255
 256     my $lid_ids = $mgr->editor->search_acq_lineitem_detail(
 257         {lineitem => $li_id, recv_time => undef}, {idlist => 1});
 258
 259     for my $lid_id (@$lid_ids) {
 260        receive_lineitem_detail($mgr, $lid_id, 1) or return 0;
 261     }
 262
 263     $mgr->add_li;
 264     $li->state('received');
 265     update_lineitem($mgr, $li) or return 0;
 266     return 1 if $skip_complete_check;
 267
 268     return check_purchase_order_received($mgr, $li->purchase_order);
 269 }
 270
 271 sub rollback_receive_lineitem {
 272     my($mgr, $li_id) = @_;
 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        rollback_receive_lineitem_detail($mgr, $lid_id, 1) or return 0;
 280     }
 281
 282     $mgr->add_li;
 283     $li->state('on-order');
 284     return update_lineitem($mgr, $li);
 285 }
 286
 287 # ----------------------------------------------------------------------------
 288 # Lineitem Detail
 289 # ----------------------------------------------------------------------------
 290 sub create_lineitem_detail {
 291     my($mgr, %args) = @_;
 292     my $lid = Fieldmapper::acq::lineitem_detail->new;
 293     $lid->$_($args{$_}) for keys %args;
 294     $mgr->editor->create_acq_lineitem_detail($lid) or return 0;
 295     $mgr->add_lid;
 296
 297     # create some default values
 298     unless($lid->barcode) {
 299         my $pfx = $U->ou_ancestor_setting_value($lid->owning_lib, 'acq.tmp_barcode_prefix') || 'ACQ';
 300         $lid->barcode($pfx.$lid->id);
 301     }
 302
 303     unless($lid->cn_label) {
 304         my $pfx = $U->ou_ancestor_setting_value($lid->owning_lib, 'acq.tmp_callnumber_prefix') || 'ACQ';
 305         $lid->cn_label($pfx.$lid->id);
 306     }
 307
 308     if(!$lid->location and my $loc = $U->ou_ancestor_setting_value($lid->owning_lib, 'acq.default_copy_location')) {
 309         $lid->location($loc);
 310     }
 311
 312     if(!$lid->circ_modifier and my $mod = get_default_circ_modifier($mgr, $lid->owning_lib)) {
 313         $lid->circ_modifier($mod);
 314     }
 315
 316     $mgr->editor->update_acq_lineitem_detail($lid) or return 0;
 317     my $li = $mgr->editor->retrieve_acq_lineitem($lid->lineitem) or return 0;
 318     update_lineitem($mgr, $li) or return 0;
 319     return $lid;
 320 }
 321
 322 sub get_default_circ_modifier {
 323     my($mgr, $org) = @_;
 324     my $mod = $mgr->cache($org, 'def_circ_mod');
 325     return $mod if $mod;
 326     $mod = $U->ou_ancestor_setting_value($org, 'acq.default_circ_modifier');
 327     return $mgr->cache($org, 'def_circ_mod', $mod) if $mod;
 328     return undef;
 329 }
 330
 331 sub delete_lineitem_detail {
 332     my($mgr, $lid) = @_;
 333     $lid = $mgr->editor->retrieve_acq_lineitem_detail($lid) unless ref $lid;
 334     return $mgr->editor->delete_acq_lineitem_detail($lid);
 335 }
 336
 337
 338 sub receive_lineitem_detail {
 339     my($mgr, $lid_id, $skip_complete_check) = @_;
 340     my $e = $mgr->editor;
 341
 342     my $lid = $e->retrieve_acq_lineitem_detail([
 343         $lid_id,
 344         {   flesh => 1,
 345             flesh_fields => {
 346                 acqlid => ['fund_debit']
 347             }
 348         }
 349     ]) or return 0;
 350
 351     return 1 if $lid->recv_time;
 352
 353     $lid->recv_time('now');
 354     $e->update_acq_lineitem_detail($lid) or return 0;
 355
 356     my $copy = $e->retrieve_asset_copy($lid->eg_copy_id) or return 0;
 357     $copy->status(OILS_COPY_STATUS_IN_PROCESS);
 358     $copy->edit_date('now');
 359     $copy->editor($e->requestor->id);
 360     $e->update_asset_copy($copy) or return 0;
 361
 362     if($lid->fund_debit) {
 363         $lid->fund_debit->encumbrance('f');
 364         $e->update_acq_fund_debit($lid->fund_debit) or return 0;
 365     }
 366
 367     $mgr->add_lid;
 368
 369     return 1 if $skip_complete_check;
 370
 371     my $li = check_lineitem_received($mgr, $lid->lineitem) or return 0;
 372     return 1 if $li == 1; # li not received
 373
 374     return check_purchase_order_received($mgr, $li->purchase_order);
 375 }
 376
 377
 378 sub rollback_receive_lineitem_detail {
 379     my($mgr, $lid_id) = @_;
 380     my $e = $mgr->editor;
 381
 382     my $lid = $e->retrieve_acq_lineitem_detail([
 383         $lid_id,
 384         {   flesh => 1,
 385             flesh_fields => {
 386                 acqlid => ['fund_debit']
 387             }
 388         }
 389     ]) or return 0;
 390
 391     return 1 unless $lid->recv_time;
 392
 393     $lid->clear_recv_time;
 394     $e->update_acq_lineitem_detail($lid) or return 0;
 395
 396     my $copy = $e->retrieve_asset_copy($lid->eg_copy_id) or return 0;
 397     $copy->status(OILS_COPY_STATUS_ON_ORDER);
 398     $copy->edit_date('now');
 399     $copy->editor($e->requestor->id);
 400     $e->update_asset_copy($copy) or return 0;
 401
 402     if($lid->fund_debit) {
 403         $lid->fund_debit->encumbrance('t');
 404         $e->update_acq_fund_debit($lid->fund_debit) or return 0;
 405     }
 406
 407     $mgr->add_lid;
 408     return $lid;
 409 }
 410
 411 # ----------------------------------------------------------------------------
 412 # Lineitem Attr
 413 # ----------------------------------------------------------------------------
 414 sub set_lineitem_attr {
 415     my($mgr, %args) = @_;
 416     my $attr_type = $args{attr_type};
 417
 418     # first, see if it's already set.  May just need to overwrite it
 419     my $attr = $mgr->editor->search_acq_lineitem_attr({
 420         lineitem => $args{lineitem},
 421         attr_type => $args{attr_type},
 422         attr_name => $args{attr_name}
 423     })->[0];
 424
 425     if($attr) {
 426         $attr->attr_value($args{attr_value});
 427         return $attr if $mgr->editor->update_acq_lineitem_attr($attr);
 428         return undef;
 429
 430     } else {
 431
 432         $attr = Fieldmapper::acq::lineitem_attr->new;
 433         $attr->$_($args{$_}) for keys %args;
 434
 435         unless($attr->definition) {
 436             my $find = "search_acq_$attr_type";
 437             my $attr_def_id = $mgr->editor->$find({code => $attr->attr_name}, {idlist=>1})->[0] or return 0;
 438             $attr->definition($attr_def_id);
 439         }
 440         return $mgr->editor->create_acq_lineitem_attr($attr);
 441     }
 442 }
 443
 444 sub get_li_price {
 445     my $li = shift;
 446     my $attrs = $li->attributes;
 447     my ($marc_estimated, $local_estimated, $local_actual, $prov_estimated, $prov_actual);
 448
 449     for my $attr (@$attrs) {
 450         if($attr->attr_name eq 'estimated_price') {
 451             $local_estimated = $attr->attr_value
 452                 if $attr->attr_type eq 'lineitem_local_attr_definition';
 453             $prov_estimated = $attr->attr_value
 454                 if $attr->attr_type eq 'lineitem_prov_attr_definition';
 455             $marc_estimated = $attr->attr_value
 456                 if $attr->attr_type eq 'lineitem_marc_attr_definition';
 457
 458         } elsif($attr->attr_name eq 'actual_price') {
 459             $local_actual = $attr->attr_value
 460                 if $attr->attr_type eq 'lineitem_local_attr_definition';
 461             $prov_actual = $attr->attr_value
 462                 if $attr->attr_type eq 'lineitem_prov_attr_definition';
 463         }
 464     }
 465
 466     return ($local_actual, 1) if $local_actual;
 467     return ($prov_actual, 2) if $prov_actual;
 468     return ($local_estimated, 1) if $local_estimated;
 469     return ($prov_estimated, 2) if $prov_estimated;
 470     return ($marc_estimated, 3);
 471 }
 472
 473
 474 # ----------------------------------------------------------------------------
 475 # Lineitem Debits
 476 # ----------------------------------------------------------------------------
 477 sub create_lineitem_debits {
 478     my($mgr, $li, $price, $ptype) = @_;
 479
 480     ($price, $ptype) = get_li_price($li) unless $price;
 481
 482     unless($price) {
 483         $mgr->editor->event(OpenILS::Event->new('ACQ_LINEITEM_NO_PRICE', payload => $li->id));
 484         $mgr->editor->rollback;
 485         return 0;
 486     }
 487
 488     unless($li->provider) {
 489         $mgr->editor->event(OpenILS::Event->new('ACQ_LINEITEM_NO_PROVIDER', payload => $li->id));
 490         $mgr->editor->rollback;
 491         return 0;
 492     }
 493
 494     my $lid_ids = $mgr->editor->search_acq_lineitem_detail(
 495         {lineitem => $li->id},
 496         {idlist=>1}
 497     );
 498
 499     for my $lid_id (@$lid_ids) {
 500
 501         my $lid = $mgr->editor->retrieve_acq_lineitem_detail([
 502             $lid_id,
 503             {   flesh => 1,
 504                 flesh_fields => {acqlid => ['fund']}
 505             }
 506         ]);
 507
 508         create_lineitem_detail_debit($mgr, $li, $lid, $price, $ptype) or return 0;
 509     }
 510
 511     return 1;
 512 }
 513
 514
 515 # flesh li->provider
 516 # flesh lid->fund
 517 # ptype 1=local, 2=provider, 3=marc
 518 sub create_lineitem_detail_debit {
 519     my($mgr, $li, $lid, $price, $ptype) = @_;
 520
 521     unless(ref $li and ref $li->provider) {
 522        $li = $mgr->editor->retrieve_acq_lineitem([
 523             $li,
 524             {   flesh => 1,
 525                 flesh_fields => {jub => ['provider']},
 526             }
 527         ]);
 528     }
 529
 530     unless(ref $lid and ref $lid->fund) {
 531         $lid = $mgr->editor->retrieve_acq_lineitem_detail([
 532             $lid,
 533             {   flesh => 1,
 534                 flesh_fields => {acqlid => ['fund']}
 535             }
 536         ]);
 537     }
 538
 539     my $ctype = $lid->fund->currency_type;
 540     my $amount = $price;
 541
 542     if($ptype == 2) { # price from vendor
 543         $ctype = $li->provider->currency_type;
 544         $amount = currency_conversion($mgr, $ctype, $lid->fund->currency_type, $price);
 545     }
 546
 547     my $debit = create_fund_debit(
 548         $mgr,
 549         fund => $lid->fund->id,
 550         origin_amount => $price,
 551         origin_currency_type => $ctype,
 552         amount => $amount
 553     ) or return 0;
 554
 555     $lid->fund_debit($debit->id);
 556     $lid->fund($lid->fund->id);
 557     $mgr->editor->update_acq_lineitem_detail($lid) or return 0;
 558     return $debit;
 559 }
 560
 561
 562 # ----------------------------------------------------------------------------
 563 # Fund Debit
 564 # ----------------------------------------------------------------------------
 565 sub create_fund_debit {
 566     my($mgr, %args) = @_;
 567     my $debit = Fieldmapper::acq::fund_debit->new;
 568     $debit->debit_type('purchase');
 569     $debit->encumbrance('t');
 570     $debit->$_($args{$_}) for keys %args;
 571     $mgr->add_debit($debit->amount);
 572     return $mgr->editor->create_acq_fund_debit($debit);
 573 }
 574
 575 sub currency_conversion {
 576     my($mgr, $src_currency, $dest_currency, $amount) = @_;
 577     my $result = $mgr->editor->json_query(
 578         {from => ['acq.exchange_ratio', $src_currency, $dest_currency, $amount]});
 579     return $result->[0]->{'acq.exchange_ratio'};
 580 }
 581
 582
 583 # ----------------------------------------------------------------------------
 584 # Picklist
 585 # ----------------------------------------------------------------------------
 586 sub create_picklist {
 587     my($mgr, %args) = @_;
 588     my $picklist = Fieldmapper::acq::picklist->new;
 589     $picklist->creator($mgr->editor->requestor->id);
 590     $picklist->owner($picklist->creator);
 591     $picklist->editor($picklist->creator);
 592     $picklist->create_time('now');
 593     $picklist->edit_time('now');
 594     $picklist->org_unit($mgr->editor->requestor->ws_ou);
 595     $picklist->owner($mgr->editor->requestor->id);
 596     $picklist->$_($args{$_}) for keys %args;
 597     $mgr->picklist($picklist);
 598     return $mgr->editor->create_acq_picklist($picklist);
 599 }
 600
 601 sub update_picklist {
 602     my($mgr, $picklist) = @_;
 603     $picklist = $mgr->editor->retrieve_acq_picklist($picklist) unless ref $picklist;
 604     $picklist->edit_time('now');
 605     $picklist->editor($mgr->editor->requestor->id);
 606     $mgr->picklist($picklist);
 607     return $picklist if $mgr->editor->update_acq_picklist($picklist);
 608     return undef;
 609 }
 610
 611 sub delete_picklist {
 612     my($mgr, $picklist) = @_;
 613     $picklist = $mgr->editor->retrieve_acq_picklist($picklist) unless ref $picklist;
 614
 615     # delete all 'new' lineitems
 616     my $lis = $mgr->editor->search_acq_lineitem({picklist => $picklist->id, state => 'new'});
 617     for my $li (@$lis) {
 618         return 0 unless delete_lineitem($mgr, $li);
 619     }
 620
 621     # detach all non-'new' lineitems
 622     $lis = $mgr->editor->search_acq_lineitem({picklist => $picklist->id, state => {'!=' => 'new'}});
 623     for my $li (@$lis) {
 624         $li->clear_picklist;
 625         return 0 unless update_lineitem($mgr, $li);
 626     }
 627
 628     # remove any picklist-specific object perms
 629     my $ops = $mgr->editor->search_permission_usr_object_perm_map({object_type => 'acqpl', object_id => ''.$picklist->id});
 630     for my $op (@$ops) {
 631         return 0 unless $mgr->editor->delete_usr_object_perm_map($op);
 632     }
 633
 634     return $mgr->editor->delete_acq_picklist($picklist);
 635 }
 636
 637 # ----------------------------------------------------------------------------
 638 # Purchase Order
 639 # ----------------------------------------------------------------------------
 640 sub update_purchase_order {
 641     my($mgr, $po) = @_;
 642     $po = $mgr->editor->retrieve_acq_purchase_order($po) unless ref $po;
 643     $po->editor($mgr->editor->requestor->id);
 644     $po->edit_time('now');
 645     $mgr->purchase_order($po);
 646     return $po if $mgr->editor->update_acq_purchase_order($po);
 647     return undef;
 648 }
 649
 650 sub create_purchase_order {
 651     my($mgr, %args) = @_;
 652     my $po = Fieldmapper::acq::purchase_order->new;
 653     $po->creator($mgr->editor->requestor->id);
 654     $po->editor($mgr->editor->requestor->id);
 655     $po->owner($mgr->editor->requestor->id);
 656     $po->edit_time('now');
 657     $po->create_time('now');
 658     $po->ordering_agency($mgr->editor->requestor->ws_ou);
 659     $po->$_($args{$_}) for keys %args;
 660     $mgr->purchase_order($po);
 661     return $mgr->editor->create_acq_purchase_order($po);
 662 }
 663
 664 # ----------------------------------------------------------------------------
 665 # if all of the lineitems for this PO are received,
 666 # mark the PO as received
 667 # ----------------------------------------------------------------------------
 668 sub check_purchase_order_received {
 669     my($mgr, $po_id) = @_;
 670
 671     my $non_recv_li = $mgr->editor->search_acq_lineitem(
 672         {   purchase_order => $po_id,
 673             state => {'!=' => 'received'}
 674         }, {idlist=>1});
 675
 676     return 1 if @$non_recv_li;
 677
 678     my $po = $mgr->editor->retrieve_acq_purchase_order($po_id);
 679     $po->state('received');
 680     return update_purchase_order($mgr, $po);
 681 }
 682
 683
 684 # ----------------------------------------------------------------------------
 685 # Bib, Callnumber, and Copy data
 686 # ----------------------------------------------------------------------------
 687
 688 sub create_lineitem_assets {
 689     my($mgr, $li_id) = @_;
 690     my $evt;
 691
 692     my $li = $mgr->editor->retrieve_acq_lineitem([
 693         $li_id,
 694         {   flesh => 1,
 695             flesh_fields => {jub => ['purchase_order', 'attributes']}
 696         }
 697     ]) or return 0;
 698
 699     # -----------------------------------------------------------------
 700     # first, create the bib record if necessary
 701     # -----------------------------------------------------------------
 702     my $new_bib = 0;
 703     unless($li->eg_bib_id) {
 704         create_bib($mgr, $li) or return 0;
 705         $new_bib = 1;
 706     }
 707
 708     my $li_details = $mgr->editor->search_acq_lineitem_detail({lineitem => $li_id}, {idlist=>1});
 709
 710     # -----------------------------------------------------------------
 711     # for each lineitem_detail, create the volume if necessary, create
 712     # a copy, and link them all together.
 713     # -----------------------------------------------------------------
 714     for my $lid_id (@{$li_details}) {
 715
 716         my $lid = $mgr->editor->retrieve_acq_lineitem_detail($lid_id) or return 0;
 717         next if $lid->eg_copy_id;
 718
 719         my $org = $lid->owning_lib;
 720         my $label = $lid->cn_label;
 721         my $bibid = $li->eg_bib_id;
 722
 723         my $volume = $mgr->cache($org, "cn.$bibid.$label");
 724         unless($volume) {
 725             $volume = create_volume($mgr, $li, $lid) or return 0;
 726             $mgr->cache($org, "cn.$bibid.$label", $volume);
 727         }
 728         create_copy($mgr, $volume, $lid) or return 0;
 729     }
 730
 731     return { li => $li, new_bib => $new_bib };
 732 }
 733
 734 sub create_bib {
 735     my($mgr, $li) = @_;
 736
 737     my $record = OpenILS::Application::Cat::BibCommon->biblio_record_xml_import(
 738         $mgr->editor,
 739         $li->marc,
 740         undef,
 741         undef,
 742         1, # override tcn collisions
 743         1, # no-ingest
 744         undef # $rec->bib_source
 745     );
 746
 747     if($U->event_code($record)) {
 748         $mgr->editor->event($record);
 749         $mgr->editor->rollback;
 750         return 0;
 751     }
 752
 753     $li->eg_bib_id($record->id);
 754     $mgr->add_bib;
 755     return update_lineitem($mgr, $li);
 756 }
 757
 758 sub create_volume {
 759     my($mgr, $li, $lid) = @_;
 760
 761     my ($volume, $evt) =
 762         OpenILS::Application::Cat::AssetCommon->find_or_create_volume(
 763             $mgr->editor,
 764             $lid->cn_label,
 765             $li->eg_bib_id,
 766             $lid->owning_lib
 767         );
 768
 769     if($evt) {
 770         $mgr->editor->event($evt);
 771         return 0;
 772     }
 773
 774     return $volume;
 775 }
 776
 777 sub create_copy {
 778     my($mgr, $volume, $lid) = @_;
 779     my $copy = Fieldmapper::asset::copy->new;
 780     $copy->isnew(1);
 781     $copy->loan_duration(2);
 782     $copy->fine_level(2);
 783     $copy->status(OILS_COPY_STATUS_ON_ORDER);
 784     $copy->barcode($lid->barcode);
 785     $copy->location($lid->location);
 786     $copy->call_number($volume->id);
 787     $copy->circ_lib($volume->owning_lib);
 788     $copy->circ_modifier($lid->circ_modifier);
 789
 790     my $evt = OpenILS::Application::Cat::AssetCommon->create_copy($mgr->editor, $volume, $copy);
 791     if($evt) {
 792         $mgr->editor->event($evt);
 793         return 0;
 794     }
 795
 796     $mgr->add_copy;
 797     $lid->eg_copy_id($copy->id);
 798     $mgr->editor->update_acq_lineitem_detail($lid) or return 0;
 799 }
 800
 801
 802
 803
 804
 805
 806 # ----------------------------------------------------------------------------
 807 # Workflow: Build a selection list from a Z39.50 search
 808 # ----------------------------------------------------------------------------
 809
 810 __PACKAGE__->register_method(
 811         method => 'zsearch',
 812         api_name => 'open-ils.acq.picklist.search.z3950',
 813     stream => 1,
 814         signature => {
 815         desc => 'Performs a z3950 federated search and creates a picklist and associated lineitems',
 816         params => [
 817             {desc => 'Authentication token', type => 'string'},
 818             {desc => 'Search definition', type => 'object'},
 819             {desc => 'Picklist name, optional', type => 'string'},
 820         ]
 821     }
 822 );
 823
 824 sub zsearch {
 825     my($self, $conn, $auth, $search, $name, $options) = @_;
 826     my $e = new_editor(authtoken=>$auth);
 827     return $e->event unless $e->checkauth;
 828     return $e->event unless $e->allowed('CREATE_PICKLIST');
 829
 830     $search->{limit} ||= 10;
 831     $options ||= {};
 832
 833     my $ses = OpenSRF::AppSession->create('open-ils.search');
 834     my $req = $ses->request('open-ils.search.z3950.search_class', $auth, $search);
 835
 836     my $first = 1;
 837     my $picklist;
 838     my $mgr;
 839     while(my $resp = $req->recv(timeout=>60)) {
 840
 841         if($first) {
 842             my $e = new_editor(requestor=>$e->requestor, xact=>1);
 843             $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
 844             $picklist = zsearch_build_pl($mgr, $name);
 845             $first = 0;
 846         }
 847
 848         my $result = $resp->content;
 849         my $count = $result->{count};
 850         $mgr->total( (($count < $search->{limit}) ? $count : $search->{limit})+1 );
 851
 852         for my $rec (@{$result->{records}}) {
 853
 854             my $li = create_lineitem($mgr,
 855                 picklist => $picklist->id,
 856                 source_label => $result->{service},
 857                 marc => $rec->{marcxml},
 858                 eg_bib_id => $rec->{bibid}
 859             );
 860
 861             if($$options{respond_li}) {
 862                 $li->attributes($mgr->editor->search_acq_lineitem_attr({lineitem => $li->id}))
 863                     if $$options{flesh_attrs};
 864                 $li->clear_marc if $$options{clear_marc};
 865                 $mgr->respond(lineitem => $li);
 866             } else {
 867                 $mgr->respond;
 868             }
 869         }
 870     }
 871
 872     $mgr->editor->commit;
 873     return $mgr->respond_complete;
 874 }
 875
 876 sub zsearch_build_pl {
 877     my($mgr, $name) = @_;
 878     $name ||= '';
 879
 880     my $picklist = $mgr->editor->search_acq_picklist({
 881         owner => $mgr->editor->requestor->id,
 882         name => $name
 883     })->[0];
 884
 885     if($name eq '' and $picklist) {
 886         return 0 unless delete_picklist($mgr, $picklist);
 887         $picklist = undef;
 888     }
 889
 890     return update_picklist($mgr, $picklist) if $picklist;
 891     return create_picklist($mgr, name => $name);
 892 }
 893
 894
 895 # ----------------------------------------------------------------------------
 896 # Workflow: Build a selection list / PO by importing a batch of MARC records
 897 # ----------------------------------------------------------------------------
 898
 899 __PACKAGE__->register_method(
 900     method => 'upload_records',
 901     api_name => 'open-ils.acq.process_upload_records',
 902     stream => 1,
 903 );
 904
 905 sub upload_records {
 906     my($self, $conn, $auth, $key) = @_;
 907
 908         my $e = new_editor(authtoken => $auth, xact => 1);
 909     return $e->die_event unless $e->checkauth;
 910     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
 911
 912     my $cache = OpenSRF::Utils::Cache->new;
 913
 914     my $data = $cache->get_cache("vandelay_import_spool_$key");
 915         my $purpose = $data->{purpose};
 916     my $filename = $data->{path};
 917     my $provider = $data->{provider};
 918     my $picklist = $data->{picklist};
 919     my $create_po = $data->{create_po};
 920     my $ordering_agency = $data->{ordering_agency};
 921     my $create_assets = $data->{create_assets};
 922     my $po;
 923     my $evt;
 924
 925     unless(-r $filename) {
 926         $logger->error("unable to read MARC file $filename");
 927         $e->rollback;
 928         return OpenILS::Event->new('FILE_UPLOAD_ERROR', payload => {filename => $filename});
 929     }
 930
 931     $provider = $e->retrieve_acq_provider($provider) or return $e->die_event;
 932
 933     if($picklist) {
 934         $picklist = $e->retrieve_acq_picklist($picklist) or return $e->die_event;
 935         if($picklist->owner != $e->requestor->id) {
 936             return $e->die_event unless
 937                 $e->allowed('CREATE_PICKLIST', $picklist->org_unit, $picklist);
 938         }
 939     }
 940
 941     if($create_po) {
 942         $po = create_purchase_order($mgr,
 943             ordering_agency => $ordering_agency,
 944             provider => $provider->id
 945         ) or return $mgr->editor->die_event;
 946     }
 947
 948     $logger->info("acq processing MARC file=$filename");
 949
 950     my $marctype = 'USMARC'; # ?
 951         my $batch = new MARC::Batch ($marctype, $filename);
 952         $batch->strict_off;
 953
 954         my $count = 0;
 955     my @li_list;
 956
 957         while(1) {
 958
 959             my $err;
 960         my $xml;
 961                 $count++;
 962         my $r;
 963
 964                 try {
 965             $r = $batch->next;
 966         } catch Error with {
 967             $err = shift;
 968                         $logger->warn("Proccessing of record $count in set $key failed with error $err.  Skipping this record");
 969         };
 970
 971         next if $err;
 972         last unless $r;
 973
 974                 try {
 975             ($xml = $r->as_xml_record()) =~ s/\n//sog;
 976             $xml =~ s/^<\?xml.+\?\s*>//go;
 977             $xml =~ s/>\s+</></go;
 978             $xml =~ s/\p{Cc}//go;
 979             $xml = $U->entityize($xml);
 980             $xml =~ s/[\x00-\x1f]//go;
 981
 982                 } catch Error with {
 983                         $err = shift;
 984                         $logger->warn("Proccessing XML of record $count in set $key failed with error $err.  Skipping this record");
 985                 };
 986
 987         next if $err or not $xml;
 988
 989         my %args = (
 990             source_label => $provider->code,
 991             provider => $provider->id,
 992             marc => $xml,
 993         );
 994
 995         $args{picklist} = $picklist->id if $picklist;
 996         if($po) {
 997             $args{purchase_order} = $po->id;
 998             $args{state} = 'on-order';
 999         }
1000
1001         my $li = create_lineitem($mgr, %args) or return $mgr->editor->die_event;
1002         $mgr->respond;
1003         $li->provider($provider); # flesh it, we'll need it later
1004
1005         import_lineitem_details($mgr, $ordering_agency, $li) or return $mgr->editor->die_event;
1006         $mgr->respond;
1007
1008         push(@li_list, $li->id);
1009         $mgr->respond;
1010         }
1011
1012         $e->commit;
1013     unlink($filename);
1014     $cache->delete_cache('vandelay_import_spool_' . $key);
1015
1016     if($create_assets) {
1017         create_lineitem_list_assets($mgr, \@li_list) or return $e->die_event;
1018     }
1019
1020     return $mgr->respond_complete;
1021 }
1022
1023 sub import_lineitem_details {
1024     my($mgr, $ordering_agency, $li) = @_;
1025
1026     my $holdings = $mgr->editor->json_query({from => ['acq.extract_provider_holding_data', $li->id]});
1027     return 1 unless @$holdings;
1028     my $org_path = $U->get_org_ancestors($ordering_agency);
1029     $org_path = [ reverse (@$org_path) ];
1030     my $price;
1031
1032     my $idx = 1;
1033     while(1) {
1034         # create a lineitem detail for each copy in the data
1035
1036         my $compiled = extract_lineitem_detail_data($mgr, $org_path, $holdings, $idx);
1037         last unless defined $compiled;
1038         return 0 unless $compiled;
1039
1040         # this takes the price of the last copy and uses it as the lineitem price
1041         # need to determine if a given record would include different prices for the same item
1042         $price = $$compiled{price};
1043
1044         for(1..$$compiled{quantity}) {
1045             my $lid = create_lineitem_detail($mgr,
1046                 lineitem => $li->id,
1047                 owning_lib => $$compiled{owning_lib},
1048                 cn_label => $$compiled{call_number},
1049                 fund => $$compiled{fund},
1050                 circ_modifier => $$compiled{circ_modifier},
1051                 note => $$compiled{note},
1052                 location => $$compiled{copy_location}
1053             ) or return 0;
1054         }
1055
1056         $mgr->respond;
1057         $idx++;
1058     }
1059
1060     # set the price attr so we'll know the source of the price
1061     set_lineitem_attr(
1062         $mgr,
1063         attr_name => 'estimated_price',
1064         attr_type => 'lineitem_local_attr_definition',
1065         attr_value => $price,
1066         lineitem => $li->id
1067     ) or return 0;
1068
1069     # if we're creating a purchase order, create the debits
1070     if($li->purchase_order) {
1071         create_lineitem_debits($mgr, $li, $price, 2) or return 0;
1072         $mgr->respond;
1073     }
1074
1075     return 1;
1076 }
1077
1078 # return hash on success, 0 on error, undef on no more holdings
1079 sub extract_lineitem_detail_data {
1080     my($mgr, $org_path, $holdings, $index) = @_;
1081
1082     my @data_list = grep { $_->{holding} eq $index } @$holdings;
1083     return undef unless @data_list;
1084
1085     my %compiled = map { $_->{attr} => $_->{data} } @data_list;
1086     my $base_org = $$org_path[0];
1087
1088     my $killme = sub {
1089         my $msg = shift;
1090         $logger->error("Item import extraction error: $msg");
1091         $logger->error('Holdings Data: ' . OpenSRF::Utils::JSON->perl2JSON(\%compiled));
1092         $mgr->editor->rollback;
1093         $mgr->editor->event(OpenILS::Event->new('ACQ_IMPORT_ERROR', payload => $msg));
1094         return 0;
1095     };
1096
1097     $compiled{quantity} ||= 1;
1098
1099     # ---------------------------------------------------------------------
1100     # Fund
1101     my $code = $compiled{fund_code};
1102     return $killme->('no fund code provided') unless $code;
1103
1104     my $fund = $mgr->cache($base_org, "fund.$code");
1105     unless($fund) {
1106         # search up the org tree for the most appropriate fund
1107         for my $org (@$org_path) {
1108             $fund = $mgr->editor->search_acq_fund(
1109                 {org => $org, code => $code, year => DateTime->now->year}, {idlist => 1})->[0];
1110             last if $fund;
1111         }
1112     }
1113     return $killme->("no fund with code $code at orgs [@$org_path]") unless $fund;
1114     $compiled{fund} = $fund;
1115     $mgr->cache($base_org, "fund.$code", $fund);
1116
1117
1118     # ---------------------------------------------------------------------
1119     # Owning lib
1120     my $sn = $compiled{owning_lib};
1121     return $killme->('no owning_lib defined') unless $sn;
1122     my $org_id =
1123         $mgr->cache($base_org, "orgsn.$sn") ||
1124             $mgr->editor->search_actor_org_unit({shortname => $sn}, {idlist => 1})->[0];
1125     return $killme->("invalid owning_lib defined: $sn") unless $org_id;
1126     $compiled{owning_lib} = $org_id;
1127     $mgr->cache($$org_path[0], "orgsn.$sn", $org_id);
1128
1129
1130     # ---------------------------------------------------------------------
1131     # Circ Modifier
1132     my $mod;
1133     $code = $compiled{circ_modifier};
1134
1135     if($code) {
1136
1137         $mod = $mgr->cache($base_org, "mod.$code") ||
1138             $mgr->editor->retrieve_config_circ_modifier($code);
1139         return $killme->("invlalid circ_modifier $code") unless $mod;
1140         $mgr->cache($base_org, "mod.$code", $mod);
1141
1142     } else {
1143         # try the default
1144         $mod = get_default_circ_modifier($mgr, $base_org)
1145             or return $killme->('no circ_modifier defined');
1146     }
1147
1148     $compiled{circ_modifier} = $mod;
1149
1150
1151     # ---------------------------------------------------------------------
1152     # Shelving Location
1153     my $name = $compiled{copy_location};
1154     return $killme->('no copy_location defined') unless $name;
1155     my $loc = $mgr->cache($base_org, "copy_loc.$name");
1156     unless($loc) {
1157         for my $org (@$org_path) {
1158             $loc = $mgr->editor->search_asset_copy_location(
1159                 {owning_lib => $org, name => $name}, {idlist => 1})->[0];
1160             last if $loc;
1161         }
1162     }
1163     return $killme->("Invalid copy location $name") unless $loc;
1164     $compiled{copy_location} = $loc;
1165     $mgr->cache($base_org, "copy_loc.$name", $loc);
1166
1167     return \%compiled;
1168 }
1169
1170
1171
1172 # ----------------------------------------------------------------------------
1173 # Workflow: Given an existing purchase order, import/create the bibs,
1174 # callnumber and copy objects
1175 # ----------------------------------------------------------------------------
1176
1177 __PACKAGE__->register_method(
1178         method => 'create_po_assets',
1179         api_name        => 'open-ils.acq.purchase_order.assets.create',
1180         signature => {
1181         desc => q/Creates assets for each lineitem in the purchase order/,
1182         params => [
1183             {desc => 'Authentication token', type => 'string'},
1184             {desc => 'The purchase order id', type => 'number'},
1185         ],
1186         return => {desc => 'Streams a total versus completed counts object, event on error'}
1187     }
1188 );
1189
1190 sub create_po_assets {
1191     my($self, $conn, $auth, $po_id) = @_;
1192
1193     my $e = new_editor(authtoken=>$auth, xact=>1);
1194     return $e->die_event unless $e->checkauth;
1195     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1196
1197     my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->die_event;
1198     return $e->die_event unless $e->allowed('IMPORT_PURCHASE_ORDER_ASSETS', $po->ordering_agency);
1199
1200     my $li_ids = $e->search_acq_lineitem({purchase_order => $po_id}, {idlist => 1});
1201
1202     # it's ugly, but it's fast.  Get the total count of lineitem detail objects to process
1203     my $lid_total = $e->json_query({
1204         select => { acqlid => [{aggregate => 1, transform => 'count', column => 'id'}] },
1205         from => {
1206             acqlid => {
1207                 jub => {
1208                     fkey => 'lineitem',
1209                     field => 'id',
1210                     join => {acqpo => {fkey => 'purchase_order', field => 'id'}}
1211                 }
1212             }
1213         },
1214         where => {'+acqpo' => {id => $po_id}}
1215     })->[0]->{id};
1216
1217     $mgr->total(scalar(@$li_ids) + $lid_total);
1218
1219     create_lineitem_list_assets($mgr, $li_ids) or return $e->die_event;
1220
1221     $e->xact_begin;
1222     update_purchase_order($mgr, $po) or return $e->die_event;
1223     $e->commit;
1224
1225     return $mgr->respond_complete;
1226 }
1227
1228
1229
1230 __PACKAGE__->register_method(
1231         method => 'create_purchase_order_api',
1232         api_name        => 'open-ils.acq.purchase_order.create',
1233         signature => {
1234         desc => 'Creates a new purchase order',
1235         params => [
1236             {desc => 'Authentication token', type => 'string'},
1237             {desc => 'purchase_order to create', type => 'object'}
1238         ],
1239         return => {desc => 'The purchase order id, Event on failure'}
1240     }
1241 );
1242
1243 sub create_purchase_order_api {
1244     my($self, $conn, $auth, $po, $args) = @_;
1245     $args ||= {};
1246
1247     my $e = new_editor(xact=>1, authtoken=>$auth);
1248     return $e->die_event unless $e->checkauth;
1249     return $e->die_event unless $e->allowed('CREATE_PURCHASE_ORDER', $po->ordering_agency);
1250     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1251
1252     # create the PO
1253     my %pargs = (ordering_agency => $e->requestor->ws_ou);
1254     $pargs{provider} = $po->provider if $po->provider;
1255     $po = create_purchase_order($mgr, %pargs) or return $e->die_event;
1256
1257     my $li_ids = $$args{lineitems};
1258
1259     if($li_ids) {
1260
1261         for my $li_id (@$li_ids) {
1262
1263             my $li = $e->retrieve_acq_lineitem([
1264                 $li_id,
1265                 {flesh => 1, flesh_fields => {jub => ['attributes']}}
1266             ]) or return $e->die_event;
1267
1268             $li->provider($po->provider);
1269             $li->purchase_order($po->id);
1270             update_lineitem($mgr, $li) or return $e->die_event;
1271             $mgr->respond;
1272
1273             create_lineitem_debits($mgr, $li) or return $e->die_event;
1274         }
1275     }
1276
1277     # commit before starting the asset creation
1278     $e->xact_commit;
1279
1280     if($li_ids and $$args{create_assets}) {
1281         create_lineitem_list_assets($mgr, $li_ids) or return $e->die_event;
1282     }
1283
1284     return $mgr->respond_complete;
1285 }
1286
1287
1288 __PACKAGE__->register_method(
1289         method => 'lineitem_detail_CUD_batch',
1290         api_name => 'open-ils.acq.lineitem_detail.cud.batch',
1291     stream => 1,
1292         signature => {
1293         desc => q/Creates a new purchase order line item detail.
1294             Additionally creates the associated fund_debit/,
1295         params => [
1296             {desc => 'Authentication token', type => 'string'},
1297             {desc => 'List of lineitem_details to create', type => 'array'},
1298         ],
1299         return => {desc => 'Streaming response of current position in the array'}
1300     }
1301 );
1302
1303 sub lineitem_detail_CUD_batch {
1304     my($self, $conn, $auth, $li_details) = @_;
1305
1306     my $e = new_editor(xact=>1, authtoken=>$auth);
1307     return $e->die_event unless $e->checkauth;
1308     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1309
1310     # XXX perms
1311
1312     $mgr->total(scalar(@$li_details));
1313
1314     my %li_cache;
1315
1316     for my $lid (@$li_details) {
1317
1318         my $li = $li_cache{$lid->lineitem} || $e->retrieve_acq_lineitem($lid->lineitem);
1319
1320         if($lid->isnew) {
1321             create_lineitem_detail($mgr, %{$lid->to_bare_hash}) or return $e->die_event;
1322
1323         } elsif($lid->ischanged) {
1324             $e->update_acq_lineitem_detail($lid) or return $e->die_event;
1325
1326         } elsif($lid->isdeleted) {
1327             delete_lineitem_detail($mgr, $lid) or return $e->die_event;
1328         }
1329
1330         $mgr->respond(li => $li);
1331         $li_cache{$lid->lineitem} = $li;
1332     }
1333
1334     $e->commit;
1335     return $mgr->respond_complete;
1336 }
1337
1338
1339 __PACKAGE__->register_method(
1340         method => 'receive_po_api',
1341         api_name        => 'open-ils.acq.purchase_order.receive'
1342 );
1343
1344 sub receive_po_api {
1345     my($self, $conn, $auth, $po_id) = @_;
1346     my $e = new_editor(xact => 1, authtoken => $auth);
1347     return $e->die_event unless $e->checkauth;
1348     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1349
1350     my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->die_event;
1351     return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency);
1352
1353     my $li_ids = $e->search_acq_lineitem({purchase_order => $po_id}, {idlist => 1});
1354
1355     for my $li_id (@$li_ids) {
1356         receive_lineitem($mgr, $li_id) or return $e->die_event;
1357         $mgr->respond;
1358     }
1359
1360     $po->state('received');
1361     update_purchase_order($mgr, $po) or return $e->die_event;
1362
1363     $e->commit;
1364     return $mgr->respond_complete;
1365 }
1366
1367
1368 __PACKAGE__->register_method(
1369         method => 'receive_lineitem_detail_api',
1370         api_name        => 'open-ils.acq.lineitem_detail.receive',
1371         signature => {
1372         desc => 'Mark a lineitem_detail as received',
1373         params => [
1374             {desc => 'Authentication token', type => 'string'},
1375             {desc => 'lineitem detail ID', type => 'number'}
1376         ],
1377         return => {desc => '1 on success, Event on error'}
1378     }
1379 );
1380
1381 sub receive_lineitem_detail_api {
1382     my($self, $conn, $auth, $lid_id) = @_;
1383
1384     my $e = new_editor(xact=>1, authtoken=>$auth);
1385     return $e->die_event unless $e->checkauth;
1386     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1387
1388     my $lid = $e->retrieve_acq_lineitem_detail([
1389         $lid_id, {
1390             flesh => 2,
1391             flesh_fields => {
1392                 acqlid => ['lineitem'],
1393                 jub => ['purchase_order']
1394             }
1395         }
1396     ]);
1397
1398     return $e->die_event unless $e->allowed(
1399         'RECEIVE_PURCHASE_ORDER', $lid->lineitem->purchase_order->ordering_agency);
1400
1401     receive_lineitem_detail($mgr, $lid_id) or return $e->die_event;
1402     $e->commit;
1403     return 1;
1404 }
1405
1406 __PACKAGE__->register_method(
1407         method => 'receive_lineitem_api',
1408         api_name        => 'open-ils.acq.lineitem.receive',
1409         signature => {
1410         desc => 'Mark a lineitem as received',
1411         params => [
1412             {desc => 'Authentication token', type => 'string'},
1413             {desc => 'lineitem detail ID', type => 'number'}
1414         ],
1415         return => {desc => '1 on success, Event on error'}
1416     }
1417 );
1418
1419 sub receive_lineitem_api {
1420     my($self, $conn, $auth, $li_id) = @_;
1421
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 $li = $e->retrieve_acq_lineitem([
1427         $li_id, {
1428             flesh => 1,
1429             flesh_fields => {
1430                 jub => ['purchase_order']
1431             }
1432         }
1433     ]) or return $e->die_event;
1434
1435     return $e->die_event unless $e->allowed(
1436         'RECEIVE_PURCHASE_ORDER', $li->purchase_order->ordering_agency);
1437
1438     receive_lineitem($mgr, $li_id) or return $e->die_event;
1439     $e->commit;
1440     return 1;
1441 }
1442
1443
1444 __PACKAGE__->register_method(
1445         method => 'rollback_receive_po_api',
1446         api_name        => 'open-ils.acq.purchase_order.receive.rollback'
1447 );
1448
1449 sub rollback_receive_po_api {
1450     my($self, $conn, $auth, $po_id) = @_;
1451     my $e = new_editor(xact => 1, authtoken => $auth);
1452     return $e->die_event unless $e->checkauth;
1453     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1454
1455     my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->die_event;
1456     return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency);
1457
1458     my $li_ids = $e->search_acq_lineitem({purchase_order => $po_id}, {idlist => 1});
1459
1460     for my $li_id (@$li_ids) {
1461         rollback_receive_lineitem($mgr, $li_id) or return $e->die_event;
1462         $mgr->respond;
1463     }
1464
1465     $po->state('on-order');
1466     update_purchase_order($mgr, $po) or return $e->die_event;
1467
1468     $e->commit;
1469     return $mgr->respond_complete;
1470 }
1471
1472
1473 __PACKAGE__->register_method(
1474         method => 'rollback_receive_lineitem_detail_api',
1475         api_name        => 'open-ils.acq.lineitem_detail.receive.rollback',
1476         signature => {
1477         desc => 'Mark a lineitem_detail as received',
1478         params => [
1479             {desc => 'Authentication token', type => 'string'},
1480             {desc => 'lineitem detail ID', type => 'number'}
1481         ],
1482         return => {desc => '1 on success, Event on error'}
1483     }
1484 );
1485
1486 sub rollback_receive_lineitem_detail_api {
1487     my($self, $conn, $auth, $lid_id) = @_;
1488
1489     my $e = new_editor(xact=>1, authtoken=>$auth);
1490     return $e->die_event unless $e->checkauth;
1491     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1492
1493     my $lid = $e->retrieve_acq_lineitem_detail([
1494         $lid_id, {
1495             flesh => 2,
1496             flesh_fields => {
1497                 acqlid => ['lineitem'],
1498                 jub => ['purchase_order']
1499             }
1500         }
1501     ]);
1502     my $li = $lid->lineitem;
1503     my $po = $li->purchase_order;
1504
1505     return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency);
1506     rollback_receive_lineitem_detail($mgr, $lid_id) or return $e->die_event;
1507
1508     $li->state('on-order');
1509     $po->state('on-order');
1510     udpate_lineitem($mgr, $li) or return $e->die_event;
1511     udpate_purchase_order($mgr, $po) or return $e->die_event;
1512
1513     $e->commit;
1514     return 1;
1515 }
1516
1517 __PACKAGE__->register_method(
1518         method => 'rollback_receive_lineitem_api',
1519         api_name        => 'open-ils.acq.lineitem.receive.rollback',
1520         signature => {
1521         desc => 'Mark a lineitem as received',
1522         params => [
1523             {desc => 'Authentication token', type => 'string'},
1524             {desc => 'lineitem detail ID', type => 'number'}
1525         ],
1526         return => {desc => '1 on success, Event on error'}
1527     }
1528 );
1529
1530 sub rollback_receive_lineitem_api {
1531     my($self, $conn, $auth, $li_id) = @_;
1532
1533     my $e = new_editor(xact=>1, authtoken=>$auth);
1534     return $e->die_event unless $e->checkauth;
1535     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1536
1537     my $li = $e->retrieve_acq_lineitem_detail([
1538         $li_id, {
1539             flesh => 1,
1540             flesh_fields => {
1541                 jub => ['purchase_order']
1542             }
1543         }
1544     ]);
1545     my $po = $li->purchase_order;
1546
1547     return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency);
1548
1549     rollback_receive_lineitem($mgr, $li_id) or return $e->die_event;
1550
1551     $po->state('on-order');
1552     update_purchase_order($mgr, $po) or return $e->die_event;
1553
1554     $e->commit;
1555     return 1;
1556 }
1557
1558 1;