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