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