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

   1 package OpenILS::Application::Acq::BatchManager;
   2 use OpenSRF::AppSession;
   3 use OpenSRF::EX qw/:try/;
   4 use strict; use warnings;
   5
   6 sub new {
   7     my($class, %args) = @_;
   8     my $self = bless(\%args, $class);
   9     $self->{args} = {
  10         lid => 0,
  11         li => 0,
  12         copies => 0,
  13         bibs => 0,
  14         progress => 0,
  15         debits_accrued => 0,
  16         purchase_order => undef,
  17         picklist => undef,
  18         complete => 0,
  19         indexed => 0,
  20         total => 0
  21     };
  22     $self->{ingest_queue} = [];
  23     $self->{cache} = {};
  24     $self->throttle(5) unless $self->throttle;
  25     return $self;
  26 }
  27
  28 sub conn {
  29     my($self, $val) = @_;
  30     $self->{conn} = $val if $val;
  31     return $self->{conn};
  32 }
  33 sub throttle {
  34     my($self, $val) = @_;
  35     $self->{throttle} = $val if $val;
  36     return $self->{throttle};
  37 }
  38 sub respond {
  39     my($self, %other_args) = @_;
  40     if($self->throttle and not %other_args) {
  41         return unless (
  42             ($self->{args}->{progress} - $self->{last_respond_progress}) >= $self->throttle
  43         );
  44     }
  45     $self->conn->respond({ %{$self->{args}}, %other_args });
  46     $self->{last_respond_progress} = $self->{args}->{progress};
  47 }
  48 sub respond_complete {
  49     my($self, %other_args) = @_;
  50     $self->complete;
  51     $self->conn->respond_complete({ %{$self->{args}}, %other_args });
  52     return undef;
  53 }
  54 sub total {
  55     my($self, $val) = @_;
  56     $self->{args}->{total} = $val if defined $val;
  57     $self->{args}->{maximum} = $self->{args}->{total};
  58     return $self->{args}->{total};
  59 }
  60 sub purchase_order {
  61     my($self, $val) = @_;
  62     $self->{args}->{purchase_order} = $val if $val;
  63     return $self;
  64 }
  65 sub picklist {
  66     my($self, $val) = @_;
  67     $self->{args}->{picklist} = $val if $val;
  68     return $self;
  69 }
  70 sub add_lid {
  71     my $self = shift;
  72     $self->{args}->{lid} += 1;
  73     $self->{args}->{progress} += 1;
  74     return $self;
  75 }
  76 sub add_li {
  77     my $self = shift;
  78     $self->{args}->{li} += 1;
  79     $self->{args}->{progress} += 1;
  80     return $self;
  81 }
  82 sub add_copy {
  83     my $self = shift;
  84     $self->{args}->{copies} += 1;
  85     $self->{args}->{progress} += 1;
  86     return $self;
  87 }
  88 sub add_bib {
  89     my $self = shift;
  90     $self->{args}->{bibs} += 1;
  91     $self->{args}->{progress} += 1;
  92     return $self;
  93 }
  94 sub add_debit {
  95     my($self, $amount) = @_;
  96     $self->{args}->{debits_accrued} += $amount;
  97     $self->{args}->{progress} += 1;
  98     return $self;
  99 }
 100 sub editor {
 101     my($self, $editor) = @_;
 102     $self->{editor} = $editor if defined $editor;
 103     return $self->{editor};
 104 }
 105 sub complete {
 106     my $self = shift;
 107     $self->{args}->{complete} = 1;
 108     return $self;
 109 }
 110
 111 sub ingest_ses {
 112     my($self, $val) = @_;
 113     $self->{ingest_ses} = $val if $val;
 114     return $self->{ingest_ses};
 115 }
 116
 117 sub push_ingest_queue {
 118     my($self, $rec_id) = @_;
 119
 120     $self->ingest_ses(OpenSRF::AppSession->connect('open-ils.ingest'))
 121         unless $self->ingest_ses;
 122
 123     my $req = $self->ingest_ses->request('open-ils.ingest.full.biblio.record', $rec_id);
 124
 125     push(@{$self->{ingest_queue}}, $req);
 126 }
 127
 128 sub process_ingest_records {
 129     my $self = shift;
 130     return unless @{$self->{ingest_queue}};
 131
 132     for my $req (@{$self->{ingest_queue}}) {
 133
 134         try {
 135             $req->gather(1);
 136             $self->{args}->{indexed} += 1;
 137             $self->{args}->{progress} += 1;
 138         } otherwise {};
 139
 140         $self->respond;
 141     }
 142     $self->ingest_ses->disconnect;
 143 }
 144
 145
 146 sub cache {
 147     my($self, $org, $key, $val) = @_;
 148     $self->{cache}->{$org} = {} unless $self->{cache}->{org};
 149     $self->{cache}->{$org}->{$key} = $val if defined $val;
 150     return $self->{cache}->{$org}->{$key};
 151 }
 152
 153
 154 package OpenILS::Application::Acq::Order;
 155 use base qw/OpenILS::Application/;
 156 use strict; use warnings;
 157 # ----------------------------------------------------------------------------
 158 # Break up each component of the order process and pieces into managable
 159 # actions that can be shared across different workflows
 160 # ----------------------------------------------------------------------------
 161 use OpenILS::Event;
 162 use OpenSRF::Utils::Logger qw(:logger);
 163 use OpenSRF::Utils::JSON;
 164 use OpenILS::Utils::Fieldmapper;
 165 use OpenILS::Utils::CStoreEditor q/:funcs/;
 166 use OpenILS::Const qw/:const/;
 167 use OpenSRF::EX q/:try/;
 168 use OpenILS::Application::AppUtils;
 169 use OpenILS::Application::Cat::BibCommon;
 170 use OpenILS::Application::Cat::AssetCommon;
 171 use MARC::Record;
 172 use MARC::Batch;
 173 use MARC::File::XML;
 174 my $U = 'OpenILS::Application::AppUtils';
 175
 176
 177 # ----------------------------------------------------------------------------
 178 # Lineitem
 179 # ----------------------------------------------------------------------------
 180 sub create_lineitem {
 181     my($mgr, %args) = @_;
 182     my $li = Fieldmapper::acq::lineitem->new;
 183     $li->creator($mgr->editor->requestor->id);
 184     $li->selector($li->creator);
 185     $li->editor($li->creator);
 186     $li->create_time('now');
 187     $li->edit_time('now');
 188     $li->state('new');
 189     $li->$_($args{$_}) for keys %args;
 190     $li->clear_id;
 191     $mgr->add_li;
 192     return $mgr->editor->create_acq_lineitem($li);
 193 }
 194
 195 sub update_lineitem {
 196     my($mgr, $li) = @_;
 197     $li->edit_time('now');
 198     $li->editor($mgr->editor->requestor->id);
 199     $mgr->add_li;
 200     return $li if $mgr->editor->update_acq_lineitem($li);
 201     return undef;
 202 }
 203
 204 sub delete_lineitem {
 205     my($mgr, $li) = @_;
 206     $li = $mgr->editor->retrieve_acq_lineitem($li) unless ref $li;
 207
 208     # delete the attached lineitem_details
 209     my $lid_ids = $mgr->editor->search_acq_lineitem_detail({lineitem => $li->id}, {idlist=>1});
 210     for my $lid_id (@$lid_ids) {
 211         return 0 unless delete_lineitem_detail($mgr, $lid_id);
 212     }
 213
 214     $mgr->add_li;
 215     return $mgr->editor->delete_acq_lineitem($li);
 216 }
 217
 218 # begins and commit transactions as it goes
 219 sub create_lineitem_list_assets {
 220     my($mgr, $li_ids) = @_;
 221     # create the bibs/volumes/copies and ingest the records
 222     for my $li_id (@$li_ids) {
 223         $mgr->editor->xact_begin;
 224         my $data = create_lineitem_assets($mgr, $li_id) or return undef;
 225         $mgr->editor->xact_commit;
 226         $mgr->push_ingest_queue($data->{li}->eg_bib_id) if $data->{new_bib};
 227         $mgr->respond;
 228     }
 229     $mgr->process_ingest_records;
 230     return 1;
 231 }
 232
 233 # ----------------------------------------------------------------------------
 234 # if all of the lineitem details for this lineitem have
 235 # been received, mark the lineitem as received
 236 # returns 1 on non-received, li on received, 0 on error
 237 # ----------------------------------------------------------------------------
 238 sub check_lineitem_received {
 239     my($mgr, $li_id) = @_;
 240
 241     my $non_recv = $mgr->editor->search_acq_lineitem_detail(
 242         {recv_time => undef, lineitem => $li_id}, {idlist=>1});
 243
 244     return 1 if @$non_recv;
 245
 246     my $li = $mgr->editor->retrieve_acq_lineitem($li_id);
 247     $li->state('received');
 248     return update_lineitem($mgr, $li);
 249 }
 250
 251 sub receive_lineitem {
 252     my($mgr, $li_id, $skip_complete_check) = @_;
 253     my $li = $mgr->editor->retrieve_acq_lineitem($li_id) or return 0;
 254
 255     my $lid_ids = $mgr->editor->search_acq_lineitem_detail(
 256         {lineitem => $li_id, recv_time => undef}, {idlist => 1});
 257
 258     for my $lid_id (@$lid_ids) {
 259        receive_lineitem_detail($mgr, $lid_id, 1) or return 0;
 260     }
 261
 262     $mgr->add_li;
 263     $li->state('received');
 264     update_lineitem($mgr, $li) or return 0;
 265     return 1 if $skip_complete_check;
 266
 267     return check_purchase_order_received($mgr, $li->purchase_order);
 268 }
 269
 270 sub rollback_receive_lineitem {
 271     my($mgr, $li_id) = @_;
 272     my $li = $mgr->editor->retrieve_acq_lineitem($li_id) or return 0;
 273
 274     my $lid_ids = $mgr->editor->search_acq_lineitem_detail(
 275         {lineitem => $li_id, recv_time => {'!=' => undef}}, {idlist => 1});
 276
 277     for my $lid_id (@$lid_ids) {
 278        rollback_receive_lineitem_detail($mgr, $lid_id, 1) or return 0;
 279     }
 280
 281     $mgr->add_li;
 282     $li->state('on-order');
 283     return update_lineitem($mgr, $li);
 284 }
 285
 286 # ----------------------------------------------------------------------------
 287 # Lineitem Detail
 288 # ----------------------------------------------------------------------------
 289 sub create_lineitem_detail {
 290     my($mgr, %args) = @_;
 291     my $lid = Fieldmapper::acq::lineitem_detail->new;
 292     $lid->$_($args{$_}) for keys %args;
 293     $lid->clear_id;
 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     $debit->clear_id;
 572     $mgr->add_debit($debit->amount);
 573     return $mgr->editor->create_acq_fund_debit($debit);
 574 }
 575
 576 sub currency_conversion {
 577     my($mgr, $src_currency, $dest_currency, $amount) = @_;
 578     my $result = $mgr->editor->json_query(
 579         {from => ['acq.exchange_ratio', $src_currency, $dest_currency, $amount]});
 580     return $result->[0]->{'acq.exchange_ratio'};
 581 }
 582
 583
 584 # ----------------------------------------------------------------------------
 585 # Picklist
 586 # ----------------------------------------------------------------------------
 587 sub create_picklist {
 588     my($mgr, %args) = @_;
 589     my $picklist = Fieldmapper::acq::picklist->new;
 590     $picklist->creator($mgr->editor->requestor->id);
 591     $picklist->owner($picklist->creator);
 592     $picklist->editor($picklist->creator);
 593     $picklist->create_time('now');
 594     $picklist->edit_time('now');
 595     $picklist->org_unit($mgr->editor->requestor->ws_ou);
 596     $picklist->owner($mgr->editor->requestor->id);
 597     $picklist->$_($args{$_}) for keys %args;
 598     $picklist->clear_id;
 599     $mgr->picklist($picklist);
 600     return $mgr->editor->create_acq_picklist($picklist);
 601 }
 602
 603 sub update_picklist {
 604     my($mgr, $picklist) = @_;
 605     $picklist = $mgr->editor->retrieve_acq_picklist($picklist) unless ref $picklist;
 606     $picklist->edit_time('now');
 607     $picklist->editor($mgr->editor->requestor->id);
 608     $mgr->picklist($picklist);
 609     return $picklist if $mgr->editor->update_acq_picklist($picklist);
 610     return undef;
 611 }
 612
 613 sub delete_picklist {
 614     my($mgr, $picklist) = @_;
 615     $picklist = $mgr->editor->retrieve_acq_picklist($picklist) unless ref $picklist;
 616
 617     # delete all 'new' lineitems
 618     my $lis = $mgr->editor->search_acq_lineitem({picklist => $picklist->id, state => 'new'});
 619     for my $li (@$lis) {
 620         return 0 unless delete_lineitem($mgr, $li);
 621     }
 622
 623     # detach all non-'new' lineitems
 624     $lis = $mgr->editor->search_acq_lineitem({picklist => $picklist->id, state => {'!=' => 'new'}});
 625     for my $li (@$lis) {
 626         $li->clear_picklist;
 627         return 0 unless update_lineitem($mgr, $li);
 628     }
 629
 630     # remove any picklist-specific object perms
 631     my $ops = $mgr->editor->search_permission_usr_object_perm_map({object_type => 'acqpl', object_id => ''.$picklist->id});
 632     for my $op (@$ops) {
 633         return 0 unless $mgr->editor->delete_usr_object_perm_map($op);
 634     }
 635
 636     return $mgr->editor->delete_acq_picklist($picklist);
 637 }
 638
 639 # ----------------------------------------------------------------------------
 640 # Purchase Order
 641 # ----------------------------------------------------------------------------
 642 sub update_purchase_order {
 643     my($mgr, $po) = @_;
 644     $po = $mgr->editor->retrieve_acq_purchase_order($po) unless ref $po;
 645     $po->editor($mgr->editor->requestor->id);
 646     $po->edit_time('now');
 647     $mgr->purchase_order($po);
 648     return $po if $mgr->editor->update_acq_purchase_order($po);
 649     return undef;
 650 }
 651
 652 sub create_purchase_order {
 653     my($mgr, %args) = @_;
 654     my $po = Fieldmapper::acq::purchase_order->new;
 655     $po->creator($mgr->editor->requestor->id);
 656     $po->editor($mgr->editor->requestor->id);
 657     $po->owner($mgr->editor->requestor->id);
 658     $po->edit_time('now');
 659     $po->create_time('now');
 660     $po->ordering_agency($mgr->editor->requestor->ws_ou);
 661     $po->$_($args{$_}) for keys %args;
 662     $po->clear_id;
 663     $mgr->purchase_order($po);
 664     return $mgr->editor->create_acq_purchase_order($po);
 665 }
 666
 667 # ----------------------------------------------------------------------------
 668 # if all of the lineitems for this PO are received,
 669 # mark the PO as received
 670 # ----------------------------------------------------------------------------
 671 sub check_purchase_order_received {
 672     my($mgr, $po_id) = @_;
 673
 674     my $non_recv_li = $mgr->editor->search_acq_lineitem(
 675         {   purchase_order => $po_id,
 676             state => {'!=' => 'received'}
 677         }, {idlist=>1});
 678
 679     return 1 if @$non_recv_li;
 680
 681     my $po = $mgr->editor->retrieve_acq_purchase_order($po_id);
 682     $po->state('received');
 683     return update_purchase_order($mgr, $po);
 684 }
 685
 686
 687 # ----------------------------------------------------------------------------
 688 # Bib, Callnumber, and Copy data
 689 # ----------------------------------------------------------------------------
 690
 691 sub create_lineitem_assets {
 692     my($mgr, $li_id) = @_;
 693     my $evt;
 694
 695     my $li = $mgr->editor->retrieve_acq_lineitem([
 696         $li_id,
 697         {   flesh => 1,
 698             flesh_fields => {jub => ['purchase_order', 'attributes']}
 699         }
 700     ]) or return 0;
 701
 702     # -----------------------------------------------------------------
 703     # first, create the bib record if necessary
 704     # -----------------------------------------------------------------
 705     my $new_bib = 0;
 706     unless($li->eg_bib_id) {
 707         create_bib($mgr, $li) or return 0;
 708         $new_bib = 1;
 709     }
 710
 711     my $li_details = $mgr->editor->search_acq_lineitem_detail({lineitem => $li_id}, {idlist=>1});
 712
 713     # -----------------------------------------------------------------
 714     # for each lineitem_detail, create the volume if necessary, create
 715     # a copy, and link them all together.
 716     # -----------------------------------------------------------------
 717     for my $lid_id (@{$li_details}) {
 718
 719         my $lid = $mgr->editor->retrieve_acq_lineitem_detail($lid_id) or return 0;
 720         next if $lid->eg_copy_id;
 721
 722         my $org = $lid->owning_lib;
 723         my $label = $lid->cn_label;
 724         my $bibid = $li->eg_bib_id;
 725
 726         my $volume = $mgr->cache($org, "cn.$bibid.$label");
 727         unless($volume) {
 728             $volume = create_volume($mgr, $li, $lid) or return 0;
 729             $mgr->cache($org, "cn.$bibid.$label", $volume);
 730         }
 731         create_copy($mgr, $volume, $lid) or return 0;
 732     }
 733
 734     return { li => $li, new_bib => $new_bib };
 735 }
 736
 737 sub create_bib {
 738     my($mgr, $li) = @_;
 739
 740     my $record = OpenILS::Application::Cat::BibCommon->biblio_record_xml_import(
 741         $mgr->editor,
 742         $li->marc,
 743         undef,
 744         undef,
 745         1, # override tcn collisions
 746         1, # no-ingest
 747         undef # $rec->bib_source
 748     );
 749
 750     if($U->event_code($record)) {
 751         $mgr->editor->event($record);
 752         $mgr->editor->rollback;
 753         return 0;
 754     }
 755
 756     $li->eg_bib_id($record->id);
 757     $mgr->add_bib;
 758     return update_lineitem($mgr, $li);
 759 }
 760
 761 sub create_volume {
 762     my($mgr, $li, $lid) = @_;
 763
 764     my ($volume, $evt) =
 765         OpenILS::Application::Cat::AssetCommon->find_or_create_volume(
 766             $mgr->editor,
 767             $lid->cn_label,
 768             $li->eg_bib_id,
 769             $lid->owning_lib
 770         );
 771
 772     if($evt) {
 773         $mgr->editor->event($evt);
 774         return 0;
 775     }
 776
 777     return $volume;
 778 }
 779
 780 sub create_copy {
 781     my($mgr, $volume, $lid) = @_;
 782     my $copy = Fieldmapper::asset::copy->new;
 783     $copy->isnew(1);
 784     $copy->loan_duration(2);
 785     $copy->fine_level(2);
 786     $copy->status(OILS_COPY_STATUS_ON_ORDER);
 787     $copy->barcode($lid->barcode);
 788     $copy->location($lid->location);
 789     $copy->call_number($volume->id);
 790     $copy->circ_lib($volume->owning_lib);
 791     $copy->circ_modifier($lid->circ_modifier);
 792
 793     my $evt = OpenILS::Application::Cat::AssetCommon->create_copy($mgr->editor, $volume, $copy);
 794     if($evt) {
 795         $mgr->editor->event($evt);
 796         return 0;
 797     }
 798
 799     $mgr->add_copy;
 800     $lid->eg_copy_id($copy->id);
 801     $mgr->editor->update_acq_lineitem_detail($lid) or return 0;
 802 }
 803
 804
 805
 806
 807
 808
 809 # ----------------------------------------------------------------------------
 810 # Workflow: Build a selection list from a Z39.50 search
 811 # ----------------------------------------------------------------------------
 812
 813 __PACKAGE__->register_method(
 814         method => 'zsearch',
 815         api_name => 'open-ils.acq.picklist.search.z3950',
 816     stream => 1,
 817         signature => {
 818         desc => 'Performs a z3950 federated search and creates a picklist and associated lineitems',
 819         params => [
 820             {desc => 'Authentication token', type => 'string'},
 821             {desc => 'Search definition', type => 'object'},
 822             {desc => 'Picklist name, optional', type => 'string'},
 823         ]
 824     }
 825 );
 826
 827 sub zsearch {
 828     my($self, $conn, $auth, $search, $name, $options) = @_;
 829     my $e = new_editor(authtoken=>$auth);
 830     return $e->event unless $e->checkauth;
 831     return $e->event unless $e->allowed('CREATE_PICKLIST');
 832
 833     $search->{limit} ||= 10;
 834     $options ||= {};
 835
 836     my $ses = OpenSRF::AppSession->create('open-ils.search');
 837     my $req = $ses->request('open-ils.search.z3950.search_class', $auth, $search);
 838
 839     my $first = 1;
 840     my $picklist;
 841     my $mgr;
 842     while(my $resp = $req->recv(timeout=>60)) {
 843
 844         if($first) {
 845             my $e = new_editor(requestor=>$e->requestor, xact=>1);
 846             $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
 847             $picklist = zsearch_build_pl($mgr, $name);
 848             $first = 0;
 849         }
 850
 851         my $result = $resp->content;
 852         my $count = $result->{count};
 853         $mgr->total( (($count < $search->{limit}) ? $count : $search->{limit})+1 );
 854
 855         for my $rec (@{$result->{records}}) {
 856
 857             my $li = create_lineitem($mgr,
 858                 picklist => $picklist->id,
 859                 source_label => $result->{service},
 860                 marc => $rec->{marcxml},
 861                 eg_bib_id => $rec->{bibid}
 862             );
 863
 864             if($$options{respond_li}) {
 865                 $li->attributes($mgr->editor->search_acq_lineitem_attr({lineitem => $li->id}))
 866                     if $$options{flesh_attrs};
 867                 $li->clear_marc if $$options{clear_marc};
 868                 $mgr->respond(lineitem => $li);
 869             } else {
 870                 $mgr->respond;
 871             }
 872         }
 873     }
 874
 875     $mgr->editor->commit;
 876     return $mgr->respond_complete;
 877 }
 878
 879 sub zsearch_build_pl {
 880     my($mgr, $name) = @_;
 881     $name ||= '';
 882
 883     my $picklist = $mgr->editor->search_acq_picklist({
 884         owner => $mgr->editor->requestor->id,
 885         name => $name
 886     })->[0];
 887
 888     if($name eq '' and $picklist) {
 889         return 0 unless delete_picklist($mgr, $picklist);
 890         $picklist = undef;
 891     }
 892
 893     return update_picklist($mgr, $picklist) if $picklist;
 894     return create_picklist($mgr, name => $name);
 895 }
 896
 897
 898 # ----------------------------------------------------------------------------
 899 # Workflow: Build a selection list / PO by importing a batch of MARC records
 900 # ----------------------------------------------------------------------------
 901
 902 __PACKAGE__->register_method(
 903     method => 'upload_records',
 904     api_name => 'open-ils.acq.process_upload_records',
 905     stream => 1,
 906 );
 907
 908 sub upload_records {
 909     my($self, $conn, $auth, $key) = @_;
 910
 911         my $e = new_editor(authtoken => $auth, xact => 1);
 912     return $e->die_event unless $e->checkauth;
 913     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
 914
 915     my $cache = OpenSRF::Utils::Cache->new;
 916
 917     my $data = $cache->get_cache("vandelay_import_spool_$key");
 918         my $purpose = $data->{purpose};
 919     my $filename = $data->{path};
 920     my $provider = $data->{provider};
 921     my $picklist = $data->{picklist};
 922     my $create_po = $data->{create_po};
 923     my $ordering_agency = $data->{ordering_agency};
 924     my $create_assets = $data->{create_assets};
 925     my $po;
 926     my $evt;
 927
 928     unless(-r $filename) {
 929         $logger->error("unable to read MARC file $filename");
 930         $e->rollback;
 931         return OpenILS::Event->new('FILE_UPLOAD_ERROR', payload => {filename => $filename});
 932     }
 933
 934     $provider = $e->retrieve_acq_provider($provider) or return $e->die_event;
 935
 936     if($picklist) {
 937         $picklist = $e->retrieve_acq_picklist($picklist) or return $e->die_event;
 938         if($picklist->owner != $e->requestor->id) {
 939             return $e->die_event unless
 940                 $e->allowed('CREATE_PICKLIST', $picklist->org_unit, $picklist);
 941         }
 942     }
 943
 944     if($create_po) {
 945         $po = create_purchase_order($mgr,
 946             ordering_agency => $ordering_agency,
 947             provider => $provider->id
 948         ) or return $mgr->editor->die_event;
 949     }
 950
 951     $logger->info("acq processing MARC file=$filename");
 952
 953     my $marctype = 'USMARC'; # ?
 954         my $batch = new MARC::Batch ($marctype, $filename);
 955         $batch->strict_off;
 956
 957         my $count = 0;
 958     my @li_list;
 959
 960         while(1) {
 961
 962             my $err;
 963         my $xml;
 964                 $count++;
 965         my $r;
 966
 967                 try {
 968             $r = $batch->next;
 969         } catch Error with {
 970             $err = shift;
 971                         $logger->warn("Proccessing of record $count in set $key failed with error $err.  Skipping this record");
 972         };
 973
 974         next if $err;
 975         last unless $r;
 976
 977                 try {
 978             ($xml = $r->as_xml_record()) =~ s/\n//sog;
 979             $xml =~ s/^<\?xml.+\?\s*>//go;
 980             $xml =~ s/>\s+</></go;
 981             $xml =~ s/\p{Cc}//go;
 982             $xml = $U->entityize($xml);
 983             $xml =~ s/[\x00-\x1f]//go;
 984
 985                 } catch Error with {
 986                         $err = shift;
 987                         $logger->warn("Proccessing XML of record $count in set $key failed with error $err.  Skipping this record");
 988                 };
 989
 990         next if $err or not $xml;
 991
 992         my %args = (
 993             source_label => $provider->code,
 994             provider => $provider->id,
 995             marc => $xml,
 996         );
 997
 998         $args{picklist} = $picklist->id if $picklist;
 999         if($po) {
1000             $args{purchase_order} = $po->id;
1001             $args{state} = 'on-order';
1002         }
1003
1004         my $li = create_lineitem($mgr, %args) or return $mgr->editor->die_event;
1005         $mgr->respond;
1006         $li->provider($provider); # flesh it, we'll need it later
1007
1008         import_lineitem_details($mgr, $ordering_agency, $li) or return $mgr->editor->die_event;
1009         $mgr->respond;
1010
1011         push(@li_list, $li->id);
1012         $mgr->respond;
1013         }
1014
1015         $e->commit;
1016     unlink($filename);
1017     $cache->delete_cache('vandelay_import_spool_' . $key);
1018
1019     if($create_assets) {
1020         create_lineitem_list_assets($mgr, \@li_list) or return $e->die_event;
1021     }
1022
1023     return $mgr->respond_complete;
1024 }
1025
1026 sub import_lineitem_details {
1027     my($mgr, $ordering_agency, $li) = @_;
1028
1029     my $holdings = $mgr->editor->json_query({from => ['acq.extract_provider_holding_data', $li->id]});
1030     return 1 unless @$holdings;
1031     my $org_path = $U->get_org_ancestors($ordering_agency);
1032     $org_path = [ reverse (@$org_path) ];
1033     my $price;
1034
1035     my $idx = 1;
1036     while(1) {
1037         # create a lineitem detail for each copy in the data
1038
1039         my $compiled = extract_lineitem_detail_data($mgr, $org_path, $holdings, $idx);
1040         last unless defined $compiled;
1041         return 0 unless $compiled;
1042
1043         # this takes the price of the last copy and uses it as the lineitem price
1044         # need to determine if a given record would include different prices for the same item
1045         $price = $$compiled{price};
1046
1047         for(1..$$compiled{quantity}) {
1048             my $lid = create_lineitem_detail($mgr,
1049                 lineitem => $li->id,
1050                 owning_lib => $$compiled{owning_lib},
1051                 cn_label => $$compiled{call_number},
1052                 fund => $$compiled{fund},
1053                 circ_modifier => $$compiled{circ_modifier},
1054                 note => $$compiled{note},
1055                 location => $$compiled{copy_location}
1056             ) or return 0;
1057         }
1058
1059         $mgr->respond;
1060         $idx++;
1061     }
1062
1063     # set the price attr so we'll know the source of the price
1064     set_lineitem_attr(
1065         $mgr,
1066         attr_name => 'estimated_price',
1067         attr_type => 'lineitem_local_attr_definition',
1068         attr_value => $price,
1069         lineitem => $li->id
1070     ) or return 0;
1071
1072     # if we're creating a purchase order, create the debits
1073     if($li->purchase_order) {
1074         create_lineitem_debits($mgr, $li, $price, 2) or return 0;
1075         $mgr->respond;
1076     }
1077
1078     return 1;
1079 }
1080
1081 # return hash on success, 0 on error, undef on no more holdings
1082 sub extract_lineitem_detail_data {
1083     my($mgr, $org_path, $holdings, $index) = @_;
1084
1085     my @data_list = grep { $_->{holding} eq $index } @$holdings;
1086     return undef unless @data_list;
1087
1088     my %compiled = map { $_->{attr} => $_->{data} } @data_list;
1089     my $base_org = $$org_path[0];
1090
1091     my $killme = sub {
1092         my $msg = shift;
1093         $logger->error("Item import extraction error: $msg");
1094         $logger->error('Holdings Data: ' . OpenSRF::Utils::JSON->perl2JSON(\%compiled));
1095         $mgr->editor->rollback;
1096         $mgr->editor->event(OpenILS::Event->new('ACQ_IMPORT_ERROR', payload => $msg));
1097         return 0;
1098     };
1099
1100     $compiled{quantity} ||= 1;
1101
1102     # ---------------------------------------------------------------------
1103     # Fund
1104     my $code = $compiled{fund_code};
1105     return $killme->('no fund code provided') unless $code;
1106
1107     my $fund = $mgr->cache($base_org, "fund.$code");
1108     unless($fund) {
1109         # search up the org tree for the most appropriate fund
1110         for my $org (@$org_path) {
1111             $fund = $mgr->editor->search_acq_fund(
1112                 {org => $org, code => $code, year => DateTime->now->year}, {idlist => 1})->[0];
1113             last if $fund;
1114         }
1115     }
1116     return $killme->("no fund with code $code at orgs [@$org_path]") unless $fund;
1117     $compiled{fund} = $fund;
1118     $mgr->cache($base_org, "fund.$code", $fund);
1119
1120
1121     # ---------------------------------------------------------------------
1122     # Owning lib
1123     my $sn = $compiled{owning_lib};
1124     return $killme->('no owning_lib defined') unless $sn;
1125     my $org_id =
1126         $mgr->cache($base_org, "orgsn.$sn") ||
1127             $mgr->editor->search_actor_org_unit({shortname => $sn}, {idlist => 1})->[0];
1128     return $killme->("invalid owning_lib defined: $sn") unless $org_id;
1129     $compiled{owning_lib} = $org_id;
1130     $mgr->cache($$org_path[0], "orgsn.$sn", $org_id);
1131
1132
1133     # ---------------------------------------------------------------------
1134     # Circ Modifier
1135     my $mod;
1136     $code = $compiled{circ_modifier};
1137
1138     if($code) {
1139
1140         $mod = $mgr->cache($base_org, "mod.$code") ||
1141             $mgr->editor->retrieve_config_circ_modifier($code);
1142         return $killme->("invlalid circ_modifier $code") unless $mod;
1143         $mgr->cache($base_org, "mod.$code", $mod);
1144
1145     } else {
1146         # try the default
1147         $mod = get_default_circ_modifier($mgr, $base_org)
1148             or return $killme->('no circ_modifier defined');
1149     }
1150
1151     $compiled{circ_modifier} = $mod;
1152
1153
1154     # ---------------------------------------------------------------------
1155     # Shelving Location
1156     my $name = $compiled{copy_location};
1157     return $killme->('no copy_location defined') unless $name;
1158     my $loc = $mgr->cache($base_org, "copy_loc.$name");
1159     unless($loc) {
1160         for my $org (@$org_path) {
1161             $loc = $mgr->editor->search_asset_copy_location(
1162                 {owning_lib => $org, name => $name}, {idlist => 1})->[0];
1163             last if $loc;
1164         }
1165     }
1166     return $killme->("Invalid copy location $name") unless $loc;
1167     $compiled{copy_location} = $loc;
1168     $mgr->cache($base_org, "copy_loc.$name", $loc);
1169
1170     return \%compiled;
1171 }
1172
1173
1174
1175 # ----------------------------------------------------------------------------
1176 # Workflow: Given an existing purchase order, import/create the bibs,
1177 # callnumber and copy objects
1178 # ----------------------------------------------------------------------------
1179
1180 __PACKAGE__->register_method(
1181         method => 'create_po_assets',
1182         api_name        => 'open-ils.acq.purchase_order.assets.create',
1183         signature => {
1184         desc => q/Creates assets for each lineitem in the purchase order/,
1185         params => [
1186             {desc => 'Authentication token', type => 'string'},
1187             {desc => 'The purchase order id', type => 'number'},
1188         ],
1189         return => {desc => 'Streams a total versus completed counts object, event on error'}
1190     }
1191 );
1192
1193 sub create_po_assets {
1194     my($self, $conn, $auth, $po_id) = @_;
1195
1196     my $e = new_editor(authtoken=>$auth, xact=>1);
1197     return $e->die_event unless $e->checkauth;
1198     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1199
1200     my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->die_event;
1201     return $e->die_event unless $e->allowed('IMPORT_PURCHASE_ORDER_ASSETS', $po->ordering_agency);
1202
1203     my $li_ids = $e->search_acq_lineitem({purchase_order => $po_id}, {idlist => 1});
1204
1205     # it's ugly, but it's fast.  Get the total count of lineitem detail objects to process
1206     my $lid_total = $e->json_query({
1207         select => { acqlid => [{aggregate => 1, transform => 'count', column => 'id'}] },
1208         from => {
1209             acqlid => {
1210                 jub => {
1211                     fkey => 'lineitem',
1212                     field => 'id',
1213                     join => {acqpo => {fkey => 'purchase_order', field => 'id'}}
1214                 }
1215             }
1216         },
1217         where => {'+acqpo' => {id => $po_id}}
1218     })->[0]->{id};
1219
1220     $mgr->total(scalar(@$li_ids) + $lid_total);
1221
1222     create_lineitem_list_assets($mgr, $li_ids) or return $e->die_event;
1223
1224     $e->xact_begin;
1225     update_purchase_order($mgr, $po) or return $e->die_event;
1226     $e->commit;
1227
1228     return $mgr->respond_complete;
1229 }
1230
1231
1232
1233 __PACKAGE__->register_method(
1234         method => 'create_purchase_order_api',
1235         api_name        => 'open-ils.acq.purchase_order.create',
1236         signature => {
1237         desc => 'Creates a new purchase order',
1238         params => [
1239             {desc => 'Authentication token', type => 'string'},
1240             {desc => 'purchase_order to create', type => 'object'}
1241         ],
1242         return => {desc => 'The purchase order id, Event on failure'}
1243     }
1244 );
1245
1246 sub create_purchase_order_api {
1247     my($self, $conn, $auth, $po, $args) = @_;
1248     $args ||= {};
1249
1250     my $e = new_editor(xact=>1, authtoken=>$auth);
1251     return $e->die_event unless $e->checkauth;
1252     return $e->die_event unless $e->allowed('CREATE_PURCHASE_ORDER', $po->ordering_agency);
1253     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1254
1255     # create the PO
1256     my %pargs = (ordering_agency => $e->requestor->ws_ou);
1257     $pargs{provider} = $po->provider if $po->provider;
1258     $po = create_purchase_order($mgr, %pargs) or return $e->die_event;
1259
1260     my $li_ids = $$args{lineitems};
1261
1262     if($li_ids) {
1263
1264         for my $li_id (@$li_ids) {
1265
1266             my $li = $e->retrieve_acq_lineitem([
1267                 $li_id,
1268                 {flesh => 1, flesh_fields => {jub => ['attributes']}}
1269             ]) or return $e->die_event;
1270
1271             $li->provider($po->provider);
1272             $li->purchase_order($po->id);
1273             update_lineitem($mgr, $li) or return $e->die_event;
1274             $mgr->respond;
1275
1276             create_lineitem_debits($mgr, $li) or return $e->die_event;
1277         }
1278     }
1279
1280     # commit before starting the asset creation
1281     $e->xact_commit;
1282
1283     if($li_ids and $$args{create_assets}) {
1284         create_lineitem_list_assets($mgr, $li_ids) or return $e->die_event;
1285     }
1286
1287     return $mgr->respond_complete;
1288 }
1289
1290
1291 __PACKAGE__->register_method(
1292         method => 'lineitem_detail_CUD_batch',
1293         api_name => 'open-ils.acq.lineitem_detail.cud.batch',
1294     stream => 1,
1295         signature => {
1296         desc => q/Creates a new purchase order line item detail.
1297             Additionally creates the associated fund_debit/,
1298         params => [
1299             {desc => 'Authentication token', type => 'string'},
1300             {desc => 'List of lineitem_details to create', type => 'array'},
1301         ],
1302         return => {desc => 'Streaming response of current position in the array'}
1303     }
1304 );
1305
1306 sub lineitem_detail_CUD_batch {
1307     my($self, $conn, $auth, $li_details) = @_;
1308
1309     my $e = new_editor(xact=>1, authtoken=>$auth);
1310     return $e->die_event unless $e->checkauth;
1311     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1312
1313     # XXX perms
1314
1315     $mgr->total(scalar(@$li_details));
1316
1317     my %li_cache;
1318
1319     for my $lid (@$li_details) {
1320
1321         my $li = $li_cache{$lid->lineitem} || $e->retrieve_acq_lineitem($lid->lineitem);
1322
1323         if($lid->isnew) {
1324             create_lineitem_detail($mgr, %{$lid->to_bare_hash}) or return $e->die_event;
1325
1326         } elsif($lid->ischanged) {
1327             $e->update_acq_lineitem_detail($lid) or return $e->die_event;
1328
1329         } elsif($lid->isdeleted) {
1330             delete_lineitem_detail($mgr, $lid) or return $e->die_event;
1331         }
1332
1333         $mgr->respond(li => $li);
1334         $li_cache{$lid->lineitem} = $li;
1335     }
1336
1337     $e->commit;
1338     return $mgr->respond_complete;
1339 }
1340
1341
1342 __PACKAGE__->register_method(
1343         method => 'receive_po_api',
1344         api_name        => 'open-ils.acq.purchase_order.receive'
1345 );
1346
1347 sub receive_po_api {
1348     my($self, $conn, $auth, $po_id) = @_;
1349     my $e = new_editor(xact => 1, authtoken => $auth);
1350     return $e->die_event unless $e->checkauth;
1351     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1352
1353     my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->die_event;
1354     return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency);
1355
1356     my $li_ids = $e->search_acq_lineitem({purchase_order => $po_id}, {idlist => 1});
1357
1358     for my $li_id (@$li_ids) {
1359         receive_lineitem($mgr, $li_id) or return $e->die_event;
1360         $mgr->respond;
1361     }
1362
1363     $po->state('received');
1364     update_purchase_order($mgr, $po) or return $e->die_event;
1365
1366     $e->commit;
1367     return $mgr->respond_complete;
1368 }
1369
1370
1371 __PACKAGE__->register_method(
1372         method => 'receive_lineitem_detail_api',
1373         api_name        => 'open-ils.acq.lineitem_detail.receive',
1374         signature => {
1375         desc => 'Mark a lineitem_detail as received',
1376         params => [
1377             {desc => 'Authentication token', type => 'string'},
1378             {desc => 'lineitem detail ID', type => 'number'}
1379         ],
1380         return => {desc => '1 on success, Event on error'}
1381     }
1382 );
1383
1384 sub receive_lineitem_detail_api {
1385     my($self, $conn, $auth, $lid_id) = @_;
1386
1387     my $e = new_editor(xact=>1, authtoken=>$auth);
1388     return $e->die_event unless $e->checkauth;
1389     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1390
1391     my $lid = $e->retrieve_acq_lineitem_detail([
1392         $lid_id, {
1393             flesh => 2,
1394             flesh_fields => {
1395                 acqlid => ['lineitem'],
1396                 jub => ['purchase_order']
1397             }
1398         }
1399     ]);
1400
1401     return $e->die_event unless $e->allowed(
1402         'RECEIVE_PURCHASE_ORDER', $lid->lineitem->purchase_order->ordering_agency);
1403
1404     receive_lineitem_detail($mgr, $lid_id) or return $e->die_event;
1405     $e->commit;
1406     return 1;
1407 }
1408
1409 __PACKAGE__->register_method(
1410         method => 'receive_lineitem_api',
1411         api_name        => 'open-ils.acq.lineitem.receive',
1412         signature => {
1413         desc => 'Mark a lineitem as received',
1414         params => [
1415             {desc => 'Authentication token', type => 'string'},
1416             {desc => 'lineitem detail ID', type => 'number'}
1417         ],
1418         return => {desc => '1 on success, Event on error'}
1419     }
1420 );
1421
1422 sub receive_lineitem_api {
1423     my($self, $conn, $auth, $li_id) = @_;
1424
1425     my $e = new_editor(xact=>1, authtoken=>$auth);
1426     return $e->die_event unless $e->checkauth;
1427     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1428
1429     my $li = $e->retrieve_acq_lineitem([
1430         $li_id, {
1431             flesh => 1,
1432             flesh_fields => {
1433                 jub => ['purchase_order']
1434             }
1435         }
1436     ]) or return $e->die_event;
1437
1438     return $e->die_event unless $e->allowed(
1439         'RECEIVE_PURCHASE_ORDER', $li->purchase_order->ordering_agency);
1440
1441     receive_lineitem($mgr, $li_id) or return $e->die_event;
1442     $e->commit;
1443     return 1;
1444 }
1445
1446
1447 __PACKAGE__->register_method(
1448         method => 'rollback_receive_po_api',
1449         api_name        => 'open-ils.acq.purchase_order.receive.rollback'
1450 );
1451
1452 sub rollback_receive_po_api {
1453     my($self, $conn, $auth, $po_id) = @_;
1454     my $e = new_editor(xact => 1, authtoken => $auth);
1455     return $e->die_event unless $e->checkauth;
1456     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1457
1458     my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->die_event;
1459     return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency);
1460
1461     my $li_ids = $e->search_acq_lineitem({purchase_order => $po_id}, {idlist => 1});
1462
1463     for my $li_id (@$li_ids) {
1464         rollback_receive_lineitem($mgr, $li_id) or return $e->die_event;
1465         $mgr->respond;
1466     }
1467
1468     $po->state('on-order');
1469     update_purchase_order($mgr, $po) or return $e->die_event;
1470
1471     $e->commit;
1472     return $mgr->respond_complete;
1473 }
1474
1475
1476 __PACKAGE__->register_method(
1477         method => 'rollback_receive_lineitem_detail_api',
1478         api_name        => 'open-ils.acq.lineitem_detail.receive.rollback',
1479         signature => {
1480         desc => 'Mark a lineitem_detail as received',
1481         params => [
1482             {desc => 'Authentication token', type => 'string'},
1483             {desc => 'lineitem detail ID', type => 'number'}
1484         ],
1485         return => {desc => '1 on success, Event on error'}
1486     }
1487 );
1488
1489 sub rollback_receive_lineitem_detail_api {
1490     my($self, $conn, $auth, $lid_id) = @_;
1491
1492     my $e = new_editor(xact=>1, authtoken=>$auth);
1493     return $e->die_event unless $e->checkauth;
1494     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1495
1496     my $lid = $e->retrieve_acq_lineitem_detail([
1497         $lid_id, {
1498             flesh => 2,
1499             flesh_fields => {
1500                 acqlid => ['lineitem'],
1501                 jub => ['purchase_order']
1502             }
1503         }
1504     ]);
1505     my $li = $lid->lineitem;
1506     my $po = $li->purchase_order;
1507
1508     return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency);
1509     rollback_receive_lineitem_detail($mgr, $lid_id) or return $e->die_event;
1510
1511     $li->state('on-order');
1512     $po->state('on-order');
1513     udpate_lineitem($mgr, $li) or return $e->die_event;
1514     udpate_purchase_order($mgr, $po) or return $e->die_event;
1515
1516     $e->commit;
1517     return 1;
1518 }
1519
1520 __PACKAGE__->register_method(
1521         method => 'rollback_receive_lineitem_api',
1522         api_name        => 'open-ils.acq.lineitem.receive.rollback',
1523         signature => {
1524         desc => 'Mark a lineitem as received',
1525         params => [
1526             {desc => 'Authentication token', type => 'string'},
1527             {desc => 'lineitem detail ID', type => 'number'}
1528         ],
1529         return => {desc => '1 on success, Event on error'}
1530     }
1531 );
1532
1533 sub rollback_receive_lineitem_api {
1534     my($self, $conn, $auth, $li_id) = @_;
1535
1536     my $e = new_editor(xact=>1, authtoken=>$auth);
1537     return $e->die_event unless $e->checkauth;
1538     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1539
1540     my $li = $e->retrieve_acq_lineitem_detail([
1541         $li_id, {
1542             flesh => 1,
1543             flesh_fields => {
1544                 jub => ['purchase_order']
1545             }
1546         }
1547     ]);
1548     my $po = $li->purchase_order;
1549
1550     return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency);
1551
1552     rollback_receive_lineitem($mgr, $li_id) or return $e->die_event;
1553
1554     $po->state('on-order');
1555     update_purchase_order($mgr, $po) or return $e->die_event;
1556
1557     $e->commit;
1558     return 1;
1559 }
1560
1561
1562 __PACKAGE__->register_method(
1563         method => 'set_lineitem_price_api',
1564         api_name        => 'open-ils.acq.lineitem.price.set',
1565         signature => {
1566         desc => 'Set lineitem price.  If debits already exist, update them as well',
1567         params => [
1568             {desc => 'Authentication token', type => 'string'},
1569             {desc => 'lineitem ID', type => 'number'}
1570         ],
1571         return => {desc => 'status blob, Event on error'}
1572     }
1573 );
1574
1575 sub set_lineitem_price_api {
1576     my($self, $conn, $auth, $li_id, $price, $currency) = @_;
1577
1578     my $e = new_editor(xact=>1, authtoken=>$auth);
1579     return $e->die_event unless $e->checkauth;
1580     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1581
1582     # XXX perms
1583
1584     my $li = $e->retrieve_acq_lineitem($li_id) or return $e->die_event;
1585
1586     # update the local attr for estimated price
1587     set_lineitem_attr(
1588         $mgr,
1589         attr_name => 'estimated_price',
1590         attr_type => 'lineitem_local_attr_definition',
1591         attr_value => $price,
1592         lineitem => $li_id
1593     ) or return $e->die_event;
1594
1595     my $lid_ids = $e->search_acq_lineitem_detail(
1596         {lineitem => $li_id, fund_debit => {'!=' => undef}},
1597         {idlist => 1}
1598     );
1599
1600     for my $lid_id (@$lid_ids) {
1601
1602         my $lid = $e->retrieve_acq_lineitem_detail([
1603             $lid_id, {
1604             flesh => 1, flesh_fields => {acqlid => ['fund', 'fund_debit']}}
1605         ]);
1606
1607         # onless otherwise specified, assume currency of new price is same as currency type of the fund
1608         $currency ||= $lid->fund->currency_type;
1609         my $amount = $price;
1610
1611         if($lid->fund->currency_type ne $currency) {
1612             $amount = currency_conversion($mgr, $currency, $lid->fund->currency_type, $price);
1613         }
1614
1615         $lid->fund_debit->origin_currency_type($currency);
1616         $lid->fund_debit->origin_amount($price);
1617         $lid->fund_debit->amount($amount);
1618
1619         $e->update_acq_fund_debit($lid->fund_debit) or return $e->die_event;
1620         $mgr->add_lid;
1621         $mgr->respond;
1622     }
1623
1624     $e->commit;
1625     return $mgr->respond_complete;
1626 }
1627
1628
1629 __PACKAGE__->register_method(
1630         method => 'clone_picklist_api',
1631         api_name        => 'open-ils.acq.picklist.clone',
1632         signature => {
1633         desc => 'Clones a picklist, including lineitem and lineitem details',
1634         params => [
1635             {desc => 'Authentication token', type => 'string'},
1636             {desc => 'Picklist ID', type => 'number'},
1637             {desc => 'New Picklist Name', type => 'string'}
1638         ],
1639         return => {desc => 'status blob, Event on error'}
1640     }
1641 );
1642
1643 sub clone_picklist_api {
1644     my($self, $conn, $auth, $pl_id, $name) = @_;
1645
1646     my $e = new_editor(xact=>1, authtoken=>$auth);
1647     return $e->die_event unless $e->checkauth;
1648     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1649
1650     my $old_pl = $e->retrieve_acq_picklist($pl_id);
1651     my $new_pl = create_picklist($mgr, %{$old_pl->to_bare_hash}, name => $name) or return $e->die_event;
1652
1653     my $li_ids = $e->search_acq_lineitem({picklist => $pl_id}, {idlist => 1});
1654
1655     for my $li_id (@$li_ids) {
1656
1657         # copy the lineitems
1658         my $li = $e->retrieve_acq_lineitem($li_id);
1659         my $new_li = create_lineitem($mgr, %{$li->to_bare_hash}, picklist => $new_pl->id) or return $e->die_event;
1660
1661         my $lid_ids = $e->search_acq_lineitem_detail({lineitem => $li_id}, {idlist => 1});
1662         for my $lid_id (@$lid_ids) {
1663
1664             # copy the lineitem details
1665             my $lid = $e->retrieve_acq_lineitem_detail($lid_id);
1666             create_lineitem_detail($mgr, %{$lid->to_bare_hash}, lineitem => $new_li->id) or return $e->die_event;
1667             $mgr->respond;
1668         }
1669     }
1670
1671     $e->commit;
1672     return $mgr->respond_complete;
1673 }
1674
1675
1676 __PACKAGE__->register_method(
1677         method => 'merge_picklist_api',
1678         api_name        => 'open-ils.acq.picklist.merge',
1679         signature => {
1680         desc => 'Merges 2 or more picklists into a single list',
1681         params => [
1682             {desc => 'Authentication token', type => 'string'},
1683             {desc => 'Lead Picklist ID', type => 'number'},
1684             {desc => 'List of subordinate picklist IDs', type => 'array'}
1685         ],
1686         return => {desc => 'status blob, Event on error'}
1687     }
1688 );
1689
1690 sub merge_picklist_api {
1691     my($self, $conn, $auth, $lead_pl, $pl_list) = @_;
1692
1693     my $e = new_editor(xact=>1, authtoken=>$auth);
1694     return $e->die_event unless $e->checkauth;
1695     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1696
1697     # XXX perms on each picklist modified
1698
1699     # point all of the lineitems at the lead picklist
1700     my $li_ids = $e->search_acq_lineitem({picklist => $pl_list}, {idlist => 1});
1701
1702     for my $li_id (@$li_ids) {
1703         my $li = $e->retrieve_acq_lineitem($li_id);
1704         $li->picklist($lead_pl);
1705         update_lineitem($mgr, $li) or return $e->die_event;
1706         $mgr->respond;
1707     }
1708
1709     # now delete the subordinate lists
1710     for my $pl_id (@$pl_list) {
1711         my $pl = $e->retrieve_acq_picklist($pl_id);
1712         $e->delete_acq_picklist($pl) or return $e->die_event;
1713     }
1714
1715     $e->commit;
1716     return $mgr->respond_complete;
1717 }
1718
1719
1720
1721 1;