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