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

   1 package OpenILS::Application::Acq::BatchManager;
   2 use OpenILS::Application::Acq::Financials;
   3 use OpenSRF::AppSession;
   4 use OpenSRF::EX qw/:try/;
   5 use strict; use warnings;
   6
   7 sub new {
   8     my($class, %args) = @_;
   9     my $self = bless(\%args, $class);
  10     $self->{args} = {
  11         lid => 0,
  12         li => 0,
  13         copies => 0,
  14         bibs => 0,
  15         progress => 0,
  16         debits_accrued => 0,
  17         purchase_order => undef,
  18         picklist => undef,
  19         complete => 0,
  20         indexed => 0,
  21         total => 0
  22     };
  23     $self->{ingest_queue} = [];
  24     $self->{cache} = {};
  25     $self->throttle(5) unless $self->throttle;
  26     $self->{post_proc_queue} = [];
  27     $self->{last_respond_progress} = 0;
  28     return $self;
  29 }
  30
  31 sub conn {
  32     my($self, $val) = @_;
  33     $self->{conn} = $val if $val;
  34     return $self->{conn};
  35 }
  36 sub throttle {
  37     my($self, $val) = @_;
  38     $self->{throttle} = $val if $val;
  39     return $self->{throttle};
  40 }
  41 sub respond {
  42     my($self, %other_args) = @_;
  43     if($self->throttle and not %other_args) {
  44         return unless (
  45             ($self->{args}->{progress} - $self->{last_respond_progress}) >= $self->throttle
  46         );
  47     }
  48     $self->conn->respond({ %{$self->{args}}, %other_args });
  49     $self->{last_respond_progress} = $self->{args}->{progress};
  50 }
  51 sub respond_complete {
  52     my($self, %other_args) = @_;
  53     $self->complete;
  54     $self->conn->respond_complete({ %{$self->{args}}, %other_args });
  55     $self->run_post_response_hooks;
  56     return undef;
  57 }
  58
  59 # run the post response hook subs, shifting them off as we go
  60 sub run_post_response_hooks {
  61     my($self) = @_;
  62     (shift @{$self->{post_proc_queue}})->() while @{$self->{post_proc_queue}};
  63 }
  64
  65 # any subs passed to this method will be run after the call to respond_complete
  66 sub post_process {
  67     my($self, $sub) = @_;
  68     push(@{$self->{post_proc_queue}}, $sub);
  69 }
  70
  71 sub total {
  72     my($self, $val) = @_;
  73     $self->{args}->{total} = $val if defined $val;
  74     $self->{args}->{maximum} = $self->{args}->{total};
  75     return $self->{args}->{total};
  76 }
  77 sub purchase_order {
  78     my($self, $val) = @_;
  79     $self->{args}->{purchase_order} = $val if $val;
  80     return $self;
  81 }
  82 sub picklist {
  83     my($self, $val) = @_;
  84     $self->{args}->{picklist} = $val if $val;
  85     return $self;
  86 }
  87 sub add_lid {
  88     my $self = shift;
  89     $self->{args}->{lid} += 1;
  90     $self->{args}->{progress} += 1;
  91     return $self;
  92 }
  93 sub add_li {
  94     my $self = shift;
  95     $self->{args}->{li} += 1;
  96     $self->{args}->{progress} += 1;
  97     return $self;
  98 }
  99 sub add_copy {
 100     my $self = shift;
 101     $self->{args}->{copies} += 1;
 102     $self->{args}->{progress} += 1;
 103     return $self;
 104 }
 105 sub add_bib {
 106     my $self = shift;
 107     $self->{args}->{bibs} += 1;
 108     $self->{args}->{progress} += 1;
 109     return $self;
 110 }
 111 sub add_debit {
 112     my($self, $amount) = @_;
 113     $self->{args}->{debits_accrued} += $amount;
 114     $self->{args}->{progress} += 1;
 115     return $self;
 116 }
 117 sub editor {
 118     my($self, $editor) = @_;
 119     $self->{editor} = $editor if defined $editor;
 120     return $self->{editor};
 121 }
 122 sub complete {
 123     my $self = shift;
 124     $self->{args}->{complete} = 1;
 125     return $self;
 126 }
 127
 128 sub ingest_ses {
 129     my($self, $val) = @_;
 130     $self->{ingest_ses} = $val if $val;
 131     return $self->{ingest_ses};
 132 }
 133
 134 sub push_ingest_queue {
 135     my($self, $rec_id) = @_;
 136
 137     $self->ingest_ses(OpenSRF::AppSession->connect('open-ils.ingest'))
 138         unless $self->ingest_ses;
 139
 140     my $req = $self->ingest_ses->request('open-ils.ingest.full.biblio.record', $rec_id);
 141
 142     push(@{$self->{ingest_queue}}, $req);
 143 }
 144
 145 sub process_ingest_records {
 146     my $self = shift;
 147     return unless @{$self->{ingest_queue}};
 148
 149     for my $req (@{$self->{ingest_queue}}) {
 150
 151         try {
 152             $req->gather(1);
 153             $self->{args}->{indexed} += 1;
 154             $self->{args}->{progress} += 1;
 155         } otherwise {};
 156
 157         $self->respond;
 158     }
 159     $self->ingest_ses->disconnect;
 160 }
 161
 162
 163 sub cache {
 164     my($self, $org, $key, $val) = @_;
 165     $self->{cache}->{$org} = {} unless $self->{cache}->{org};
 166     $self->{cache}->{$org}->{$key} = $val if defined $val;
 167     return $self->{cache}->{$org}->{$key};
 168 }
 169
 170
 171 package OpenILS::Application::Acq::Order;
 172 use base qw/OpenILS::Application/;
 173 use strict; use warnings;
 174 # ----------------------------------------------------------------------------
 175 # Break up each component of the order process and pieces into managable
 176 # actions that can be shared across different workflows
 177 # ----------------------------------------------------------------------------
 178 use OpenILS::Event;
 179 use OpenSRF::Utils::Logger qw(:logger);
 180 use OpenSRF::Utils::JSON;
 181 use OpenSRF::AppSession;
 182 use OpenILS::Utils::Fieldmapper;
 183 use OpenILS::Utils::CStoreEditor q/:funcs/;
 184 use OpenILS::Utils::Normalize qw/clean_marc/;
 185 use OpenILS::Const qw/:const/;
 186 use OpenSRF::EX q/:try/;
 187 use OpenILS::Application::AppUtils;
 188 use OpenILS::Application::Cat::BibCommon;
 189 use OpenILS::Application::Cat::AssetCommon;
 190 use MARC::Record;
 191 use MARC::Batch;
 192 use MARC::File::XML (BinaryEncoding => 'UTF-8');
 193 my $U = 'OpenILS::Application::AppUtils';
 194
 195
 196 # ----------------------------------------------------------------------------
 197 # Lineitem
 198 # ----------------------------------------------------------------------------
 199 sub create_lineitem {
 200     my($mgr, %args) = @_;
 201     my $li = Fieldmapper::acq::lineitem->new;
 202     $li->creator($mgr->editor->requestor->id);
 203     $li->selector($li->creator);
 204     $li->editor($li->creator);
 205     $li->create_time('now');
 206     $li->edit_time('now');
 207     $li->state('new');
 208     $li->$_($args{$_}) for keys %args;
 209     $li->clear_id;
 210     $mgr->add_li;
 211     $mgr->editor->create_acq_lineitem($li) or return 0;
 212
 213     unless($li->estimated_unit_price) {
 214         # extract the price from the MARC data
 215         my $price = get_li_price_from_attr($mgr->editor, $li) or return $li;
 216         $li->estimated_unit_price($price);
 217         return update_lineitem($mgr, $li);
 218     }
 219
 220     return $li;
 221 }
 222
 223 sub get_li_price_from_attr {
 224     my($e, $li) = @_;
 225     my $attrs = $li->attributes || $e->search_acq_lineitem_attr({lineitem => $li->id});
 226
 227     for my $attr_type (qw/
 228             lineitem_local_attr_definition
 229             lineitem_prov_attr_definition
 230             lineitem_marc_attr_definition/) {
 231
 232         my ($attr) = grep {
 233             $_->attr_name eq 'estimated_price' and
 234             $_->attr_type eq $attr_type } @$attrs;
 235
 236         return $attr->attr_value if $attr;
 237     }
 238
 239     return undef;
 240 }
 241
 242
 243 sub update_lineitem {
 244     my($mgr, $li) = @_;
 245     $li->edit_time('now');
 246     $li->editor($mgr->editor->requestor->id);
 247     $mgr->add_li;
 248     return $mgr->editor->retrieve_acq_lineitem($mgr->editor->data) if
 249         $mgr->editor->update_acq_lineitem($li);
 250     return undef;
 251 }
 252
 253
 254 # ----------------------------------------------------------------------------
 255 # Create real holds from patron requests for a given lineitem
 256 # ----------------------------------------------------------------------------
 257 sub promote_lineitem_holds {
 258     my($mgr, $li) = @_;
 259
 260     my $requests = $mgr->editor->search_acq_user_request(
 261         { lineitem => $li->id,
 262           '-or' =>
 263             [ { need_before => {'>' => 'now'} },
 264               { need_before => undef }
 265             ]
 266         }
 267     );
 268
 269     for my $request ( @$requests ) {
 270
 271         $request->eg_bib( $li->eg_bib_id );
 272         $mgr->editor->update_acq_user_request( $request ) or return 0;
 273
 274         next unless ($U->is_true( $request->hold ));
 275
 276         my $hold = Fieldmapper::action::hold_request->new;
 277         $hold->usr( $request->usr );
 278         $hold->requestor( $request->usr );
 279         $hold->request_time( $request->request_date );
 280         $hold->pickup_lib( $request->pickup_lib );
 281         $hold->request_lib( $request->pickup_lib );
 282         $hold->selection_ou( $request->pickup_lib );
 283         $hold->phone_notify( $request->phone_notify );
 284         $hold->email_notify( $request->email_notify );
 285         $hold->expire_time( $request->need_before );
 286
 287         if ($request->holdable_formats) {
 288             my $mrm = $mgr->editor->search_metabib_metarecord_source_map( { source => $li->eg_bib_id } )->[0];
 289             if ($mrm) {
 290                 $hold->hold_type( 'M' );
 291                 $hold->holdable_formats( $request->holdable_formats );
 292                 $hold->target( $mrm->metarecord );
 293             }
 294         }
 295
 296         if (!$hold->target) {
 297             $hold->hold_type( 'T' );
 298             $hold->target( $li->eg_bib_id );
 299         }
 300
 301         $mgr->editor->create_actor_hold_request( $hold ) or return 0;
 302     }
 303
 304     return $li;
 305 }
 306
 307 sub delete_lineitem {
 308     my($mgr, $li) = @_;
 309     $li = $mgr->editor->retrieve_acq_lineitem($li) unless ref $li;
 310
 311     # delete the attached lineitem_details
 312     my $lid_ids = $mgr->editor->search_acq_lineitem_detail({lineitem => $li->id}, {idlist=>1});
 313     for my $lid_id (@$lid_ids) {
 314         return 0 unless delete_lineitem_detail($mgr, $lid_id);
 315     }
 316
 317     $mgr->add_li;
 318     return $mgr->editor->delete_acq_lineitem($li);
 319 }
 320
 321 # begins and commit transactions as it goes
 322 sub create_lineitem_list_assets {
 323     my($mgr, $li_ids) = @_;
 324     return undef if check_import_li_marc_perms($mgr, $li_ids);
 325
 326     # create the bibs/volumes/copies and ingest the records
 327     for my $li_id (@$li_ids) {
 328         $mgr->editor->xact_begin;
 329         my $data = create_lineitem_assets($mgr, $li_id) or return undef;
 330         $mgr->editor->xact_commit;
 331         # XXX ingest is in-db now
 332         #$mgr->push_ingest_queue($data->{li}->eg_bib_id) if $data->{new_bib};
 333         $mgr->respond;
 334     }
 335     $mgr->process_ingest_records;
 336     return 1;
 337 }
 338
 339 # returns event on error, undef on success
 340 sub check_import_li_marc_perms {
 341     my($mgr, $li_ids) = @_;
 342
 343     # if there are any order records that are not linked to
 344     # in-db bib records, verify staff has perms to import order records
 345     my $order_li = $mgr->editor->search_acq_lineitem(
 346         [{id => $li_ids, eg_bib_id => undef}, {limit => 1}], {idlist => 1})->[0];
 347
 348     if($order_li) {
 349         return $mgr->editor->die_event unless
 350             $mgr->editor->allowed('IMPORT_ACQ_LINEITEM_BIB_RECORD');
 351     }
 352
 353     return undef;
 354 }
 355
 356
 357 # ----------------------------------------------------------------------------
 358 # if all of the lineitem details for this lineitem have
 359 # been received, mark the lineitem as received
 360 # returns 1 on non-received, li on received, 0 on error
 361 # ----------------------------------------------------------------------------
 362
 363 sub describe_affected_po {
 364     my ($e, $po) = @_;
 365
 366     my ($enc, $spent) =
 367         OpenILS::Application::Acq::Financials::build_price_summary(
 368             $e, $po->id
 369         );
 370
 371     +{$po->id => {
 372             "state" => $po->state,
 373             "amount_encumbered" => $enc,
 374             "amount_spent" => $spent
 375         }
 376     };
 377 }
 378
 379 sub check_lineitem_received {
 380     my($mgr, $li_id) = @_;
 381
 382     my $non_recv = $mgr->editor->search_acq_lineitem_detail(
 383         {recv_time => undef, lineitem => $li_id}, {idlist=>1});
 384
 385     return 1 if @$non_recv;
 386
 387     my $li = $mgr->editor->retrieve_acq_lineitem($li_id);
 388     $li->state('received');
 389     return update_lineitem($mgr, $li);
 390 }
 391
 392 sub receive_lineitem {
 393     my($mgr, $li_id, $skip_complete_check) = @_;
 394     my $li = $mgr->editor->retrieve_acq_lineitem($li_id) or return 0;
 395
 396     my $lid_ids = $mgr->editor->search_acq_lineitem_detail(
 397         {lineitem => $li_id, recv_time => undef}, {idlist => 1});
 398
 399     for my $lid_id (@$lid_ids) {
 400        receive_lineitem_detail($mgr, $lid_id, 1) or return 0;
 401     }
 402
 403     $mgr->add_li;
 404     $li->state('received');
 405
 406     $li = update_lineitem($mgr, $li) or return 0;
 407     $mgr->post_process( sub { create_lineitem_status_events($mgr, $li_id, 'aur.received'); });
 408
 409     my $po;
 410     return 0 unless
 411         $skip_complete_check or (
 412             $po = check_purchase_order_received($mgr, $li->purchase_order)
 413         );
 414
 415     my $result = {"li" => {$li->id => {"state" => $li->state}}};
 416     $result->{"po"} = describe_affected_po($mgr->editor, $po) if ref $po;
 417     return $result;
 418 }
 419
 420 sub rollback_receive_lineitem {
 421     my($mgr, $li_id) = @_;
 422     my $li = $mgr->editor->retrieve_acq_lineitem($li_id) or return 0;
 423
 424     my $lid_ids = $mgr->editor->search_acq_lineitem_detail(
 425         {lineitem => $li_id, recv_time => {'!=' => undef}}, {idlist => 1});
 426
 427     for my $lid_id (@$lid_ids) {
 428        rollback_receive_lineitem_detail($mgr, $lid_id, 1) or return 0;
 429     }
 430
 431     $mgr->add_li;
 432     $li->state('on-order');
 433     return update_lineitem($mgr, $li);
 434 }
 435
 436
 437 sub create_lineitem_status_events {
 438     my($mgr, $li_id, $hook) = @_;
 439
 440     my $ses = OpenSRF::AppSession->create('open-ils.trigger');
 441     $ses->connect;
 442     my $user_reqs = $mgr->editor->search_acq_user_request([
 443         {lineitem => $li_id},
 444         {flesh => 1, flesh_fields => {aur => ['usr']}}
 445     ]);
 446
 447     for my $user_req (@$user_reqs) {
 448         my $req = $ses->request('open-ils.trigger.event.autocreate', $hook, $user_req, $user_req->usr->home_ou);
 449         $req->recv;
 450     }
 451
 452     $ses->disconnect;
 453     return undef;
 454 }
 455
 456 # ----------------------------------------------------------------------------
 457 # Lineitem Detail
 458 # ----------------------------------------------------------------------------
 459 sub create_lineitem_detail {
 460     my($mgr, %args) = @_;
 461     my $lid = Fieldmapper::acq::lineitem_detail->new;
 462     $lid->$_($args{$_}) for keys %args;
 463     $lid->clear_id;
 464     $mgr->add_lid;
 465     return $mgr->editor->create_acq_lineitem_detail($lid);
 466 }
 467
 468
 469 # flesh out any required data with default values where appropriate
 470 sub complete_lineitem_detail {
 471     my($mgr, $lid) = @_;
 472     unless($lid->barcode) {
 473         my $pfx = $U->ou_ancestor_setting_value($lid->owning_lib, 'acq.tmp_barcode_prefix') || 'ACQ';
 474         $lid->barcode($pfx.$lid->id);
 475     }
 476
 477     unless($lid->cn_label) {
 478         my $pfx = $U->ou_ancestor_setting_value($lid->owning_lib, 'acq.tmp_callnumber_prefix') || 'ACQ';
 479         $lid->cn_label($pfx.$lid->id);
 480     }
 481
 482     if(!$lid->location and my $loc = $U->ou_ancestor_setting_value($lid->owning_lib, 'acq.default_copy_location')) {
 483         $lid->location($loc);
 484     }
 485
 486     $lid->circ_modifier(get_default_circ_modifier($mgr, $lid->owning_lib))
 487         unless defined $lid->circ_modifier;
 488
 489     $mgr->editor->update_acq_lineitem_detail($lid) or return 0;
 490     return $lid;
 491 }
 492
 493 sub get_default_circ_modifier {
 494     my($mgr, $org) = @_;
 495     my $code = $mgr->cache($org, 'def_circ_mod');
 496     $code = $U->ou_ancestor_setting_value($org, 'acq.default_circ_modifier') unless defined $code;
 497     return $mgr->cache($org, 'def_circ_mod', $code) if defined $code;
 498     return undef;
 499 }
 500
 501 sub delete_lineitem_detail {
 502     my($mgr, $lid) = @_;
 503     $lid = $mgr->editor->retrieve_acq_lineitem_detail($lid) unless ref $lid;
 504     return $mgr->editor->delete_acq_lineitem_detail($lid);
 505 }
 506
 507
 508 sub receive_lineitem_detail {
 509     my($mgr, $lid_id, $skip_complete_check) = @_;
 510     my $e = $mgr->editor;
 511
 512     my $lid = $e->retrieve_acq_lineitem_detail([
 513         $lid_id,
 514         {   flesh => 1,
 515             flesh_fields => {
 516                 acqlid => ['fund_debit']
 517             }
 518         }
 519     ]) or return 0;
 520
 521     return 1 if $lid->recv_time;
 522
 523     $lid->receiver($e->requestor->id);
 524     $lid->recv_time('now');
 525     $e->update_acq_lineitem_detail($lid) or return 0;
 526
 527     if ($lid->eg_copy_id) {
 528         my $copy = $e->retrieve_asset_copy($lid->eg_copy_id) or return 0;
 529         $copy->status(OILS_COPY_STATUS_IN_PROCESS);
 530         $copy->edit_date('now');
 531         $copy->editor($e->requestor->id);
 532         $copy->creator($e->requestor->id) if $U->ou_ancestor_setting_value(
 533             $e->requestor->ws_ou, 'acq.copy_creator_uses_receiver', $e);
 534         $e->update_asset_copy($copy) or return 0;
 535     }
 536
 537     $mgr->add_lid;
 538
 539     return 1 if $skip_complete_check;
 540
 541     my $li = check_lineitem_received($mgr, $lid->lineitem) or return 0;
 542     return 1 if $li == 1; # li not received
 543
 544     return check_purchase_order_received($mgr, $li->purchase_order) or return 0;
 545 }
 546
 547
 548 sub rollback_receive_lineitem_detail {
 549     my($mgr, $lid_id) = @_;
 550     my $e = $mgr->editor;
 551
 552     my $lid = $e->retrieve_acq_lineitem_detail([
 553         $lid_id,
 554         {   flesh => 1,
 555             flesh_fields => {
 556                 acqlid => ['fund_debit']
 557             }
 558         }
 559     ]) or return 0;
 560
 561     return 1 unless $lid->recv_time;
 562
 563     $lid->clear_receiver;
 564     $lid->clear_recv_time;
 565     $e->update_acq_lineitem_detail($lid) or return 0;
 566
 567     if ($lid->eg_copy_id) {
 568         my $copy = $e->retrieve_asset_copy($lid->eg_copy_id) or return 0;
 569         $copy->status(OILS_COPY_STATUS_ON_ORDER);
 570         $copy->edit_date('now');
 571         $copy->editor($e->requestor->id);
 572         $e->update_asset_copy($copy) or return 0;
 573     }
 574
 575     $mgr->add_lid;
 576     return $lid;
 577 }
 578
 579 # ----------------------------------------------------------------------------
 580 # Lineitem Attr
 581 # ----------------------------------------------------------------------------
 582 sub set_lineitem_attr {
 583     my($mgr, %args) = @_;
 584     my $attr_type = $args{attr_type};
 585
 586     # first, see if it's already set.  May just need to overwrite it
 587     my $attr = $mgr->editor->search_acq_lineitem_attr({
 588         lineitem => $args{lineitem},
 589         attr_type => $args{attr_type},
 590         attr_name => $args{attr_name}
 591     })->[0];
 592
 593     if($attr) {
 594         $attr->attr_value($args{attr_value});
 595         return $attr if $mgr->editor->update_acq_lineitem_attr($attr);
 596         return undef;
 597
 598     } else {
 599
 600         $attr = Fieldmapper::acq::lineitem_attr->new;
 601         $attr->$_($args{$_}) for keys %args;
 602
 603         unless($attr->definition) {
 604             my $find = "search_acq_$attr_type";
 605             my $attr_def_id = $mgr->editor->$find({code => $attr->attr_name}, {idlist=>1})->[0] or return 0;
 606             $attr->definition($attr_def_id);
 607         }
 608         return $mgr->editor->create_acq_lineitem_attr($attr);
 609     }
 610 }
 611
 612 # ----------------------------------------------------------------------------
 613 # Lineitem Debits
 614 # ----------------------------------------------------------------------------
 615 sub create_lineitem_debits {
 616     my ($mgr, $li, $dry_run) = @_;
 617
 618     unless($li->estimated_unit_price) {
 619         $mgr->editor->event(OpenILS::Event->new('ACQ_LINEITEM_NO_PRICE', payload => $li->id));
 620         $mgr->editor->rollback;
 621         return 0;
 622     }
 623
 624     unless($li->provider) {
 625         $mgr->editor->event(OpenILS::Event->new('ACQ_LINEITEM_NO_PROVIDER', payload => $li->id));
 626         $mgr->editor->rollback;
 627         return 0;
 628     }
 629
 630     my $lid_ids = $mgr->editor->search_acq_lineitem_detail(
 631         {lineitem => $li->id},
 632         {idlist=>1}
 633     );
 634
 635     for my $lid_id (@$lid_ids) {
 636
 637         my $lid = $mgr->editor->retrieve_acq_lineitem_detail([
 638             $lid_id,
 639             {   flesh => 1,
 640                 flesh_fields => {acqlid => ['fund']}
 641             }
 642         ]);
 643
 644         create_lineitem_detail_debit($mgr, $li, $lid, $dry_run) or return 0;
 645     }
 646
 647     return 1;
 648 }
 649
 650
 651 # flesh li->provider
 652 # flesh lid->fund
 653 sub create_lineitem_detail_debit {
 654     my ($mgr, $li, $lid, $dry_run, $no_translate) = @_;
 655
 656     # don't create the debit if one already exists
 657     return $mgr->editor->retrieve_acq_fund_debit($lid->fund_debit) if $lid->fund_debit;
 658
 659     my $li_id = ref($li) ? $li->id : $li;
 660
 661     unless(ref $li and ref $li->provider) {
 662        $li = $mgr->editor->retrieve_acq_lineitem([
 663             $li_id,
 664             {   flesh => 1,
 665                 flesh_fields => {jub => ['provider']},
 666             }
 667         ]);
 668     }
 669
 670     if(ref $lid) {
 671         $lid->fund($mgr->editor->retrieve_acq_fund($lid->fund)) unless(ref $lid->fund);
 672     } else {
 673         $lid = $mgr->editor->retrieve_acq_lineitem_detail([
 674             $lid,
 675             {   flesh => 1,
 676                 flesh_fields => {acqlid => ['fund']}
 677             }
 678         ]);
 679     }
 680
 681     unless ($lid->fund) {
 682         $mgr->editor->event(
 683             new OpenILS::Event("ACQ_FUND_NOT_FOUND") # close enough
 684         );
 685         return 0;
 686     }
 687
 688     my $amount = $li->estimated_unit_price;
 689     if($li->provider->currency_type ne $lid->fund->currency_type and !$no_translate) {
 690
 691         # At Fund debit creation time, translate into the currency of the fund
 692         # TODO: org setting to disable automatic currency conversion at debit create time?
 693
 694         $amount = $mgr->editor->json_query({
 695             from => [
 696                 'acq.exchange_ratio',
 697                 $li->provider->currency_type, # source currency
 698                 $lid->fund->currency_type, # destination currency
 699                 $li->estimated_unit_price # source amount
 700             ]
 701         })->[0]->{'acq.exchange_ratio'};
 702     }
 703
 704     my $debit = create_fund_debit(
 705         $mgr,
 706         $dry_run,
 707         fund => $lid->fund->id,
 708         origin_amount => $li->estimated_unit_price,
 709         origin_currency_type => $li->provider->currency_type,
 710         amount => $amount
 711     ) or return 0;
 712
 713     $lid->fund_debit($debit->id);
 714     $lid->fund($lid->fund->id);
 715     $mgr->editor->update_acq_lineitem_detail($lid) or return 0;
 716     return $debit;
 717 }
 718
 719
 720 __PACKAGE__->register_method(
 721         "method" => "fund_exceeds_balance_percent_api",
 722         "api_name" => "open-ils.acq.fund.check_balance_percentages",
 723         "signature" => {
 724         "desc" => q/Determine whether a given fund exceeds its defined
 725             "balance stop and warning percentages"/,
 726         "params" => [
 727             {"desc" => "Authentication token", "type" => "string"},
 728             {"desc" => "Fund ID", "type" => "number"},
 729             {"desc" => "Theoretical debit amount (optional)",
 730                 "type" => "number"}
 731         ],
 732         "return" => {"desc" => q/An array of two values, for stop and warning,
 733             in that order: 1 if fund exceeds that balance percentage, else 0/}
 734     }
 735 );
 736
 737 sub fund_exceeds_balance_percent_api {
 738     my ($self, $conn, $auth, $fund_id, $debit_amount) = @_;
 739
 740     $debit_amount ||= 0;
 741
 742     my $e = new_editor("authtoken" => $auth);
 743     return $e->die_event unless $e->checkauth;
 744
 745     my $fund = $e->retrieve_acq_fund($fund_id) or return $e->die_event;
 746     return $e->die_event unless $e->allowed("VIEW_FUND", $fund->org);
 747
 748     my $result = [
 749         fund_exceeds_balance_percent($fund, $debit_amount, $e, "stop"),
 750         fund_exceeds_balance_percent($fund, $debit_amount, $e, "warning")
 751     ];
 752
 753     $e->disconnect;
 754     return $result;
 755 }
 756
 757 sub fund_exceeds_balance_percent {
 758     my ($fund, $debit_amount, $e, $which) = @_;
 759
 760     my ($method_name, $event_name) = @{{
 761         "warning" => [
 762             "balance_warning_percent", "ACQ_FUND_EXCEEDS_WARN_PERCENT"
 763         ],
 764         "stop" => [
 765             "balance_stop_percent", "ACQ_FUND_EXCEEDS_STOP_PERCENT"
 766         ]
 767     }->{$which}};
 768
 769     if ($fund->$method_name) {
 770         my $balance =
 771             $e->search_acq_fund_combined_balance({"fund" => $fund->id})->[0];
 772         my $allocations =
 773             $e->search_acq_fund_allocation_total({"fund" => $fund->id})->[0];
 774
 775         $balance = ($balance) ? $balance->amount : 0;
 776         $allocations = ($allocations) ? $allocations->amount : 0;
 777
 778         if (
 779             $allocations == 0 || # if no allocations were ever made, assume we have hit the stop percent
 780             ((($allocations - $balance + $debit_amount) / $allocations) * 100) > $fund->$method_name
 781         ) {
 782             $logger->info("fund would hit a limit: " . $fund->id . ", $balance, $debit_amount, $allocations, $method_name");
 783             $e->event(
 784                 new OpenILS::Event(
 785                     $event_name,
 786                     "payload" => {
 787                         "fund" => $fund, "debit_amount" => $debit_amount
 788                     }
 789                 )
 790             );
 791             return 1;
 792         }
 793     }
 794     return 0;
 795 }
 796
 797 # ----------------------------------------------------------------------------
 798 # Fund Debit
 799 # ----------------------------------------------------------------------------
 800 sub create_fund_debit {
 801     my($mgr, $dry_run, %args) = @_;
 802
 803     # Verify the fund is not being spent beyond the hard stop amount
 804     my $fund = $mgr->editor->retrieve_acq_fund($args{fund}) or return 0;
 805
 806     return 0 if
 807         fund_exceeds_balance_percent(
 808             $fund, $args{"amount"}, $mgr->editor, "stop"
 809         );
 810     return 0 if
 811         $dry_run and fund_exceeds_balance_percent(
 812             $fund, $args{"amount"}, $mgr->editor, "warning"
 813         );
 814
 815     my $debit = Fieldmapper::acq::fund_debit->new;
 816     $debit->debit_type('purchase');
 817     $debit->encumbrance('t');
 818     $debit->$_($args{$_}) for keys %args;
 819     $debit->clear_id;
 820     $mgr->add_debit($debit->amount);
 821     return $mgr->editor->create_acq_fund_debit($debit);
 822 }
 823
 824
 825 # ----------------------------------------------------------------------------
 826 # Picklist
 827 # ----------------------------------------------------------------------------
 828 sub create_picklist {
 829     my($mgr, %args) = @_;
 830     my $picklist = Fieldmapper::acq::picklist->new;
 831     $picklist->creator($mgr->editor->requestor->id);
 832     $picklist->owner($picklist->creator);
 833     $picklist->editor($picklist->creator);
 834     $picklist->create_time('now');
 835     $picklist->edit_time('now');
 836     $picklist->org_unit($mgr->editor->requestor->ws_ou);
 837     $picklist->owner($mgr->editor->requestor->id);
 838     $picklist->$_($args{$_}) for keys %args;
 839     $picklist->clear_id;
 840     $mgr->picklist($picklist);
 841     return $mgr->editor->create_acq_picklist($picklist);
 842 }
 843
 844 sub update_picklist {
 845     my($mgr, $picklist) = @_;
 846     $picklist = $mgr->editor->retrieve_acq_picklist($picklist) unless ref $picklist;
 847     $picklist->edit_time('now');
 848     $picklist->editor($mgr->editor->requestor->id);
 849     if ($mgr->editor->update_acq_picklist($picklist)) {
 850         $picklist = $mgr->editor->retrieve_acq_picklist($mgr->editor->data);
 851         $mgr->picklist($picklist);
 852         return $picklist;
 853     } else {
 854         return undef;
 855     }
 856 }
 857
 858 sub delete_picklist {
 859     my($mgr, $picklist) = @_;
 860     $picklist = $mgr->editor->retrieve_acq_picklist($picklist) unless ref $picklist;
 861
 862     # delete all 'new' lineitems
 863     my $li_ids = $mgr->editor->search_acq_lineitem(
 864         {
 865             picklist => $picklist->id,
 866             "-or" => {state => "new", purchase_order => undef}
 867         },
 868         {idlist => 1}
 869     );
 870     for my $li_id (@$li_ids) {
 871         my $li = $mgr->editor->retrieve_acq_lineitem($li_id);
 872         return 0 unless delete_lineitem($mgr, $li);
 873         $mgr->respond;
 874     }
 875
 876     # detach all non-'new' lineitems
 877     $li_ids = $mgr->editor->search_acq_lineitem({picklist => $picklist->id, state => {'!=' => 'new'}}, {idlist => 1});
 878     for my $li_id (@$li_ids) {
 879         my $li = $mgr->editor->retrieve_acq_lineitem($li_id);
 880         $li->clear_picklist;
 881         return 0 unless update_lineitem($mgr, $li);
 882         $mgr->respond;
 883     }
 884
 885     # remove any picklist-specific object perms
 886     my $ops = $mgr->editor->search_permission_usr_object_perm_map({object_type => 'acqpl', object_id => ''.$picklist->id});
 887     for my $op (@$ops) {
 888         return 0 unless $mgr->editor->delete_usr_object_perm_map($op);
 889     }
 890
 891     return $mgr->editor->delete_acq_picklist($picklist);
 892 }
 893
 894 # ----------------------------------------------------------------------------
 895 # Purchase Order
 896 # ----------------------------------------------------------------------------
 897 sub update_purchase_order {
 898     my($mgr, $po) = @_;
 899     $po = $mgr->editor->retrieve_acq_purchase_order($po) unless ref $po;
 900     $po->editor($mgr->editor->requestor->id);
 901     $po->edit_time('now');
 902     $mgr->purchase_order($po);
 903     return $mgr->editor->retrieve_acq_purchase_order($mgr->editor->data)
 904         if $mgr->editor->update_acq_purchase_order($po);
 905     return undef;
 906 }
 907
 908 sub create_purchase_order {
 909     my($mgr, %args) = @_;
 910
 911     # verify the chosen provider is still active
 912     my $provider = $mgr->editor->retrieve_acq_provider($args{provider}) or return 0;
 913     unless($U->is_true($provider->active)) {
 914         $logger->error("provider is not active.  cannot create PO");
 915         $mgr->editor->event(OpenILS::Event->new('ACQ_PROVIDER_INACTIVE'));
 916         return 0;
 917     }
 918
 919     my $po = Fieldmapper::acq::purchase_order->new;
 920     $po->creator($mgr->editor->requestor->id);
 921     $po->editor($mgr->editor->requestor->id);
 922     $po->owner($mgr->editor->requestor->id);
 923     $po->edit_time('now');
 924     $po->create_time('now');
 925     $po->state('pending');
 926     $po->ordering_agency($mgr->editor->requestor->ws_ou);
 927     $po->$_($args{$_}) for keys %args;
 928     $po->clear_id;
 929     $mgr->purchase_order($po);
 930     return $mgr->editor->create_acq_purchase_order($po);
 931 }
 932
 933 # ----------------------------------------------------------------------------
 934 # if all of the lineitems for this PO are received,
 935 # mark the PO as received
 936 # ----------------------------------------------------------------------------
 937 sub check_purchase_order_received {
 938     my($mgr, $po_id) = @_;
 939
 940     my $non_recv_li = $mgr->editor->search_acq_lineitem(
 941         {   purchase_order => $po_id,
 942             state => {'!=' => 'received'}
 943         }, {idlist=>1});
 944
 945     my $po = $mgr->editor->retrieve_acq_purchase_order($po_id);
 946     return $po if @$non_recv_li;
 947
 948     $po->state('received');
 949     return update_purchase_order($mgr, $po);
 950 }
 951
 952
 953 # ----------------------------------------------------------------------------
 954 # Bib, Callnumber, and Copy data
 955 # ----------------------------------------------------------------------------
 956
 957 sub create_lineitem_assets {
 958     my($mgr, $li_id) = @_;
 959     my $evt;
 960
 961     my $li = $mgr->editor->retrieve_acq_lineitem([
 962         $li_id,
 963         {   flesh => 1,
 964             flesh_fields => {jub => ['purchase_order', 'attributes']}
 965         }
 966     ]) or return 0;
 967
 968     # -----------------------------------------------------------------
 969     # first, create the bib record if necessary
 970     # -----------------------------------------------------------------
 971     my $new_bib = 0;
 972     unless($li->eg_bib_id) {
 973         create_bib($mgr, $li) or return 0;
 974         $new_bib = 1;
 975     }
 976
 977
 978     # -----------------------------------------------------------------
 979     # The lineitem is going live, promote user request holds to real holds
 980     # -----------------------------------------------------------------
 981     promote_lineitem_holds($mgr, $li) or return 0;
 982
 983     my $li_details = $mgr->editor->search_acq_lineitem_detail({lineitem => $li_id}, {idlist=>1});
 984
 985     # -----------------------------------------------------------------
 986     # for each lineitem_detail, create the volume if necessary, create
 987     # a copy, and link them all together.
 988     # -----------------------------------------------------------------
 989     my $first_cn;
 990     for my $lid_id (@{$li_details}) {
 991
 992         my $lid = $mgr->editor->retrieve_acq_lineitem_detail($lid_id) or return 0;
 993         next if $lid->eg_copy_id;
 994
 995         # use the same callnumber label for all items within this lineitem
 996         $lid->cn_label($first_cn) if $first_cn and not $lid->cn_label;
 997
 998         # apply defaults if necessary
 999         return 0 unless complete_lineitem_detail($mgr, $lid);
1000
1001         $first_cn = $lid->cn_label unless $first_cn;
1002
1003         my $org = $lid->owning_lib;
1004         my $label = $lid->cn_label;
1005         my $bibid = $li->eg_bib_id;
1006
1007         my $volume = $mgr->cache($org, "cn.$bibid.$label");
1008         unless($volume) {
1009             $volume = create_volume($mgr, $li, $lid) or return 0;
1010             $mgr->cache($org, "cn.$bibid.$label", $volume);
1011         }
1012         create_copy($mgr, $volume, $lid, $li) or return 0;
1013     }
1014
1015     return { li => $li, new_bib => $new_bib };
1016 }
1017
1018 sub create_bib {
1019     my($mgr, $li) = @_;
1020
1021     my $record = OpenILS::Application::Cat::BibCommon->biblio_record_xml_import(
1022         $mgr->editor,
1023         $li->marc,
1024         undef, # bib source
1025         undef,
1026         1, # override tcn collisions
1027     );
1028
1029     if($U->event_code($record)) {
1030         $mgr->editor->event($record);
1031         $mgr->editor->rollback;
1032         return 0;
1033     }
1034
1035     $li->eg_bib_id($record->id);
1036     $mgr->add_bib;
1037     return update_lineitem($mgr, $li);
1038 }
1039
1040 sub create_volume {
1041     my($mgr, $li, $lid) = @_;
1042
1043     my ($volume, $evt) =
1044         OpenILS::Application::Cat::AssetCommon->find_or_create_volume(
1045             $mgr->editor,
1046             $lid->cn_label,
1047             $li->eg_bib_id,
1048             $lid->owning_lib
1049         );
1050
1051     if($evt) {
1052         $mgr->editor->event($evt);
1053         return 0;
1054     }
1055
1056     return $volume;
1057 }
1058
1059 sub create_copy {
1060     my($mgr, $volume, $lid, $li) = @_;
1061     my $copy = Fieldmapper::asset::copy->new;
1062     $copy->isnew(1);
1063     $copy->loan_duration(2);
1064     $copy->fine_level(2);
1065     $copy->status(($lid->recv_time) ? OILS_COPY_STATUS_IN_PROCESS : OILS_COPY_STATUS_ON_ORDER);
1066     $copy->barcode($lid->barcode);
1067     $copy->location($lid->location);
1068     $copy->call_number($volume->id);
1069     $copy->circ_lib($volume->owning_lib);
1070     $copy->circ_modifier($lid->circ_modifier);
1071
1072     # AKA list price.  We might need a $li->list_price field since
1073     # estimated price is not necessarily the same as list price
1074     $copy->price($li->estimated_unit_price);
1075
1076     my $evt = OpenILS::Application::Cat::AssetCommon->create_copy($mgr->editor, $volume, $copy);
1077     if($evt) {
1078         $mgr->editor->event($evt);
1079         return 0;
1080     }
1081
1082     $mgr->add_copy;
1083     $lid->eg_copy_id($copy->id);
1084     $mgr->editor->update_acq_lineitem_detail($lid) or return 0;
1085 }
1086
1087
1088
1089
1090
1091
1092 # ----------------------------------------------------------------------------
1093 # Workflow: Build a selection list from a Z39.50 search
1094 # ----------------------------------------------------------------------------
1095
1096 __PACKAGE__->register_method(
1097         method => 'zsearch',
1098         api_name => 'open-ils.acq.picklist.search.z3950',
1099     stream => 1,
1100         signature => {
1101         desc => 'Performs a z3950 federated search and creates a picklist and associated lineitems',
1102         params => [
1103             {desc => 'Authentication token', type => 'string'},
1104             {desc => 'Search definition', type => 'object'},
1105             {desc => 'Picklist name, optional', type => 'string'},
1106         ]
1107     }
1108 );
1109
1110 sub zsearch {
1111     my($self, $conn, $auth, $search, $name, $options) = @_;
1112     my $e = new_editor(authtoken=>$auth);
1113     return $e->event unless $e->checkauth;
1114     return $e->event unless $e->allowed('CREATE_PICKLIST');
1115
1116     $search->{limit} ||= 10;
1117     $options ||= {};
1118
1119     my $ses = OpenSRF::AppSession->create('open-ils.search');
1120     my $req = $ses->request('open-ils.search.z3950.search_class', $auth, $search);
1121
1122     my $first = 1;
1123     my $picklist;
1124     my $mgr;
1125     while(my $resp = $req->recv(timeout=>60)) {
1126
1127         if($first) {
1128             my $e = new_editor(requestor=>$e->requestor, xact=>1);
1129             $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1130             $picklist = zsearch_build_pl($mgr, $name);
1131             $first = 0;
1132         }
1133
1134         my $result = $resp->content;
1135         my $count = $result->{count} || 0;
1136         $mgr->total( (($count < $search->{limit}) ? $count : $search->{limit})+1 );
1137
1138         for my $rec (@{$result->{records}}) {
1139
1140             my $li = create_lineitem($mgr,
1141                 picklist => $picklist->id,
1142                 source_label => $result->{service},
1143                 marc => $rec->{marcxml},
1144                 eg_bib_id => $rec->{bibid}
1145             );
1146
1147             if($$options{respond_li}) {
1148                 $li->attributes($mgr->editor->search_acq_lineitem_attr({lineitem => $li->id}))
1149                     if $$options{flesh_attrs};
1150                 $li->clear_marc if $$options{clear_marc};
1151                 $mgr->respond(lineitem => $li);
1152             } else {
1153                 $mgr->respond;
1154             }
1155         }
1156     }
1157
1158     $mgr->editor->commit;
1159     return $mgr->respond_complete;
1160 }
1161
1162 sub zsearch_build_pl {
1163     my($mgr, $name) = @_;
1164     $name ||= '';
1165
1166     my $picklist = $mgr->editor->search_acq_picklist({
1167         owner => $mgr->editor->requestor->id,
1168         name => $name
1169     })->[0];
1170
1171     if($name eq '' and $picklist) {
1172         return 0 unless delete_picklist($mgr, $picklist);
1173         $picklist = undef;
1174     }
1175
1176     return update_picklist($mgr, $picklist) if $picklist;
1177     return create_picklist($mgr, name => $name);
1178 }
1179
1180
1181 # ----------------------------------------------------------------------------
1182 # Workflow: Build a selection list / PO by importing a batch of MARC records
1183 # ----------------------------------------------------------------------------
1184
1185 __PACKAGE__->register_method(
1186     method   => 'upload_records',
1187     api_name => 'open-ils.acq.process_upload_records',
1188     stream   => 1,
1189 );
1190
1191 sub upload_records {
1192     my($self, $conn, $auth, $key) = @_;
1193
1194         my $e = new_editor(authtoken => $auth, xact => 1);
1195     return $e->die_event unless $e->checkauth;
1196     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1197
1198     my $cache = OpenSRF::Utils::Cache->new;
1199
1200     my $data = $cache->get_cache("vandelay_import_spool_$key");
1201     my $purpose         = $data->{purpose};
1202     my $filename        = $data->{path};
1203     my $provider        = $data->{provider};
1204     my $picklist        = $data->{picklist};
1205     my $create_po       = $data->{create_po};
1206     my $activate_po     = $data->{activate_po};
1207     my $ordering_agency = $data->{ordering_agency};
1208     my $create_assets   = $data->{create_assets};
1209     my $po;
1210     my $evt;
1211
1212     unless(-r $filename) {
1213         $logger->error("unable to read MARC file $filename");
1214         $e->rollback;
1215         return OpenILS::Event->new('FILE_UPLOAD_ERROR', payload => {filename => $filename});
1216     }
1217
1218     $provider = $e->retrieve_acq_provider($provider) or return $e->die_event;
1219
1220     if($picklist) {
1221         $picklist = $e->retrieve_acq_picklist($picklist) or return $e->die_event;
1222         if($picklist->owner != $e->requestor->id) {
1223             return $e->die_event unless
1224                 $e->allowed('CREATE_PICKLIST', $picklist->org_unit, $picklist);
1225         }
1226         $mgr->picklist($picklist);
1227     }
1228
1229     if($create_po) {
1230
1231         $po = create_purchase_order($mgr,
1232             ordering_agency => $ordering_agency,
1233             provider => $provider->id,
1234             state => 'on-order'
1235         ) or return $mgr->editor->die_event;
1236     }
1237
1238     $logger->info("acq processing MARC file=$filename");
1239
1240         my $batch = new MARC::Batch ('USMARC', $filename);
1241         $batch->strict_off;
1242
1243         my $count = 0;
1244     my @li_list;
1245
1246         while(1) {
1247
1248             my ($err, $xml, $r);
1249                 $count++;
1250
1251                 try {
1252             $r = $batch->next;
1253         } catch Error with {
1254             $err = shift;
1255                         $logger->warn("Proccessing of record $count in set $key failed with error $err.  Skipping this record");
1256         };
1257
1258         next if $err;
1259         last unless $r;
1260
1261                 try {
1262             $xml = clean_marc($r);
1263                 } catch Error with {
1264                         $err = shift;
1265                         $logger->warn("Proccessing XML of record $count in set $key failed with error $err.  Skipping this record");
1266                 };
1267
1268         next if $err or not $xml;
1269
1270         my %args = (
1271             source_label => $provider->code,
1272             provider => $provider->id,
1273             marc => $xml,
1274         );
1275
1276         $args{picklist} = $picklist->id if $picklist;
1277         if($po) {
1278             $args{purchase_order} = $po->id;
1279             $args{state} = 'pending-order';
1280         }
1281
1282         my $li = create_lineitem($mgr, %args) or return $mgr->editor->die_event;
1283         $mgr->respond;
1284         $li->provider($provider); # flesh it, we'll need it later
1285
1286         import_lineitem_details($mgr, $ordering_agency, $li) or return $mgr->editor->die_event;
1287         $mgr->respond;
1288
1289         push(@li_list, $li->id);
1290         $mgr->respond;
1291         }
1292
1293     my $die_event = activate_purchase_order_impl($mgr, $po->id) if $po and $activate_po;
1294     return $die_event if $die_event;
1295
1296         $e->commit;
1297     unlink($filename);
1298     $cache->delete_cache('vandelay_import_spool_' . $key);
1299
1300     if ($create_assets) {
1301         create_lineitem_list_assets($mgr, \@li_list) or return $e->die_event;
1302     }
1303
1304     return $mgr->respond_complete;
1305 }
1306
1307 sub import_lineitem_details {
1308     my($mgr, $ordering_agency, $li) = @_;
1309
1310     my $holdings = $mgr->editor->json_query({from => ['acq.extract_provider_holding_data', $li->id]});
1311     return 1 unless @$holdings;
1312     my $org_path = $U->get_org_ancestors($ordering_agency);
1313     $org_path = [ reverse (@$org_path) ];
1314     my $price;
1315
1316
1317     my $idx = 1;
1318     while(1) {
1319         # create a lineitem detail for each copy in the data
1320
1321         my $compiled = extract_lineitem_detail_data($mgr, $org_path, $holdings, $idx);
1322         last unless defined $compiled;
1323         return 0 unless $compiled;
1324
1325         # this takes the price of the last copy and uses it as the lineitem price
1326         # need to determine if a given record would include different prices for the same item
1327         $price = $$compiled{estimated_price};
1328
1329         last unless $$compiled{quantity};
1330
1331         for(1..$$compiled{quantity}) {
1332             my $lid = create_lineitem_detail(
1333                 $mgr,
1334                 lineitem        => $li->id,
1335                 owning_lib      => $$compiled{owning_lib},
1336                 cn_label        => $$compiled{call_number},
1337                 fund            => $$compiled{fund},
1338                 circ_modifier   => $$compiled{circ_modifier},
1339                 note            => $$compiled{note},
1340                 location        => $$compiled{copy_location},
1341                 collection_code => $$compiled{collection_code}
1342             ) or return 0;
1343         }
1344
1345         $mgr->respond;
1346         $idx++;
1347     }
1348
1349     $li->estimated_unit_price($price);
1350     update_lineitem($mgr, $li) or return 0;
1351     return 1;
1352 }
1353
1354 # return hash on success, 0 on error, undef on no more holdings
1355 sub extract_lineitem_detail_data {
1356     my($mgr, $org_path, $holdings, $index) = @_;
1357
1358     my @data_list = grep { $_->{holding} eq $index } @$holdings;
1359     return undef unless @data_list;
1360
1361     my %compiled = map { $_->{attr} => $_->{data} } @data_list;
1362     my $base_org = $$org_path[0];
1363
1364     my $killme = sub {
1365         my $msg = shift;
1366         $logger->error("Item import extraction error: $msg");
1367         $logger->error('Holdings Data: ' . OpenSRF::Utils::JSON->perl2JSON(\%compiled));
1368         $mgr->editor->rollback;
1369         $mgr->editor->event(OpenILS::Event->new('ACQ_IMPORT_ERROR', payload => $msg));
1370         return 0;
1371     };
1372
1373     # ---------------------------------------------------------------------
1374     # Fund
1375     if(my $code = $compiled{fund_code}) {
1376
1377         my $fund = $mgr->cache($base_org, "fund.$code");
1378         unless($fund) {
1379             # search up the org tree for the most appropriate fund
1380             for my $org (@$org_path) {
1381                 $fund = $mgr->editor->search_acq_fund(
1382                     {org => $org, code => $code, year => DateTime->now->year}, {idlist => 1})->[0];
1383                 last if $fund;
1384             }
1385         }
1386         return $killme->("no fund with code $code at orgs [@$org_path]") unless $fund;
1387         $compiled{fund} = $fund;
1388         $mgr->cache($base_org, "fund.$code", $fund);
1389     }
1390
1391
1392     # ---------------------------------------------------------------------
1393     # Owning lib
1394     if(my $sn = $compiled{owning_lib}) {
1395         my $org_id = $mgr->cache($base_org, "orgsn.$sn") ||
1396             $mgr->editor->search_actor_org_unit({shortname => $sn}, {idlist => 1})->[0];
1397         return $killme->("invalid owning_lib defined: $sn") unless $org_id;
1398         $compiled{owning_lib} = $org_id;
1399         $mgr->cache($$org_path[0], "orgsn.$sn", $org_id);
1400     }
1401
1402
1403     # ---------------------------------------------------------------------
1404     # Circ Modifier
1405     my $code = $compiled{circ_modifier};
1406
1407     if(defined $code) {
1408
1409         # verify this is a valid circ modifier
1410         return $killme->("invlalid circ_modifier $code") unless
1411             defined $mgr->cache($base_org, "mod.$code") or
1412             $mgr->editor->retrieve_config_circ_modifier($code);
1413
1414             # if valid, cache for future tests
1415             $mgr->cache($base_org, "mod.$code", $code);
1416
1417     } else {
1418         $compiled{circ_modifier} = get_default_circ_modifier($mgr, $base_org);
1419     }
1420
1421
1422     # ---------------------------------------------------------------------
1423     # Shelving Location
1424     if( my $name = $compiled{copy_location}) {
1425         my $loc = $mgr->cache($base_org, "copy_loc.$name");
1426         unless($loc) {
1427             for my $org (@$org_path) {
1428                 $loc = $mgr->editor->search_asset_copy_location(
1429                     {owning_lib => $org, name => $name}, {idlist => 1})->[0];
1430                 last if $loc;
1431             }
1432         }
1433         return $killme->("Invalid copy location $name") unless $loc;
1434         $compiled{copy_location} = $loc;
1435         $mgr->cache($base_org, "copy_loc.$name", $loc);
1436     }
1437
1438     return \%compiled;
1439 }
1440
1441
1442
1443 # ----------------------------------------------------------------------------
1444 # Workflow: Given an existing purchase order, import/create the bibs,
1445 # callnumber and copy objects
1446 # ----------------------------------------------------------------------------
1447
1448 __PACKAGE__->register_method(
1449         method => 'create_po_assets',
1450         api_name        => 'open-ils.acq.purchase_order.assets.create',
1451         signature => {
1452         desc => q/Creates assets for each lineitem in the purchase order/,
1453         params => [
1454             {desc => 'Authentication token', type => 'string'},
1455             {desc => 'The purchase order id', type => 'number'},
1456         ],
1457         return => {desc => 'Streams a total versus completed counts object, event on error'}
1458     }
1459 );
1460
1461 sub create_po_assets {
1462     my($self, $conn, $auth, $po_id) = @_;
1463
1464     my $e = new_editor(authtoken=>$auth, xact=>1);
1465     return $e->die_event unless $e->checkauth;
1466     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1467
1468     my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->die_event;
1469
1470     my $li_ids = $e->search_acq_lineitem({purchase_order => $po_id}, {idlist => 1});
1471
1472     # it's ugly, but it's fast.  Get the total count of lineitem detail objects to process
1473     my $lid_total = $e->json_query({
1474         select => { acqlid => [{aggregate => 1, transform => 'count', column => 'id'}] },
1475         from => {
1476             acqlid => {
1477                 jub => {
1478                     fkey => 'lineitem',
1479                     field => 'id',
1480                     join => {acqpo => {fkey => 'purchase_order', field => 'id'}}
1481                 }
1482             }
1483         },
1484         where => {'+acqpo' => {id => $po_id}}
1485     })->[0]->{id};
1486
1487     $mgr->total(scalar(@$li_ids) + $lid_total);
1488
1489     create_lineitem_list_assets($mgr, $li_ids) or return $e->die_event;
1490
1491     $e->xact_begin;
1492     update_purchase_order($mgr, $po) or return $e->die_event;
1493     $e->commit;
1494
1495     return $mgr->respond_complete;
1496 }
1497
1498
1499
1500 __PACKAGE__->register_method(
1501     method    => 'create_purchase_order_api',
1502     api_name  => 'open-ils.acq.purchase_order.create',
1503     signature => {
1504         desc   => 'Creates a new purchase order',
1505         params => [
1506             {desc => 'Authentication token', type => 'string'},
1507             {desc => 'purchase_order to create', type => 'object'}
1508         ],
1509         return => {desc => 'The purchase order id, Event on failure'}
1510     }
1511 );
1512
1513 sub create_purchase_order_api {
1514     my($self, $conn, $auth, $po, $args) = @_;
1515     $args ||= {};
1516
1517     my $e = new_editor(xact=>1, authtoken=>$auth);
1518     return $e->die_event unless $e->checkauth;
1519     return $e->die_event unless $e->allowed('CREATE_PURCHASE_ORDER', $po->ordering_agency);
1520     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1521
1522     # create the PO
1523     my %pargs = (ordering_agency => $e->requestor->ws_ou); # default
1524     $pargs{provider}            = $po->provider            if $po->provider;
1525     $pargs{ordering_agency}     = $po->ordering_agency     if $po->ordering_agency;
1526     $pargs{prepayment_required} = $po->prepayment_required if $po->prepayment_required;
1527
1528     $po = create_purchase_order($mgr, %pargs) or return $e->die_event;
1529
1530     my $li_ids = $$args{lineitems};
1531
1532     if($li_ids) {
1533
1534         for my $li_id (@$li_ids) {
1535
1536             my $li = $e->retrieve_acq_lineitem([
1537                 $li_id,
1538                 {flesh => 1, flesh_fields => {jub => ['attributes']}}
1539             ]) or return $e->die_event;
1540
1541             $li->provider($po->provider);
1542             $li->purchase_order($po->id);
1543             $li->state('pending-order');
1544             update_lineitem($mgr, $li) or return $e->die_event;
1545             $mgr->respond;
1546         }
1547     }
1548
1549     # commit before starting the asset creation
1550     $e->xact_commit;
1551
1552     if($li_ids and $$args{create_assets}) {
1553         create_lineitem_list_assets($mgr, $li_ids) or return $e->die_event;
1554     }
1555
1556     return $mgr->respond_complete;
1557 }
1558
1559
1560
1561 __PACKAGE__->register_method(
1562     method   => 'update_lineitem_fund_batch',
1563     api_name => 'open-ils.acq.lineitem.fund.update.batch',
1564     stream   => 1,
1565     signature => {
1566         desc => q/Given a set of lineitem IDS, updates the fund for all attached lineitem details/
1567     }
1568 );
1569
1570 sub update_lineitem_fund_batch {
1571     my($self, $conn, $auth, $li_ids, $fund_id) = @_;
1572     my $e = new_editor(xact=>1, authtoken=>$auth);
1573     return $e->die_event unless $e->checkauth;
1574     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1575     for my $li_id (@$li_ids) {
1576         my ($li, $evt) = fetch_and_check_li($e, $li_id, 'write');
1577         return $evt if $evt;
1578         my $li_details = $e->search_acq_lineitem_detail({lineitem => $li_id});
1579         $_->fund($fund_id) and $_->ischanged(1) for @$li_details;
1580         $evt = lineitem_detail_CUD_batch($mgr, $li_details);
1581         return $evt if $evt;
1582         $mgr->add_li;
1583         $mgr->respond;
1584     }
1585     $e->commit;
1586     return $mgr->respond_complete;
1587 }
1588
1589
1590
1591 __PACKAGE__->register_method(
1592     method    => 'lineitem_detail_CUD_batch_api',
1593     api_name  => 'open-ils.acq.lineitem_detail.cud.batch',
1594     stream    => 1,
1595     signature => {
1596         desc   => q/Creates a new purchase order line item detail. / .
1597                   q/Additionally creates the associated fund_debit/,
1598         params => [
1599             {desc => 'Authentication token', type => 'string'},
1600             {desc => 'List of lineitem_details to create', type => 'array'},
1601             {desc => 'Create Debits.  Used for creating post-po-asset-creation debits', type => 'bool'},
1602         ],
1603         return => {desc => 'Streaming response of current position in the array'}
1604     }
1605 );
1606
1607 __PACKAGE__->register_method(
1608     method    => 'lineitem_detail_CUD_batch_api',
1609     api_name  => 'open-ils.acq.lineitem_detail.cud.batch.dry_run',
1610     stream    => 1,
1611     signature => {
1612         desc => q/
1613             Dry run version of open-ils.acq.lineitem_detail.cud.batch.
1614             In dry_run mode, updated fund_debit's the exceed the warning
1615             percent return an event.
1616         /
1617     }
1618 );
1619
1620
1621 sub lineitem_detail_CUD_batch_api {
1622     my($self, $conn, $auth, $li_details, $create_debits) = @_;
1623     my $e = new_editor(xact=>1, authtoken=>$auth);
1624     return $e->die_event unless $e->checkauth;
1625     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1626     my $dry_run = ($self->api_name =~ /dry_run/o);
1627     my $evt = lineitem_detail_CUD_batch($mgr, $li_details, $create_debits, $dry_run);
1628     return $evt if $evt;
1629     $e->commit;
1630     return $mgr->respond_complete;
1631 }
1632
1633
1634 sub lineitem_detail_CUD_batch {
1635     my($mgr, $li_details, $create_debits, $dry_run) = @_;
1636
1637     $mgr->total(scalar(@$li_details));
1638     my $e = $mgr->editor;
1639
1640     my $li;
1641     my %li_cache;
1642     my $fund_cache = {};
1643     my $evt;
1644
1645     for my $lid (@$li_details) {
1646
1647         unless($li = $li_cache{$lid->lineitem}) {
1648             ($li, $evt) = fetch_and_check_li($e, $lid->lineitem, 'write');
1649             return $evt if $evt;
1650         }
1651
1652         if($lid->isnew) {
1653             $lid = create_lineitem_detail($mgr, %{$lid->to_bare_hash}) or return $e->die_event;
1654             if($create_debits) {
1655                 $li->provider($e->retrieve_acq_provider($li->provider)) or return $e->die_event;
1656                 $lid->fund($e->retrieve_acq_fund($lid->fund)) or return $e->die_event;
1657                 create_lineitem_detail_debit($mgr, $li, $lid, 0, 1) or return $e->die_event;
1658             }
1659
1660         } elsif($lid->ischanged) {
1661             return $evt if $evt = handle_changed_lid($e, $lid, $dry_run, $fund_cache);
1662
1663         } elsif($lid->isdeleted) {
1664             delete_lineitem_detail($mgr, $lid) or return $e->die_event;
1665         }
1666
1667         $mgr->respond(li => $li);
1668         $li_cache{$lid->lineitem} = $li;
1669     }
1670
1671     return undef;
1672 }
1673
1674 sub handle_changed_lid {
1675     my($e, $lid, $dry_run, $fund_cache) = @_;
1676
1677     my $orig_lid = $e->retrieve_acq_lineitem_detail($lid->id) or return $e->die_event;
1678
1679     # updating the fund, so update the debit
1680     if($orig_lid->fund_debit and $orig_lid->fund != $lid->fund) {
1681
1682         my $debit = $e->retrieve_acq_fund_debit($orig_lid->fund_debit);
1683         my $new_fund = $$fund_cache{$lid->fund} =
1684             $$fund_cache{$lid->fund} || $e->retrieve_acq_fund($lid->fund);
1685
1686         # check the thresholds
1687         return $e->die_event if
1688             fund_exceeds_balance_percent($new_fund, $debit->amount, $e, "stop");
1689         return $e->die_event if $dry_run and
1690             fund_exceeds_balance_percent($new_fund, $debit->amount, $e, "warning");
1691
1692         $debit->fund($new_fund->id);
1693         $e->update_acq_fund_debit($debit) or return $e->die_event;
1694     }
1695
1696     $e->update_acq_lineitem_detail($lid) or return $e->die_event;
1697     return undef;
1698 }
1699
1700
1701 __PACKAGE__->register_method(
1702     method   => 'receive_po_api',
1703     api_name => 'open-ils.acq.purchase_order.receive'
1704 );
1705
1706 sub receive_po_api {
1707     my($self, $conn, $auth, $po_id) = @_;
1708     my $e = new_editor(xact => 1, authtoken => $auth);
1709     return $e->die_event unless $e->checkauth;
1710     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1711
1712     my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->die_event;
1713     return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency);
1714
1715     my $li_ids = $e->search_acq_lineitem({purchase_order => $po_id}, {idlist => 1});
1716
1717     for my $li_id (@$li_ids) {
1718         receive_lineitem($mgr, $li_id) or return $e->die_event;
1719         $mgr->respond;
1720     }
1721
1722     $po->state('received');
1723     update_purchase_order($mgr, $po) or return $e->die_event;
1724
1725     $e->commit;
1726     return $mgr->respond_complete;
1727 }
1728
1729
1730 # At the moment there's a lack of parallelism between the receive and unreceive
1731 # API methods for POs and the API methods for LIs and LIDs.  The methods for
1732 # POs stream back objects as they act, whereas the methods for LIs and LIDs
1733 # atomically return an object that describes only what changed (in LIs and LIDs
1734 # themselves or in the objects to which to LIs and LIDs belong).
1735 #
1736 # The methods for LIs and LIDs work the way they do to faciliate the UI's
1737 # maintaining correct information about the state of these things when a user
1738 # wants to receive or unreceive these objects without refreshing their whole
1739 # display.  The UI feature for receiving and un-receiving a whole PO just
1740 # refreshes the whole display, so this absence of parallelism in the UI is also
1741 # relected in this module.
1742 #
1743 # This could be neatened in the future by making POs receive and unreceive in
1744 # the same way the LIs and LIDs do.
1745
1746 __PACKAGE__->register_method(
1747         method => 'receive_lineitem_detail_api',
1748         api_name        => 'open-ils.acq.lineitem_detail.receive',
1749         signature => {
1750         desc => 'Mark a lineitem_detail as received',
1751         params => [
1752             {desc => 'Authentication token', type => 'string'},
1753             {desc => 'lineitem detail ID', type => 'number'}
1754         ],
1755         return => {desc =>
1756             "on success, object describing changes to LID and possibly " .
1757             "to LI and PO; on error, Event"
1758         }
1759     }
1760 );
1761
1762 sub receive_lineitem_detail_api {
1763     my($self, $conn, $auth, $lid_id) = @_;
1764
1765     my $e = new_editor(xact=>1, authtoken=>$auth);
1766     return $e->die_event unless $e->checkauth;
1767     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1768
1769     my $fleshing = {
1770         "flesh" => 2, "flesh_fields" => {
1771             "acqlid" => ["lineitem"], "jub" => ["purchase_order"]
1772         }
1773     };
1774
1775     my $lid = $e->retrieve_acq_lineitem_detail([$lid_id, $fleshing]);
1776
1777     return $e->die_event unless $e->allowed(
1778         'RECEIVE_PURCHASE_ORDER', $lid->lineitem->purchase_order->ordering_agency);
1779
1780     # update ...
1781     my $recvd = receive_lineitem_detail($mgr, $lid_id) or return $e->die_event;
1782
1783     # .. and re-retrieve
1784     $lid = $e->retrieve_acq_lineitem_detail([$lid_id, $fleshing]);
1785
1786     # Now build result data structure.
1787     my $result = {"lid" => {$lid->id => {"recv_time" => $lid->recv_time}}};
1788
1789     if (ref $recvd) {
1790         if ($recvd->class_name =~ /::purchase_order/) {
1791             $result->{"po"} = describe_affected_po($e, $recvd);
1792             $result->{"li"} = {
1793                 $lid->lineitem->id => {"state" => $lid->lineitem->state}
1794             };
1795         } elsif ($recvd->class_name =~ /::lineitem/) {
1796             $result->{"li"} = {$recvd->id => {"state" => $recvd->state}};
1797         }
1798     }
1799     $result->{"po"} ||=
1800         describe_affected_po($e, $lid->lineitem->purchase_order);
1801
1802     $e->commit;
1803     return $result;
1804 }
1805
1806 __PACKAGE__->register_method(
1807         method => 'receive_lineitem_api',
1808         api_name        => 'open-ils.acq.lineitem.receive',
1809         signature => {
1810         desc => 'Mark a lineitem as received',
1811         params => [
1812             {desc => 'Authentication token', type => 'string'},
1813             {desc => 'lineitem ID', type => 'number'}
1814         ],
1815         return => {desc =>
1816             "on success, object describing changes to LI and possibly PO; " .
1817             "on error, Event"
1818         }
1819     }
1820 );
1821
1822 sub receive_lineitem_api {
1823     my($self, $conn, $auth, $li_id) = @_;
1824
1825     my $e = new_editor(xact=>1, authtoken=>$auth);
1826     return $e->die_event unless $e->checkauth;
1827     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1828
1829     my $li = $e->retrieve_acq_lineitem([
1830         $li_id, {
1831             flesh => 1,
1832             flesh_fields => {
1833                 jub => ['purchase_order']
1834             }
1835         }
1836     ]) or return $e->die_event;
1837
1838     return $e->die_event unless $e->allowed(
1839         'RECEIVE_PURCHASE_ORDER', $li->purchase_order->ordering_agency);
1840
1841     my $res = receive_lineitem($mgr, $li_id) or return $e->die_event;
1842     $e->commit;
1843     $conn->respond_complete($res);
1844     $mgr->run_post_response_hooks;
1845 }
1846
1847
1848 __PACKAGE__->register_method(
1849     method   => 'rollback_receive_po_api',
1850     api_name => 'open-ils.acq.purchase_order.receive.rollback'
1851 );
1852
1853 sub rollback_receive_po_api {
1854     my($self, $conn, $auth, $po_id) = @_;
1855     my $e = new_editor(xact => 1, authtoken => $auth);
1856     return $e->die_event unless $e->checkauth;
1857     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1858
1859     my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->die_event;
1860     return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency);
1861
1862     my $li_ids = $e->search_acq_lineitem({purchase_order => $po_id}, {idlist => 1});
1863
1864     for my $li_id (@$li_ids) {
1865         rollback_receive_lineitem($mgr, $li_id) or return $e->die_event;
1866         $mgr->respond;
1867     }
1868
1869     $po->state('on-order');
1870     update_purchase_order($mgr, $po) or return $e->die_event;
1871
1872     $e->commit;
1873     return $mgr->respond_complete;
1874 }
1875
1876
1877 __PACKAGE__->register_method(
1878     method    => 'rollback_receive_lineitem_detail_api',
1879     api_name  => 'open-ils.acq.lineitem_detail.receive.rollback',
1880     signature => {
1881         desc   => 'Mark a lineitem_detail as Un-received',
1882         params => [
1883             {desc => 'Authentication token', type => 'string'},
1884             {desc => 'lineitem detail ID', type => 'number'}
1885         ],
1886         return => {desc =>
1887             "on success, object describing changes to LID and possibly " .
1888             "to LI and PO; on error, Event"
1889         }
1890     }
1891 );
1892
1893 sub rollback_receive_lineitem_detail_api {
1894     my($self, $conn, $auth, $lid_id) = @_;
1895
1896     my $e = new_editor(xact=>1, authtoken=>$auth);
1897     return $e->die_event unless $e->checkauth;
1898     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1899
1900     my $lid = $e->retrieve_acq_lineitem_detail([
1901         $lid_id, {
1902             flesh => 2,
1903             flesh_fields => {
1904                 acqlid => ['lineitem'],
1905                 jub => ['purchase_order']
1906             }
1907         }
1908     ]);
1909     my $li = $lid->lineitem;
1910     my $po = $li->purchase_order;
1911
1912     return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency);
1913
1914     my $result = {};
1915
1916     my $recvd = rollback_receive_lineitem_detail($mgr, $lid_id)
1917         or return $e->die_event;
1918
1919     if (ref $recvd) {
1920         $result->{"lid"} = {$recvd->id => {"recv_time" => $recvd->recv_time}};
1921     } else {
1922         $result->{"lid"} = {$lid->id => {"recv_time" => $lid->recv_time}};
1923     }
1924
1925     if ($li->state eq "received") {
1926         $li->state("on-order");
1927         $li = update_lineitem($mgr, $li) or return $e->die_event;
1928         $result->{"li"} = {$li->id => {"state" => $li->state}};
1929     }
1930
1931     if ($po->state eq "received") {
1932         $po->state("on-order");
1933         $po = update_purchase_order($mgr, $po) or return $e->die_event;
1934     }
1935     $result->{"po"} = describe_affected_po($e, $po);
1936
1937     $e->commit and return $result or return $e->die_event;
1938 }
1939
1940 __PACKAGE__->register_method(
1941     method    => 'rollback_receive_lineitem_api',
1942     api_name  => 'open-ils.acq.lineitem.receive.rollback',
1943     signature => {
1944         desc   => 'Mark a lineitem as Un-received',
1945         params => [
1946             {desc => 'Authentication token', type => 'string'},
1947             {desc => 'lineitem ID',          type => 'number'}
1948         ],
1949         return => {desc =>
1950             "on success, object describing changes to LI and possibly PO; " .
1951             "on error, Event"
1952         }
1953     }
1954 );
1955
1956 sub rollback_receive_lineitem_api {
1957     my($self, $conn, $auth, $li_id) = @_;
1958
1959     my $e = new_editor(xact=>1, authtoken=>$auth);
1960     return $e->die_event unless $e->checkauth;
1961     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1962
1963     my $li = $e->retrieve_acq_lineitem([
1964         $li_id, {
1965             "flesh" => 1, "flesh_fields" => {"jub" => ["purchase_order"]}
1966         }
1967     ]);
1968     my $po = $li->purchase_order;
1969
1970     return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency);
1971
1972     $li = rollback_receive_lineitem($mgr, $li_id) or return $e->die_event;
1973
1974     my $result = {"li" => {$li->id => {"state" => $li->state}}};
1975     if ($po->state eq "received") {
1976         $po->state("on-order");
1977         $po = update_purchase_order($mgr, $po) or return $e->die_event;
1978     }
1979     $result->{"po"} = describe_affected_po($e, $po);
1980
1981     $e->commit and return $result or return $e->die_event;
1982 }
1983
1984
1985 __PACKAGE__->register_method(
1986     method    => 'set_lineitem_price_api',
1987     api_name  => 'open-ils.acq.lineitem.price.set',
1988     signature => {
1989         desc   => 'Set lineitem price.  If debits already exist, update them as well',
1990         params => [
1991             {desc => 'Authentication token', type => 'string'},
1992             {desc => 'lineitem ID',          type => 'number'}
1993         ],
1994         return => {desc => 'status blob, Event on error'}
1995     }
1996 );
1997
1998 sub set_lineitem_price_api {
1999     my($self, $conn, $auth, $li_id, $price) = @_;
2000
2001     my $e = new_editor(xact=>1, authtoken=>$auth);
2002     return $e->die_event unless $e->checkauth;
2003     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
2004
2005     my ($li, $evt) = fetch_and_check_li($e, $li_id, 'write');
2006     return $evt if $evt;
2007
2008     $li->estimated_unit_price($price);
2009     update_lineitem($mgr, $li) or return $e->die_event;
2010
2011     my $lid_ids = $e->search_acq_lineitem_detail(
2012         {lineitem => $li_id, fund_debit => {'!=' => undef}},
2013         {idlist => 1}
2014     );
2015
2016     for my $lid_id (@$lid_ids) {
2017
2018         my $lid = $e->retrieve_acq_lineitem_detail([
2019             $lid_id, {
2020             flesh => 1, flesh_fields => {acqlid => ['fund', 'fund_debit']}}
2021         ]);
2022
2023         $lid->fund_debit->amount($price);
2024         $e->update_acq_fund_debit($lid->fund_debit) or return $e->die_event;
2025         $mgr->add_lid;
2026         $mgr->respond;
2027     }
2028
2029     $e->commit;
2030     return $mgr->respond_complete;
2031 }
2032
2033
2034 __PACKAGE__->register_method(
2035     method    => 'clone_picklist_api',
2036     api_name  => 'open-ils.acq.picklist.clone',
2037     signature => {
2038         desc   => 'Clones a picklist, including lineitem and lineitem details',
2039         params => [
2040             {desc => 'Authentication token', type => 'string'},
2041             {desc => 'Picklist ID', type => 'number'},
2042             {desc => 'New Picklist Name', type => 'string'}
2043         ],
2044         return => {desc => 'status blob, Event on error'}
2045     }
2046 );
2047
2048 sub clone_picklist_api {
2049     my($self, $conn, $auth, $pl_id, $name) = @_;
2050
2051     my $e = new_editor(xact=>1, authtoken=>$auth);
2052     return $e->die_event unless $e->checkauth;
2053     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
2054
2055     my $old_pl = $e->retrieve_acq_picklist($pl_id);
2056     my $new_pl = create_picklist($mgr, %{$old_pl->to_bare_hash}, name => $name) or return $e->die_event;
2057
2058     my $li_ids = $e->search_acq_lineitem({picklist => $pl_id}, {idlist => 1});
2059
2060     for my $li_id (@$li_ids) {
2061
2062         # copy the lineitems
2063         my $li = $e->retrieve_acq_lineitem($li_id);
2064         my $new_li = create_lineitem($mgr, %{$li->to_bare_hash}, picklist => $new_pl->id) or return $e->die_event;
2065
2066         my $lid_ids = $e->search_acq_lineitem_detail({lineitem => $li_id}, {idlist => 1});
2067         for my $lid_id (@$lid_ids) {
2068
2069             # copy the lineitem details
2070             my $lid = $e->retrieve_acq_lineitem_detail($lid_id);
2071             create_lineitem_detail($mgr, %{$lid->to_bare_hash}, lineitem => $new_li->id) or return $e->die_event;
2072         }
2073
2074         $mgr->respond;
2075     }
2076
2077     $e->commit;
2078     return $mgr->respond_complete;
2079 }
2080
2081
2082 __PACKAGE__->register_method(
2083     method    => 'merge_picklist_api',
2084     api_name  => 'open-ils.acq.picklist.merge',
2085     signature => {
2086         desc   => 'Merges 2 or more picklists into a single list',
2087         params => [
2088             {desc => 'Authentication token', type => 'string'},
2089             {desc => 'Lead Picklist ID', type => 'number'},
2090             {desc => 'List of subordinate picklist IDs', type => 'array'}
2091         ],
2092         return => {desc => 'status blob, Event on error'}
2093     }
2094 );
2095
2096 sub merge_picklist_api {
2097     my($self, $conn, $auth, $lead_pl, $pl_list) = @_;
2098
2099     my $e = new_editor(xact=>1, authtoken=>$auth);
2100     return $e->die_event unless $e->checkauth;
2101     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
2102
2103     # XXX perms on each picklist modified
2104
2105     $lead_pl = $e->retrieve_acq_picklist($lead_pl) or return $e->die_event;
2106     # point all of the lineitems at the lead picklist
2107     my $li_ids = $e->search_acq_lineitem({picklist => $pl_list}, {idlist => 1});
2108
2109     for my $li_id (@$li_ids) {
2110         my $li = $e->retrieve_acq_lineitem($li_id);
2111         $li->picklist($lead_pl);
2112         update_lineitem($mgr, $li) or return $e->die_event;
2113         $mgr->respond;
2114     }
2115
2116     # now delete the subordinate lists
2117     for my $pl_id (@$pl_list) {
2118         my $pl = $e->retrieve_acq_picklist($pl_id);
2119         $e->delete_acq_picklist($pl) or return $e->die_event;
2120     }
2121
2122     update_picklist($mgr, $lead_pl) or return $e->die_event;
2123
2124     $e->commit;
2125     return $mgr->respond_complete;
2126 }
2127
2128
2129 __PACKAGE__->register_method(
2130     method    => 'delete_picklist_api',
2131     api_name  => 'open-ils.acq.picklist.delete',
2132     signature => {
2133         desc   => q/Deletes a picklist.  It also deletes any lineitems in the "new" state. / .
2134                   q/Other attached lineitems are detached/,
2135         params => [
2136             {desc => 'Authentication token',  type => 'string'},
2137             {desc => 'Picklist ID to delete', type => 'number'}
2138         ],
2139         return => {desc => '1 on success, Event on error'}
2140     }
2141 );
2142
2143 sub delete_picklist_api {
2144     my($self, $conn, $auth, $picklist_id) = @_;
2145     my $e = new_editor(xact=>1, authtoken=>$auth);
2146     return $e->die_event unless $e->checkauth;
2147     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
2148     my $pl = $e->retrieve_acq_picklist($picklist_id) or return $e->die_event;
2149     delete_picklist($mgr, $pl) or return $e->die_event;
2150     $e->commit;
2151     return $mgr->respond_complete;
2152 }
2153
2154
2155
2156 __PACKAGE__->register_method(
2157     method   => 'activate_purchase_order',
2158     api_name => 'open-ils.acq.purchase_order.activate.dry_run'
2159 );
2160
2161 __PACKAGE__->register_method(
2162     method    => 'activate_purchase_order',
2163     api_name  => 'open-ils.acq.purchase_order.activate',
2164     signature => {
2165         desc => q/Activates a purchase order.  This updates the status of the PO / .
2166                 q/and Lineitems to 'on-order'.  Activated PO's are ready for EDI delivery if appropriate./,
2167         params => [
2168             {desc => 'Authentication token', type => 'string'},
2169             {desc => 'Purchase ID', type => 'number'}
2170         ],
2171         return => {desc => '1 on success, Event on error'}
2172     }
2173 );
2174
2175 sub activate_purchase_order {
2176     my($self, $conn, $auth, $po_id) = @_;
2177
2178     my $dry_run = ($self->api_name =~ /\.dry_run/) ? 1 : 0;
2179     my $e = new_editor(xact=>1, authtoken=>$auth);
2180     return $e->die_event unless $e->checkauth;
2181     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
2182     my $die_event = activate_purchase_order_impl($mgr, $po_id, $dry_run);
2183     return $e->die_event if $die_event;
2184     if ($dry_run) {
2185         $e->rollback;
2186     } else {
2187         $e->commit;
2188     }
2189     $conn->respond_complete(1);
2190     $mgr->run_post_response_hooks;
2191     return undef;
2192 }
2193
2194 sub activate_purchase_order_impl {
2195     my ($mgr, $po_id, $dry_run) = @_;
2196     my $e = $mgr->editor;
2197
2198     my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->die_event;
2199     return $e->die_event unless $e->allowed('CREATE_PURCHASE_ORDER', $po->ordering_agency);
2200
2201     my $provider = $e->retrieve_acq_provider($po->provider);
2202
2203     $po->state('on-order');
2204     $po->order_date('now');
2205     update_purchase_order($mgr, $po) or return $e->die_event;
2206
2207     my $query = [
2208         {
2209             purchase_order => $po_id,
2210             state => [qw/pending-order new order-ready/]
2211         },
2212         {limit => 1}
2213     ];
2214
2215     while( my $li_id = $e->search_acq_lineitem($query, {idlist => 1})->[0] ) {
2216
2217         my $li;
2218         if($dry_run) {
2219             $li = $e->retrieve_acq_lineitem($li_id);
2220         } else {
2221             # can't activate a PO w/o assets.  Create lineitem assets as necessary
2222             my $data = create_lineitem_assets($mgr, $li_id) or return $e->die_event;
2223             $li = $data->{li};
2224         }
2225
2226         $li->state('on-order');
2227         $li->claim_policy($provider->default_claim_policy)
2228             if $provider->default_claim_policy and !$li->claim_policy;
2229         create_lineitem_debits($mgr, $li, $dry_run) or return $e->die_event;
2230         update_lineitem($mgr, $li) or return $e->die_event;
2231         $mgr->post_process( sub { create_lineitem_status_events($mgr, $li->id, 'aur.ordered'); });
2232         $mgr->respond;
2233     }
2234
2235     for my $po_item (@{$e->search_acq_po_item({purchase_order => $po_id})}) {
2236
2237         my $debit = create_fund_debit(
2238             $mgr,
2239             $dry_run,
2240             debit_type => 'direct_charge', # to match invoicing
2241             origin_amount => $po_item->estimated_cost,
2242             origin_currency_type => $e->retrieve_acq_fund($po_item->fund)->currency_type,
2243             amount => $po_item->estimated_cost,
2244             fund => $po_item->fund
2245         ) or return $e->die_event;
2246         $po_item->fund_debit($debit->id);
2247         $e->update_acq_po_item($po_item) or return $e->die_event;
2248         $mgr->respond;
2249     }
2250
2251     # tell the world we activated a PO
2252     $U->create_events_for_hook('acqpo.activated', $po, $po->ordering_agency) unless $dry_run;
2253
2254     return undef;
2255 }
2256
2257
2258 __PACKAGE__->register_method(
2259     method    => 'split_purchase_order_by_lineitems',
2260     api_name  => 'open-ils.acq.purchase_order.split_by_lineitems',
2261     signature => {
2262         desc   => q/Splits a PO into many POs, 1 per lineitem.  Only works for / .
2263                   q/POs a) with more than one lineitems, and b) in the "pending" state./,
2264         params => [
2265             {desc => 'Authentication token', type => 'string'},
2266             {desc => 'Purchase order ID',    type => 'number'}
2267         ],
2268         return => {desc => 'list of new PO IDs on success, Event on error'}
2269     }
2270 );
2271
2272 sub split_purchase_order_by_lineitems {
2273     my ($self, $conn, $auth, $po_id) = @_;
2274
2275     my $e = new_editor("xact" => 1, "authtoken" => $auth);
2276     return $e->die_event unless $e->checkauth;
2277
2278     my $po = $e->retrieve_acq_purchase_order([
2279         $po_id, {
2280             "flesh" => 1,
2281             "flesh_fields" => {"acqpo" => [qw/lineitems notes/]}
2282         }
2283     ]) or return $e->die_event;
2284
2285     return $e->die_event
2286         unless $e->allowed("CREATE_PURCHASE_ORDER", $po->ordering_agency);
2287
2288     unless ($po->state eq "pending") {
2289         $e->rollback;
2290         return new OpenILS::Event("ACQ_PURCHASE_ORDER_TOO_LATE");
2291     }
2292
2293     unless (@{$po->lineitems} > 1) {
2294         $e->rollback;
2295         return new OpenILS::Event("ACQ_PURCHASE_ORDER_TOO_SHORT");
2296     }
2297
2298     # To split an existing PO into many, it seems unwise to just delete the
2299     # original PO, so we'll instead detach all of the original POs' lineitems
2300     # but the first, then create new POs for each of the remaining LIs, and
2301     # then attach the LIs to their new POs.
2302
2303     my @po_ids = ($po->id);
2304     my @moving_li = @{$po->lineitems};
2305     shift @moving_li;    # discard first LI
2306
2307     foreach my $li (@moving_li) {
2308         my $new_po = $po->clone;
2309         $new_po->clear_id;
2310         $new_po->clear_name;
2311         $new_po->creator($e->requestor->id);
2312         $new_po->editor($e->requestor->id);
2313         $new_po->owner($e->requestor->id);
2314         $new_po->edit_time("now");
2315         $new_po->create_time("now");
2316
2317         $new_po = $e->create_acq_purchase_order($new_po);
2318
2319         # Clone any notes attached to the old PO and attach to the new one.
2320         foreach my $note (@{$po->notes}) {
2321             my $new_note = $note->clone;
2322             $new_note->clear_id;
2323             $new_note->edit_time("now");
2324             $new_note->purchase_order($new_po->id);
2325             $e->create_acq_po_note($new_note);
2326         }
2327
2328         $li->edit_time("now");
2329         $li->purchase_order($new_po->id);
2330         $e->update_acq_lineitem($li);
2331
2332         push @po_ids, $new_po->id;
2333     }
2334
2335     $po->edit_time("now");
2336     $e->update_acq_purchase_order($po);
2337
2338     return \@po_ids if $e->commit;
2339     return $e->die_event;
2340 }
2341
2342
2343 sub not_cancelable {
2344     my $o = shift;
2345     (ref $o eq "HASH" and $o->{"textcode"} eq "ACQ_NOT_CANCELABLE");
2346 }
2347
2348 __PACKAGE__->register_method(
2349         method => "cancel_purchase_order_api",
2350         api_name        => "open-ils.acq.purchase_order.cancel",
2351         signature => {
2352         desc => q/Cancels an on-order purchase order/,
2353         params => [
2354             {desc => "Authentication token", type => "string"},
2355             {desc => "PO ID to cancel", type => "number"},
2356             {desc => "Cancel reason ID", type => "number"}
2357         ],
2358         return => {desc => q/Object describing changed POs, LIs and LIDs
2359             on success; Event on error./}
2360     }
2361 );
2362
2363 sub cancel_purchase_order_api {
2364     my ($self, $conn, $auth, $po_id, $cancel_reason) = @_;
2365
2366     my $e = new_editor("xact" => 1, "authtoken" => $auth);
2367     return $e->die_event unless $e->checkauth;
2368     my $mgr = new OpenILS::Application::Acq::BatchManager(
2369         "editor" => $e, "conn" => $conn
2370     );
2371
2372     $cancel_reason = $mgr->editor->retrieve_acq_cancel_reason($cancel_reason) or
2373         return new OpenILS::Event(
2374             "BAD_PARAMS", "note" => "Provide cancel reason ID"
2375         );
2376
2377     my $result = cancel_purchase_order($mgr, $po_id, $cancel_reason) or
2378         return $e->die_event;
2379     if (not_cancelable($result)) { # event not from CStoreEditor
2380         $e->rollback;
2381         return $result;
2382     } elsif ($result == -1) {
2383         $e->rollback;
2384         return new OpenILS::Event("ACQ_ALREADY_CANCELED");
2385     }
2386
2387     $e->commit or return $e->die_event;
2388
2389     # XXX create purchase order status events?
2390
2391     if ($mgr->{post_commit}) {
2392         foreach my $func (@{$mgr->{post_commit}}) {
2393             $func->();
2394         }
2395     }
2396
2397     return $result;
2398 }
2399
2400 sub cancel_purchase_order {
2401     my ($mgr, $po_id, $cancel_reason) = @_;
2402
2403     my $po = $mgr->editor->retrieve_acq_purchase_order($po_id) or return 0;
2404
2405     # XXX is "cancelled" a typo?  It's not correct US spelling, anyway.
2406     # Depending on context, this may not warrant an event.
2407     return -1 if $po->state eq "cancelled";
2408
2409     # But this always does.
2410     return new OpenILS::Event(
2411         "ACQ_NOT_CANCELABLE", "note" => "purchase_order $po_id"
2412     ) unless ($po->state eq "on-order" or $po->state eq "pending");
2413
2414     return 0 unless
2415         $mgr->editor->allowed("CREATE_PURCHASE_ORDER", $po->ordering_agency);
2416
2417     $po->state("cancelled");
2418     $po->cancel_reason($cancel_reason->id);
2419
2420     my $li_ids = $mgr->editor->search_acq_lineitem(
2421         {"purchase_order" => $po_id}, {"idlist" => 1}
2422     );
2423
2424     my $result = {"li" => {}, "lid" => {}};
2425     foreach my $li_id (@$li_ids) {
2426         my $li_result = cancel_lineitem($mgr, $li_id, $cancel_reason)
2427             or return 0;
2428
2429         next if $li_result == -1; # already canceled:skip.
2430         return $li_result if not_cancelable($li_result); # not cancelable:stop.
2431
2432         # Merge in each LI result (there's only going to be
2433         # one per call to cancel_lineitem).
2434         my ($k, $v) = each %{$li_result->{"li"}};
2435         $result->{"li"}->{$k} = $v;
2436
2437         # Merge in each LID result (there may be many per call to
2438         # cancel_lineitem).
2439         while (($k, $v) = each %{$li_result->{"lid"}}) {
2440             $result->{"lid"}->{$k} = $v;
2441         }
2442     }
2443
2444     # TODO who/what/where/how do we indicate this change for electronic orders?
2445     # TODO return changes to encumbered/spent
2446     # TODO maybe cascade up from smaller object to container object if last
2447     # smaller object in the container has been canceled?
2448
2449     update_purchase_order($mgr, $po) or return 0;
2450     $result->{"po"} = {
2451         $po_id => {"state" => $po->state, "cancel_reason" => $cancel_reason}
2452     };
2453     return $result;
2454 }
2455
2456
2457 __PACKAGE__->register_method(
2458         method => "cancel_lineitem_api",
2459         api_name        => "open-ils.acq.lineitem.cancel",
2460         signature => {
2461         desc => q/Cancels an on-order lineitem/,
2462         params => [
2463             {desc => "Authentication token", type => "string"},
2464             {desc => "Lineitem ID to cancel", type => "number"},
2465             {desc => "Cancel reason ID", type => "number"}
2466         ],
2467         return => {desc => q/Object describing changed LIs and LIDs on success;
2468             Event on error./}
2469     }
2470 );
2471
2472 __PACKAGE__->register_method(
2473         method => "cancel_lineitem_api",
2474         api_name        => "open-ils.acq.lineitem.cancel.batch",
2475         signature => {
2476         desc => q/Batched version of open-ils.acq.lineitem.cancel/,
2477         return => {desc => q/Object describing changed LIs and LIDs on success;
2478             Event on error./}
2479     }
2480 );
2481
2482 sub cancel_lineitem_api {
2483     my ($self, $conn, $auth, $li_id, $cancel_reason) = @_;
2484
2485     my $batched = $self->api_name =~ /\.batch/;
2486
2487     my $e = new_editor("xact" => 1, "authtoken" => $auth);
2488     return $e->die_event unless $e->checkauth;
2489     my $mgr = new OpenILS::Application::Acq::BatchManager(
2490         "editor" => $e, "conn" => $conn
2491     );
2492
2493     $cancel_reason = $mgr->editor->retrieve_acq_cancel_reason($cancel_reason) or
2494         return new OpenILS::Event(
2495             "BAD_PARAMS", "note" => "Provide cancel reason ID"
2496         );
2497
2498     my ($result, $maybe_event);
2499
2500     if ($batched) {
2501         $result = {"li" => {}, "lid" => {}};
2502         foreach my $one_li_id (@$li_id) {
2503             my $one = cancel_lineitem($mgr, $one_li_id, $cancel_reason) or
2504                 return $e->die_event;
2505             if (not_cancelable($one)) {
2506                 $maybe_event = $one;
2507             } elsif ($result == -1) {
2508                 $maybe_event = new OpenILS::Event("ACQ_ALREADY_CANCELED");
2509             } else {
2510                 my ($k, $v);
2511                 if ($one->{"li"}) {
2512                     while (($k, $v) = each %{$one->{"li"}}) {
2513                         $result->{"li"}->{$k} = $v;
2514                     }
2515                 }
2516                 if ($one->{"lid"}) {
2517                     while (($k, $v) = each %{$one->{"lid"}}) {
2518                         $result->{"lid"}->{$k} = $v;
2519                     }
2520                 }
2521             }
2522         }
2523     } else {
2524         $result = cancel_lineitem($mgr, $li_id, $cancel_reason) or
2525             return $e->die_event;
2526
2527         if (not_cancelable($result)) {
2528             $e->rollback;
2529             return $result;
2530         } elsif ($result == -1) {
2531             $e->rollback;
2532             return new OpenILS::Event("ACQ_ALREADY_CANCELED");
2533         }
2534     }
2535
2536     if ($batched and not scalar keys %{$result->{"li"}}) {
2537         $e->rollback;
2538         return $maybe_event;
2539     } else {
2540         $e->commit or return $e->die_event;
2541         # create_lineitem_status_events should handle array li_id ok
2542         create_lineitem_status_events($mgr, $li_id, "aur.cancelled");
2543
2544         if ($mgr->{post_commit}) {
2545             foreach my $func (@{$mgr->{post_commit}}) {
2546                 $func->();
2547             }
2548         }
2549
2550         return $result;
2551     }
2552 }
2553
2554 sub cancel_lineitem {
2555     my ($mgr, $li_id, $cancel_reason) = @_;
2556     my $li = $mgr->editor->retrieve_acq_lineitem([
2557         $li_id, {flesh => 1, flesh_fields => {jub => ['purchase_order']}}
2558     ]) or return 0;
2559
2560     return 0 unless $mgr->editor->allowed(
2561         "CREATE_PURCHASE_ORDER", $li->purchase_order->ordering_agency
2562     );
2563
2564     # Depending on context, this may not warrant an event.
2565     return -1 if $li->state eq "cancelled";
2566
2567     # But this always does.
2568     return new OpenILS::Event(
2569         "ACQ_NOT_CANCELABLE", "note" => "lineitem $li_id"
2570     ) unless (
2571         (! $li->purchase_order) or (
2572             $li->purchase_order and (
2573                 $li->state eq "on-order" or $li->state eq "pending-order"
2574             )
2575         )
2576     );
2577
2578     $li->state("cancelled");
2579     $li->cancel_reason($cancel_reason->id);
2580
2581     my $lids = $mgr->editor->search_acq_lineitem_detail([{
2582         "lineitem" => $li_id
2583     }, {
2584         flesh => 1,
2585         flesh_fields => { acqlid => ['eg_copy_id'] }
2586     }]);
2587
2588     my $result = {"lid" => {}};
2589     my $copies = [];
2590     foreach my $lid (@$lids) {
2591         my $lid_result = cancel_lineitem_detail($mgr, $lid->id, $cancel_reason)
2592             or return 0;
2593
2594         # gathering any real copies for deletion
2595         if ($lid->eg_copy_id) {
2596             $lid->eg_copy_id->isdeleted('t');
2597             push @$copies, $lid->eg_copy_id;
2598         }
2599
2600         next if $lid_result == -1; # already canceled: just skip it.
2601         return $lid_result if not_cancelable($lid_result); # not cxlable: stop.
2602
2603         # Merge in each LID result (there's only going to be one per call to
2604         # cancel_lineitem_detail).
2605         my ($k, $v) = each %{$lid_result->{"lid"}};
2606         $result->{"lid"}->{$k} = $v;
2607     }
2608
2609     # Attempt to delete the gathered copies (this will also handle volume deletion and bib deletion)
2610     # Delete empty bibs according org unit setting
2611     my $force_delete_empty_bib = $U->ou_ancestor_setting_value(
2612         $mgr->editor->requestor->ws_ou, 'cat.bib.delete_on_no_copy_via_acq_lineitem_cancel', $mgr->editor);
2613     if (scalar(@$copies)>0) {
2614         my $override = 1;
2615         my $delete_stats = undef;
2616         my $retarget_holds = [];
2617         my $cat_evt = OpenILS::Application::Cat::AssetCommon->update_fleshed_copies(
2618             $mgr->editor, $override, undef, $copies, $delete_stats, $retarget_holds,$force_delete_empty_bib);
2619
2620         if( $cat_evt ) {
2621             $logger->info("fleshed copy update failed with event: ".OpenSRF::Utils::JSON->perl2JSON($cat_evt));
2622             return new OpenILS::Event(
2623                 "ACQ_NOT_CANCELABLE", "note" => "lineitem $li_id", "payload" => $cat_evt
2624             );
2625         }
2626
2627         # We can't do the following and stay within the same transaction, but that's okay, the hold targeter will pick these up later.
2628         #my $ses = OpenSRF::AppSession->create('open-ils.circ');
2629         #$ses->request('open-ils.circ.hold.reset.batch', $auth, $retarget_holds);
2630     }
2631
2632     # if we have a bib, check to see whether it has been deleted.  if so, cancel any active holds targeting that bib
2633     if ($li->eg_bib_id) {
2634         my $bib = $mgr->editor->retrieve_biblio_record_entry($li->eg_bib_id) or return new OpenILS::Event(
2635             "ACQ_NOT_CANCELABLE", "note" => "Could not retrieve bib " . $li->eg_bib_id . " for lineitem $li_id"
2636         );
2637         if ($U->is_true($bib->deleted)) {
2638             my $holds = $mgr->editor->search_action_hold_request(
2639                 {   cancel_time => undef,
2640                     fulfillment_time => undef,
2641                     target => $li->eg_bib_id
2642                 }
2643             );
2644
2645             my %cached_usr_home_ou = ();
2646
2647             for my $hold (@$holds) {
2648
2649                 $logger->info("Cancelling hold ".$hold->id.
2650                     " due to acq lineitem cancellation.");
2651
2652                 $hold->cancel_time('now');
2653                 $hold->cancel_cause(5); # 'Staff forced'--we may want a new hold cancel cause reason for this
2654                 $hold->cancel_note('Corresponding Acquistion Lineitem/Purchase Order was cancelled.');
2655                 unless($mgr->editor->update_action_hold_request($hold)) {
2656                     my $evt = $mgr->editor->event;
2657                     $logger->error("Error updating hold ". $evt->textcode .":". $evt->desc .":". $evt->stacktrace);
2658                     return new OpenILS::Event(
2659                         "ACQ_NOT_CANCELABLE", "note" => "Could not cancel hold " . $hold->id . " for lineitem $li_id", "payload" => $evt
2660                     );
2661                 }
2662                 if (! defined $mgr->{post_commit}) { # we need a mechanism for creating trigger events, but only if the transaction gets committed
2663                     $mgr->{post_commit} = [];
2664                 }
2665                 push @{ $mgr->{post_commit} }, sub {
2666                     my $home_ou = $cached_usr_home_ou{$hold->usr};
2667                     if (! $home_ou) {
2668                         my $user = $mgr->editor->retrieve_actor_user($hold->usr); # FIXME: how do we want to handle failures here?
2669                         $home_ou = $user->home_ou;
2670                         $cached_usr_home_ou{$hold->usr} = $home_ou;
2671                     }
2672                     $U->create_events_for_hook('hold_request.cancel.cancelled_order', $hold, $home_ou);
2673                 };
2674             }
2675         }
2676     }
2677
2678     update_lineitem($mgr, $li) or return 0;
2679     $result->{"li"} = {
2680         $li_id => {
2681             "state" => $li->state,
2682             "cancel_reason" => $cancel_reason
2683         }
2684     };
2685     return $result;
2686 }
2687
2688
2689 __PACKAGE__->register_method(
2690         method => "cancel_lineitem_detail_api",
2691         api_name        => "open-ils.acq.lineitem_detail.cancel",
2692         signature => {
2693         desc => q/Cancels an on-order lineitem detail/,
2694         params => [
2695             {desc => "Authentication token", type => "string"},
2696             {desc => "Lineitem detail ID to cancel", type => "number"},
2697             {desc => "Cancel reason ID", type => "number"}
2698         ],
2699         return => {desc => q/Object describing changed LIDs on success;
2700             Event on error./}
2701     }
2702 );
2703
2704 sub cancel_lineitem_detail_api {
2705     my ($self, $conn, $auth, $lid_id, $cancel_reason) = @_;
2706
2707     my $e = new_editor("xact" => 1, "authtoken" => $auth);
2708     return $e->die_event unless $e->checkauth;
2709     my $mgr = new OpenILS::Application::Acq::BatchManager(
2710         "editor" => $e, "conn" => $conn
2711     );
2712
2713     $cancel_reason = $mgr->editor->retrieve_acq_cancel_reason($cancel_reason) or
2714         return new OpenILS::Event(
2715             "BAD_PARAMS", "note" => "Provide cancel reason ID"
2716         );
2717
2718     my $result = cancel_lineitem_detail($mgr, $lid_id, $cancel_reason) or
2719         return $e->die_event;
2720
2721     if (not_cancelable($result)) {
2722         $e->rollback;
2723         return $result;
2724     } elsif ($result == -1) {
2725         $e->rollback;
2726         return new OpenILS::Event("ACQ_ALREADY_CANCELED");
2727     }
2728
2729     $e->commit or return $e->die_event;
2730
2731     # XXX create lineitem detail status events?
2732     return $result;
2733 }
2734
2735 sub cancel_lineitem_detail {
2736     my ($mgr, $lid_id, $cancel_reason) = @_;
2737     my $lid = $mgr->editor->retrieve_acq_lineitem_detail([
2738         $lid_id, {
2739             "flesh" => 2,
2740             "flesh_fields" => {
2741                 "acqlid" => ["lineitem"], "jub" => ["purchase_order"]
2742             }
2743         }
2744     ]) or return 0;
2745
2746     # Depending on context, this may not warrant an event.
2747     return -1 if $lid->cancel_reason;
2748
2749     # But this always does.
2750     return new OpenILS::Event(
2751         "ACQ_NOT_CANCELABLE", "note" => "lineitem_detail $lid_id"
2752     ) unless (
2753         (! $lid->lineitem->purchase_order) or
2754         (
2755             (not $lid->recv_time) and
2756             $lid->lineitem and
2757             $lid->lineitem->purchase_order and (
2758                 $lid->lineitem->state eq "on-order" or
2759                 $lid->lineitem->state eq "pending-order"
2760             )
2761         )
2762     );
2763
2764     return 0 unless $mgr->editor->allowed(
2765         "CREATE_PURCHASE_ORDER",
2766         $lid->lineitem->purchase_order->ordering_agency
2767     ) or (! $lid->lineitem->purchase_order);
2768
2769     $lid->cancel_reason($cancel_reason->id);
2770
2771     unless($U->is_true($cancel_reason->keep_debits)) {
2772         my $debit_id = $lid->fund_debit;
2773         $lid->clear_fund_debit;
2774
2775         if($debit_id) {
2776             # item is cancelled.  Remove the fund debit.
2777             my $debit = $mgr->editor->retrieve_acq_fund_debit($debit_id);
2778             if (!$U->is_true($debit->encumbrance)) {
2779                 $mgr->editor->rollback;
2780                 return OpenILS::Event->new('ACQ_NOT_CANCELABLE',
2781                     note => "Debit is marked as paid: $debit_id");
2782             }
2783             $mgr->editor->delete_acq_fund_debit($debit) or return $mgr->editor->die_event;
2784         }
2785     }
2786
2787     # XXX LIDs don't have either an editor or a edit_time field. Should we
2788     # update these on the LI when we alter an LID?
2789     $mgr->editor->update_acq_lineitem_detail($lid) or return 0;
2790
2791     return {"lid" => {$lid_id => {"cancel_reason" => $cancel_reason}}};
2792 }
2793
2794
2795 __PACKAGE__->register_method(
2796     method    => 'user_requests',
2797     api_name  => 'open-ils.acq.user_request.retrieve.by_user_id',
2798     stream    => 1,
2799     signature => {
2800         desc   => 'Retrieve fleshed user requests and related data for a given user.',
2801         params => [
2802             { desc => 'Authentication token',      type => 'string' },
2803             { desc => 'User ID of the owner, or array of IDs',      },
2804             { desc => 'Options hash (optional) with any of the keys: order_by, limit, offset, state (of the lineitem)',
2805               type => 'object'
2806             }
2807         ],
2808         return => {
2809             desc => 'Fleshed user requests and related data',
2810             type => 'object'
2811         }
2812     }
2813 );
2814
2815 __PACKAGE__->register_method(
2816     method    => 'user_requests',
2817     api_name  => 'open-ils.acq.user_request.retrieve.by_home_ou',
2818     stream    => 1,
2819     signature => {
2820         desc   => 'Retrieve fleshed user requests and related data for a given org unit or units.',
2821         params => [
2822             { desc => 'Authentication token',      type => 'string' },
2823             { desc => 'Org unit ID, or array of IDs',               },
2824             { desc => 'Options hash (optional) with any of the keys: order_by, limit, offset, state (of the lineitem)',
2825               type => 'object'
2826             }
2827         ],
2828         return => {
2829             desc => 'Fleshed user requests and related data',
2830             type => 'object'
2831         }
2832     }
2833 );
2834
2835 sub user_requests {
2836     my($self, $conn, $auth, $search_value, $options) = @_;
2837     my $e = new_editor(authtoken => $auth);
2838     return $e->event unless $e->checkauth;
2839     my $rid = $e->requestor->id;
2840     $options ||= {};
2841
2842     my $query = {
2843         "select"=>{"aur"=>["id"],"au"=>["home_ou", {column => 'id', alias => 'usr_id'} ]},
2844         "from"=>{ "aur" => { "au" => {}, "jub" => { "type" => "left" } } },
2845         "where"=>{
2846             "+jub"=> {
2847                 "-or" => [
2848                     {"id"=>undef}, # this with the left-join pulls in requests without lineitems
2849                     {"state"=>["new","on-order","pending-order"]} # FIXME - probably needs softcoding
2850                 ]
2851             }
2852         },
2853         "order_by"=>[{"class"=>"aur", "field"=>"request_date", "direction"=>"desc"}]
2854     };
2855
2856     foreach (qw/ order_by limit offset /) {
2857         $query->{$_} = $options->{$_} if defined $options->{$_};
2858     }
2859     if (defined $options->{'state'}) {
2860         $query->{'where'}->{'+jub'}->{'-or'}->[1]->{'state'} = $options->{'state'};
2861     }
2862
2863     if ($self->api_name =~ /by_user_id/) {
2864         $query->{'where'}->{'usr'} = $search_value;
2865     } else {
2866         $query->{'where'}->{'+au'} = { 'home_ou' => $search_value };
2867     }
2868
2869     my $pertinent_ids = $e->json_query($query);
2870
2871     my %perm_test = ();
2872     for my $id_blob (@$pertinent_ids) {
2873         if ($rid != $id_blob->{usr_id}) {
2874             if (!defined $perm_test{ $id_blob->{home_ou} }) {
2875                 $perm_test{ $id_blob->{home_ou} } = $e->allowed( ['user_request.view'], $id_blob->{home_ou} );
2876             }
2877             if (!$perm_test{ $id_blob->{home_ou} }) {
2878                 next; # failed test
2879             }
2880         }
2881         my $aur_obj = $e->retrieve_acq_user_request([
2882             $id_blob->{id},
2883             {flesh => 1, flesh_fields => { "aur" => [ 'lineitem' ] } }
2884         ]);
2885         if (! $aur_obj) { next; }
2886
2887         if ($aur_obj->lineitem()) {
2888             $aur_obj->lineitem()->clear_marc();
2889         }
2890         $conn->respond($aur_obj);
2891     }
2892
2893     return undef;
2894 }
2895
2896 __PACKAGE__->register_method (
2897     method    => 'update_user_request',
2898     api_name  => 'open-ils.acq.user_request.cancel.batch',
2899     stream    => 1,
2900     signature => {
2901         desc   => 'If given a cancel reason, will update the request with that reason, otherwise, this will delete the request altogether.  The '    .
2902                   'intention is for staff interfaces or processes to provide cancel reasons, and for patron interfaces to just delete the requests.' ,
2903         params => [
2904             { desc => 'Authentication token',              type => 'string' },
2905             { desc => 'ID or array of IDs for the user requests to cancel'  },
2906             { desc => 'Cancel Reason ID (optional)',       type => 'string' }
2907         ],
2908         return => {
2909             desc => 'progress object, event on error',
2910         }
2911     }
2912 );
2913 __PACKAGE__->register_method (
2914     method    => 'update_user_request',
2915     api_name  => 'open-ils.acq.user_request.set_no_hold.batch',
2916     stream    => 1,
2917     signature => {
2918         desc   => 'Remove the hold from a user request or set of requests',
2919         params => [
2920             { desc => 'Authentication token',              type => 'string' },
2921             { desc => 'ID or array of IDs for the user requests to modify'  }
2922         ],
2923         return => {
2924             desc => 'progress object, event on error',
2925         }
2926     }
2927 );
2928
2929 sub update_user_request {
2930     my($self, $conn, $auth, $aur_ids, $cancel_reason) = @_;
2931     my $e = new_editor(xact => 1, authtoken => $auth);
2932     return $e->die_event unless $e->checkauth;
2933     my $rid = $e->requestor->id;
2934
2935     my $x = 1;
2936     my %perm_test = ();
2937     for my $id (@$aur_ids) {
2938
2939         my $aur_obj = $e->retrieve_acq_user_request([
2940             $id,
2941             {   flesh => 1,
2942                 flesh_fields => { "aur" => ['lineitem', 'usr'] }
2943             }
2944         ]) or return $e->die_event;
2945
2946         my $context_org = $aur_obj->usr()->home_ou();
2947         $aur_obj->usr( $aur_obj->usr()->id() );
2948
2949         if ($rid != $aur_obj->usr) {
2950             if (!defined $perm_test{ $context_org }) {
2951                 $perm_test{ $context_org } = $e->allowed( ['user_request.update'], $context_org );
2952             }
2953             if (!$perm_test{ $context_org }) {
2954                 next; # failed test
2955             }
2956         }
2957
2958         if($self->api_name =~ /set_no_hold/) {
2959             if ($U->is_true($aur_obj->hold)) {
2960                 $aur_obj->hold(0);
2961                 $e->update_acq_user_request($aur_obj) or return $e->die_event;
2962             }
2963         }
2964
2965         if($self->api_name =~ /cancel/) {
2966             if ( $cancel_reason ) {
2967                 $aur_obj->cancel_reason( $cancel_reason );
2968                 $e->update_acq_user_request($aur_obj) or return $e->die_event;
2969                 create_user_request_events( $e, [ $aur_obj ], 'aur.rejected' );
2970             } else {
2971                 $e->delete_acq_user_request($aur_obj);
2972             }
2973         }
2974
2975         $conn->respond({maximum => scalar(@$aur_ids), progress => $x++});
2976     }
2977
2978     $e->commit;
2979     return {complete => 1};
2980 }
2981
2982 __PACKAGE__->register_method (
2983     method    => 'new_user_request',
2984     api_name  => 'open-ils.acq.user_request.create',
2985     signature => {
2986         desc   => 'Create a new user request object in the DB',
2987         param  => [
2988             { desc => 'Authentication token',   type => 'string' },
2989             { desc => 'User request data hash.  Hash keys match the fields for the "aur" object', type => 'object' }
2990         ],
2991         return => {
2992             desc => 'The created user request object, or event on error'
2993         }
2994     }
2995 );
2996
2997 sub new_user_request {
2998     my($self, $conn, $auth, $form_data) = @_;
2999     my $e = new_editor(xact => 1, authtoken => $auth);
3000     return $e->die_event unless $e->checkauth;
3001     my $rid = $e->requestor->id;
3002     my $target_user_fleshed;
3003     if (! defined $$form_data{'usr'}) {
3004         $$form_data{'usr'} = $rid;
3005     }
3006     if ($$form_data{'usr'} != $rid) {
3007         # See if the requestor can place the request on behalf of a different user.
3008         $target_user_fleshed = $e->retrieve_actor_user($$form_data{'usr'}) or return $e->die_event;
3009         $e->allowed('user_request.create', $target_user_fleshed->home_ou) or return $e->die_event;
3010     } else {
3011         $target_user_fleshed = $e->requestor;
3012         $e->allowed('CREATE_PURCHASE_REQUEST') or return $e->die_event;
3013     }
3014     if (! defined $$form_data{'pickup_lib'}) {
3015         if ($target_user_fleshed->ws_ou) {
3016             $$form_data{'pickup_lib'} = $target_user_fleshed->ws_ou;
3017         } else {
3018             $$form_data{'pickup_lib'} = $target_user_fleshed->home_ou;
3019         }
3020     }
3021     if (! defined $$form_data{'request_type'}) {
3022         $$form_data{'request_type'} = 1; # Books
3023     }
3024     my $aur_obj = new Fieldmapper::acq::user_request;
3025     $aur_obj->isnew(1);
3026     $aur_obj->usr( $$form_data{'usr'} );
3027     $aur_obj->request_date( 'now' );
3028     for my $field ( keys %$form_data ) {
3029         if (defined $$form_data{$field} and $field !~ /^(id|lineitem|eg_bib|request_date|cancel_reason)$/) {
3030             $aur_obj->$field( $$form_data{$field} );
3031         }
3032     }
3033
3034     $aur_obj = $e->create_acq_user_request($aur_obj) or return $e->die_event;
3035
3036     $e->commit and create_user_request_events( $e, [ $aur_obj ], 'aur.created' );
3037
3038     return $aur_obj;
3039 }
3040
3041 sub create_user_request_events {
3042     my($e, $user_reqs, $hook) = @_;
3043
3044     my $ses = OpenSRF::AppSession->create('open-ils.trigger');
3045     $ses->connect;
3046
3047     my %cached_usr_home_ou = ();
3048     for my $user_req (@$user_reqs) {
3049         my $home_ou = $cached_usr_home_ou{$user_req->usr};
3050         if (! $home_ou) {
3051             my $user = $e->retrieve_actor_user($user_req->usr) or return $e->die_event;
3052             $home_ou = $user->home_ou;
3053             $cached_usr_home_ou{$user_req->usr} = $home_ou;
3054         }
3055         my $req = $ses->request('open-ils.trigger.event.autocreate', $hook, $user_req, $home_ou);
3056         $req->recv;
3057     }
3058
3059     $ses->disconnect;
3060     return undef;
3061 }
3062
3063
3064 __PACKAGE__->register_method(
3065         method => "po_note_CUD_batch",
3066         api_name => "open-ils.acq.po_note.cud.batch",
3067     stream => 1,
3068         signature => {
3069         desc => q/Manage purchase order notes/,
3070         params => [
3071             {desc => "Authentication token", type => "string"},
3072             {desc => "List of po_notes to manage", type => "array"},
3073         ],
3074         return => {desc => "Stream of successfully managed objects"}
3075     }
3076 );
3077
3078 sub po_note_CUD_batch {
3079     my ($self, $conn, $auth, $notes) = @_;
3080
3081     my $e = new_editor("xact"=> 1, "authtoken" => $auth);
3082     return $e->die_event unless $e->checkauth;
3083     # XXX perms
3084
3085     my $total = @$notes;
3086     my $count = 0;
3087
3088     foreach my $note (@$notes) {
3089
3090         $note->editor($e->requestor->id);
3091         $note->edit_time("now");
3092
3093         if ($note->isnew) {
3094             $note->creator($e->requestor->id);
3095             $note = $e->create_acq_po_note($note) or return $e->die_event;
3096         } elsif ($note->isdeleted) {
3097             $e->delete_acq_po_note($note) or return $e->die_event;
3098         } elsif ($note->ischanged) {
3099             $e->update_acq_po_note($note) or return $e->die_event;
3100         }
3101
3102         unless ($note->isdeleted) {
3103             $note = $e->retrieve_acq_po_note($note->id) or
3104                 return $e->die_event;
3105         }
3106
3107         $conn->respond(
3108             {"maximum" => $total, "progress" => ++$count, "note" => $note}
3109         );
3110     }
3111
3112     $e->commit and $conn->respond_complete or return $e->die_event;
3113 }
3114
3115
3116 # retrieves a lineitem, fleshes its PO and PL, checks perms
3117 sub fetch_and_check_li {
3118     my $e = shift;
3119     my $li_id = shift;
3120     my $perm_mode = shift || 'read';
3121
3122     my $li = $e->retrieve_acq_lineitem([
3123         $li_id,
3124         {   flesh => 1,
3125             flesh_fields => {jub => ['purchase_order', 'picklist']}
3126         }
3127     ]) or return $e->die_event;
3128
3129     if(my $po = $li->purchase_order) {
3130         my $perms = ($perm_mode eq 'read') ? 'VIEW_PURCHASE_ORDER' : 'CREATE_PURCHASE_ORDER';
3131         return ($li, $e->die_event) unless $e->allowed($perms, $po->ordering_agency);
3132
3133     } elsif(my $pl = $li->picklist) {
3134         my $perms = ($perm_mode eq 'read') ? 'VIEW_PICKLIST' : 'CREATE_PICKLIST';
3135         return ($li, $e->die_event) unless $e->allowed($perms, $pl->org_unit);
3136     }
3137
3138     return ($li);
3139 }
3140
3141
3142 __PACKAGE__->register_method(
3143         method => "clone_distrib_form",
3144         api_name => "open-ils.acq.distribution_formula.clone",
3145     stream => 1,
3146         signature => {
3147         desc => q/Clone a distribution formula/,
3148         params => [
3149             {desc => "Authentication token", type => "string"},
3150             {desc => "Original formula ID", type => 'integer'},
3151             {desc => "Name of new formula", type => 'string'},
3152         ],
3153         return => {desc => "ID of newly created formula"}
3154     }
3155 );
3156
3157 sub clone_distrib_form {
3158     my($self, $client, $auth, $form_id, $new_name) = @_;
3159
3160     my $e = new_editor("xact"=> 1, "authtoken" => $auth);
3161     return $e->die_event unless $e->checkauth;
3162
3163     my $old_form = $e->retrieve_acq_distribution_formula($form_id) or return $e->die_event;
3164     return $e->die_event unless $e->allowed('ADMIN_ACQ_DISTRIB_FORMULA', $old_form->owner);
3165
3166     my $new_form = Fieldmapper::acq::distribution_formula->new;
3167
3168     $new_form->owner($old_form->owner);
3169     $new_form->name($new_name);
3170     $e->create_acq_distribution_formula($new_form) or return $e->die_event;
3171
3172     my $entries = $e->search_acq_distribution_formula_entry({formula => $form_id});
3173     for my $entry (@$entries) {
3174        my $new_entry = Fieldmapper::acq::distribution_formula_entry->new;
3175        $new_entry->$_($entry->$_()) for $entry->real_fields;
3176        $new_entry->formula($new_form->id);
3177        $new_entry->clear_id;
3178        $e->create_acq_distribution_formula_entry($new_entry) or return $e->die_event;
3179     }
3180
3181     $e->commit;
3182     return $new_form->id;
3183 }
3184
3185 __PACKAGE__->register_method(
3186         method => 'add_li_to_po',
3187         api_name        => 'open-ils.acq.purchase_order.add_lineitem',
3188         signature => {
3189         desc => q/Adds a lineitem to an existing purchase order/,
3190         params => [
3191             {desc => 'Authentication token', type => 'string'},
3192             {desc => 'The purchase order id', type => 'number'},
3193             {desc => 'The lineitem ID', type => 'number'},
3194         ],
3195         return => {desc => 'Streams a total versus completed counts object, event on error'}
3196     }
3197 );
3198
3199 sub add_li_to_po {
3200     my($self, $conn, $auth, $po_id, $li_id) = @_;
3201
3202     my $e = new_editor(authtoken => $auth, xact => 1);
3203     return $e->die_event unless $e->checkauth;
3204
3205     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
3206
3207     my $po = $e->retrieve_acq_purchase_order($po_id)
3208         or return $e->die_event;
3209
3210     my $li = $e->retrieve_acq_lineitem($li_id)
3211         or return $e->die_event;
3212
3213     return $e->die_event unless
3214         $e->allowed('CREATE_PURCHASE_ORDER', $po->ordering_agency);
3215
3216     unless ($po->state =~ /new|pending/) {
3217         $e->rollback;
3218         return {success => 0, po => $po, error => 'bad-po-state'};
3219     }
3220
3221     unless ($li->state =~ /new|order-ready|pending-order/) {
3222         $e->rollback;
3223         return {success => 0, li => $li, error => 'bad-li-state'};
3224     }
3225
3226     $li->purchase_order($po_id);
3227     $li->state('pending-order');
3228     update_lineitem($mgr, $li) or return $e->die_event;
3229
3230     $e->commit;
3231     return {success => 1};
3232 }
3233
3234 1;
3235