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

   1 package OpenILS::Application::Acq::BatchManager;
   2 use OpenSRF::AppSession;
   3 use OpenSRF::EX qw/:try/;
   4 use strict; use warnings;
   5
   6 sub new {
   7     my($class, %args) = @_;
   8     my $self = bless(\%args, $class);
   9     $self->{args} = {
  10         lid => 0,
  11         li => 0,
  12         copies => 0,
  13         bibs => 0,
  14         progress => 0,
  15         debits_accrued => 0,
  16         purchase_order => undef,
  17         picklist => undef,
  18         complete => 0,
  19         indexed => 0,
  20         total => 0
  21     };
  22     $self->{ingest_queue} = [];
  23     $self->{cache} = {};
  24     $self->throttle(5) unless $self->throttle;
  25     return $self;
  26 }
  27
  28 sub conn {
  29     my($self, $val) = @_;
  30     $self->{conn} = $val if $val;
  31     return $self->{conn};
  32 }
  33 sub throttle {
  34     my($self, $val) = @_;
  35     $self->{throttle} = $val if $val;
  36     return $self->{throttle};
  37 }
  38 sub respond {
  39     my($self, %other_args) = @_;
  40     if($self->throttle and not %other_args) {
  41         return unless (
  42             ($self->{args}->{progress} - $self->{last_respond_progress}) >= $self->throttle
  43         );
  44     }
  45     $self->conn->respond({ %{$self->{args}}, %other_args });
  46     $self->{last_respond_progress} = $self->{args}->{progress};
  47 }
  48 sub respond_complete {
  49     my($self, %other_args) = @_;
  50     $self->complete;
  51     $self->conn->respond_complete({ %{$self->{args}}, %other_args });
  52     return undef;
  53 }
  54 sub total {
  55     my($self, $val) = @_;
  56     $self->{args}->{total} = $val if defined $val;
  57     $self->{args}->{maximum} = $self->{args}->{total};
  58     return $self->{args}->{total};
  59 }
  60 sub purchase_order {
  61     my($self, $val) = @_;
  62     $self->{args}->{purchase_order} = $val if $val;
  63     return $self;
  64 }
  65 sub picklist {
  66     my($self, $val) = @_;
  67     $self->{args}->{picklist} = $val if $val;
  68     return $self;
  69 }
  70 sub add_lid {
  71     my $self = shift;
  72     $self->{args}->{lid} += 1;
  73     $self->{args}->{progress} += 1;
  74     return $self;
  75 }
  76 sub add_li {
  77     my $self = shift;
  78     $self->{args}->{li} += 1;
  79     $self->{args}->{progress} += 1;
  80     return $self;
  81 }
  82 sub add_copy {
  83     my $self = shift;
  84     $self->{args}->{copies} += 1;
  85     $self->{args}->{progress} += 1;
  86     return $self;
  87 }
  88 sub add_bib {
  89     my $self = shift;
  90     $self->{args}->{bibs} += 1;
  91     $self->{args}->{progress} += 1;
  92     return $self;
  93 }
  94 sub add_debit {
  95     my($self, $amount) = @_;
  96     $self->{args}->{debits_accrued} += $amount;
  97     $self->{args}->{progress} += 1;
  98     return $self;
  99 }
 100 sub editor {
 101     my($self, $editor) = @_;
 102     $self->{editor} = $editor if defined $editor;
 103     return $self->{editor};
 104 }
 105 sub complete {
 106     my $self = shift;
 107     $self->{args}->{complete} = 1;
 108     return $self;
 109 }
 110
 111 sub ingest_ses {
 112     my($self, $val) = @_;
 113     $self->{ingest_ses} = $val if $val;
 114     return $self->{ingest_ses};
 115 }
 116
 117 sub push_ingest_queue {
 118     my($self, $rec_id) = @_;
 119
 120     $self->ingest_ses(OpenSRF::AppSession->connect('open-ils.ingest'))
 121         unless $self->ingest_ses;
 122
 123     my $req = $self->ingest_ses->request('open-ils.ingest.full.biblio.record', $rec_id);
 124
 125     push(@{$self->{ingest_queue}}, $req);
 126 }
 127
 128 sub process_ingest_records {
 129     my $self = shift;
 130     return unless @{$self->{ingest_queue}};
 131
 132     for my $req (@{$self->{ingest_queue}}) {
 133
 134         try {
 135             $req->gather(1);
 136             $self->{args}->{indexed} += 1;
 137             $self->{args}->{progress} += 1;
 138         } otherwise {};
 139
 140         $self->respond;
 141     }
 142     $self->ingest_ses->disconnect;
 143 }
 144
 145
 146 sub cache {
 147     my($self, $org, $key, $val) = @_;
 148     $self->{cache}->{$org} = {} unless $self->{cache}->{org};
 149     $self->{cache}->{$org}->{$key} = $val if defined $val;
 150     return $self->{cache}->{$org}->{$key};
 151 }
 152
 153
 154 package OpenILS::Application::Acq::Order;
 155 use base qw/OpenILS::Application/;
 156 use strict; use warnings;
 157 # ----------------------------------------------------------------------------
 158 # Break up each component of the order process and pieces into managable
 159 # actions that can be shared across different workflows
 160 # ----------------------------------------------------------------------------
 161 use OpenILS::Event;
 162 use OpenSRF::Utils::Logger qw(:logger);
 163 use OpenSRF::Utils::JSON;
 164 use OpenILS::Utils::Fieldmapper;
 165 use OpenILS::Utils::CStoreEditor q/:funcs/;
 166 use OpenILS::Const qw/:const/;
 167 use OpenSRF::EX q/:try/;
 168 use OpenILS::Application::AppUtils;
 169 use OpenILS::Application::Cat::BibCommon;
 170 use OpenILS::Application::Cat::AssetCommon;
 171 use MARC::Record;
 172 use MARC::Batch;
 173 use MARC::File::XML;
 174 my $U = 'OpenILS::Application::AppUtils';
 175
 176
 177 # ----------------------------------------------------------------------------
 178 # Lineitem
 179 # ----------------------------------------------------------------------------
 180 sub create_lineitem {
 181     my($mgr, %args) = @_;
 182     my $li = Fieldmapper::acq::lineitem->new;
 183     $li->creator($mgr->editor->requestor->id);
 184     $li->selector($li->creator);
 185     $li->editor($li->creator);
 186     $li->create_time('now');
 187     $li->edit_time('now');
 188     $li->state('new');
 189     $li->$_($args{$_}) for keys %args;
 190     $li->clear_id;
 191     $mgr->add_li;
 192     return $mgr->editor->create_acq_lineitem($li);
 193 }
 194
 195 sub update_lineitem {
 196     my($mgr, $li) = @_;
 197     $li->edit_time('now');
 198     $li->editor($mgr->editor->requestor->id);
 199     $mgr->add_li;
 200     my $success = $mgr->editor->update_acq_lineitem($li);
 201
 202     if ($success) { # check for requests, create holds
 203         my $requests = $mgr->editor->search_acq_user_request(
 204             { lineitem => $li->id,
 205               '-or' =>
 206                 [ { need_before => {'>' => 'now'} },
 207                   { need_before => undef }
 208                 ]
 209             }
 210         );
 211
 212         for my $request ( @$requests ) {
 213
 214             $request->eg_bib( $li->eg_bib_id );
 215             $mgr->editor->update_acq_user_request( $request );
 216
 217             next unless ($U->is_true( $request->hold ));
 218
 219             my $hold = Fieldmapper::action::hold_request->new;
 220             $hold->usr( $request->usr );
 221             $hold->requestor( $request->usr );
 222             $hold->request_time( $request->request_date );
 223             $hold->pickup_lib( $request->pickup_lib );
 224             $hold->request_lib( $request->pickup_lib );
 225             $hold->selection_ou( $request->pickup_lib );
 226             $hold->phone_notify( $request->phone_notify );
 227             $hold->email_notify( $request->email_notify );
 228             $hold->expire_time( $request->need_before );
 229
 230             if ($request->holdable_formats) {
 231                 my $mrm = $mgr->editor->search_metabib_metarecord_source_map( { source => $li->eg_bib_id } )->[0];
 232                 if ($mrm) {
 233                     $hold->hold_type( 'M' );
 234                     $hold->holdable_formats( $request->holdable_formats );
 235                     $hold->target( $mrm->metarecord );
 236                 }
 237             }
 238
 239             if (!$hold->target) {
 240                 $hold->hold_type( 'T' );
 241                 $hold->target( $li->eg_bib_id );
 242             }
 243
 244             $mgr->editor->create_actor_hold_request( $hold );
 245         }
 246
 247         return $li;
 248     }
 249
 250     return undef;
 251 }
 252
 253 sub delete_lineitem {
 254     my($mgr, $li) = @_;
 255     $li = $mgr->editor->retrieve_acq_lineitem($li) unless ref $li;
 256
 257     # delete the attached lineitem_details
 258     my $lid_ids = $mgr->editor->search_acq_lineitem_detail({lineitem => $li->id}, {idlist=>1});
 259     for my $lid_id (@$lid_ids) {
 260         return 0 unless delete_lineitem_detail($mgr, $lid_id);
 261     }
 262
 263     $mgr->add_li;
 264     return $mgr->editor->delete_acq_lineitem($li);
 265 }
 266
 267 # begins and commit transactions as it goes
 268 sub create_lineitem_list_assets {
 269     my($mgr, $li_ids) = @_;
 270     return undef if check_import_li_marc_perms($mgr, $li_ids);
 271
 272     # create the bibs/volumes/copies and ingest the records
 273     for my $li_id (@$li_ids) {
 274         $mgr->editor->xact_begin;
 275         my $data = create_lineitem_assets($mgr, $li_id) or return undef;
 276         $mgr->editor->xact_commit;
 277         # XXX ingest is in-db now
 278         #$mgr->push_ingest_queue($data->{li}->eg_bib_id) if $data->{new_bib};
 279         $mgr->respond;
 280     }
 281     $mgr->process_ingest_records;
 282     return 1;
 283 }
 284
 285 # returns event on error, undef on success
 286 sub check_import_li_marc_perms {
 287     my($mgr, $li_ids) = @_;
 288
 289     # if there are any order records that are not linked to
 290     # in-db bib records, verify staff has perms to import order records
 291     my $order_li = $mgr->editor->search_acq_lineitem(
 292         [{id => $li_ids, eg_bib_id => undef}, {limit => 1}], {idlist => 1})->[0];
 293
 294     if($order_li) {
 295         return $mgr->editor->die_event unless
 296             $mgr->editor->allowed('IMPORT_ACQ_LINEITEM_BIB_RECORD');
 297     }
 298
 299     return undef;
 300 }
 301
 302
 303 # ----------------------------------------------------------------------------
 304 # if all of the lineitem details for this lineitem have
 305 # been received, mark the lineitem as received
 306 # returns 1 on non-received, li on received, 0 on error
 307 # ----------------------------------------------------------------------------
 308 sub check_lineitem_received {
 309     my($mgr, $li_id) = @_;
 310
 311     my $non_recv = $mgr->editor->search_acq_lineitem_detail(
 312         {recv_time => undef, lineitem => $li_id}, {idlist=>1});
 313
 314     return 1 if @$non_recv;
 315
 316     my $li = $mgr->editor->retrieve_acq_lineitem($li_id);
 317     $li->state('received');
 318     return update_lineitem($mgr, $li);
 319 }
 320
 321 sub receive_lineitem {
 322     my($mgr, $li_id, $skip_complete_check) = @_;
 323     my $li = $mgr->editor->retrieve_acq_lineitem($li_id) or return 0;
 324
 325     my $lid_ids = $mgr->editor->search_acq_lineitem_detail(
 326         {lineitem => $li_id, recv_time => undef}, {idlist => 1});
 327
 328     for my $lid_id (@$lid_ids) {
 329        receive_lineitem_detail($mgr, $lid_id, 1) or return 0;
 330     }
 331
 332     $mgr->add_li;
 333     $li->state('received');
 334     update_lineitem($mgr, $li) or return 0;
 335     return 1 if $skip_complete_check;
 336
 337     return check_purchase_order_received($mgr, $li->purchase_order);
 338 }
 339
 340 sub rollback_receive_lineitem {
 341     my($mgr, $li_id) = @_;
 342     my $li = $mgr->editor->retrieve_acq_lineitem($li_id) or return 0;
 343
 344     my $lid_ids = $mgr->editor->search_acq_lineitem_detail(
 345         {lineitem => $li_id, recv_time => {'!=' => undef}}, {idlist => 1});
 346
 347     for my $lid_id (@$lid_ids) {
 348        rollback_receive_lineitem_detail($mgr, $lid_id, 1) or return 0;
 349     }
 350
 351     $mgr->add_li;
 352     $li->state('on-order');
 353     return update_lineitem($mgr, $li);
 354 }
 355
 356 # ----------------------------------------------------------------------------
 357 # Lineitem Detail
 358 # ----------------------------------------------------------------------------
 359 sub create_lineitem_detail {
 360     my($mgr, %args) = @_;
 361     my $lid = Fieldmapper::acq::lineitem_detail->new;
 362     $lid->$_($args{$_}) for keys %args;
 363     $lid->clear_id;
 364     $mgr->add_lid;
 365     return $mgr->editor->create_acq_lineitem_detail($lid);
 366 }
 367
 368
 369 # flesh out any required data with default values where appropriate
 370 sub complete_lineitem_detail {
 371     my($mgr, $lid) = @_;
 372     unless($lid->barcode) {
 373         my $pfx = $U->ou_ancestor_setting_value($lid->owning_lib, 'acq.tmp_barcode_prefix') || 'ACQ';
 374         $lid->barcode($pfx.$lid->id);
 375     }
 376
 377     unless($lid->cn_label) {
 378         my $pfx = $U->ou_ancestor_setting_value($lid->owning_lib, 'acq.tmp_callnumber_prefix') || 'ACQ';
 379         $lid->cn_label($pfx.$lid->id);
 380     }
 381
 382     if(!$lid->location and my $loc = $U->ou_ancestor_setting_value($lid->owning_lib, 'acq.default_copy_location')) {
 383         $lid->location($loc);
 384     }
 385
 386     if(!$lid->circ_modifier and my $mod = get_default_circ_modifier($mgr, $lid->owning_lib)) {
 387         $lid->circ_modifier($mod);
 388     }
 389
 390     $mgr->editor->update_acq_lineitem_detail($lid) or return 0;
 391     return $lid;
 392 }
 393
 394 sub get_default_circ_modifier {
 395     my($mgr, $org) = @_;
 396     my $mod = $mgr->cache($org, 'def_circ_mod');
 397     return $mod if $mod;
 398     $mod = $U->ou_ancestor_setting_value($org, 'acq.default_circ_modifier');
 399     return $mgr->cache($org, 'def_circ_mod', $mod) if $mod;
 400     return undef;
 401 }
 402
 403 sub delete_lineitem_detail {
 404     my($mgr, $lid) = @_;
 405     $lid = $mgr->editor->retrieve_acq_lineitem_detail($lid) unless ref $lid;
 406     return $mgr->editor->delete_acq_lineitem_detail($lid);
 407 }
 408
 409
 410 sub receive_lineitem_detail {
 411     my($mgr, $lid_id, $skip_complete_check) = @_;
 412     my $e = $mgr->editor;
 413
 414     my $lid = $e->retrieve_acq_lineitem_detail([
 415         $lid_id,
 416         {   flesh => 1,
 417             flesh_fields => {
 418                 acqlid => ['fund_debit']
 419             }
 420         }
 421     ]) or return 0;
 422
 423     return 1 if $lid->recv_time;
 424
 425     $lid->recv_time('now');
 426     $e->update_acq_lineitem_detail($lid) or return 0;
 427
 428     my $copy = $e->retrieve_asset_copy($lid->eg_copy_id) or return 0;
 429     $copy->status(OILS_COPY_STATUS_IN_PROCESS);
 430     $copy->edit_date('now');
 431     $copy->editor($e->requestor->id);
 432     $e->update_asset_copy($copy) or return 0;
 433
 434     if($lid->fund_debit) {
 435         $lid->fund_debit->encumbrance('f');
 436         $e->update_acq_fund_debit($lid->fund_debit) or return 0;
 437     }
 438
 439     $mgr->add_lid;
 440
 441     return 1 if $skip_complete_check;
 442
 443     my $li = check_lineitem_received($mgr, $lid->lineitem) or return 0;
 444     return 1 if $li == 1; # li not received
 445
 446     return check_purchase_order_received($mgr, $li->purchase_order);
 447 }
 448
 449
 450 sub rollback_receive_lineitem_detail {
 451     my($mgr, $lid_id) = @_;
 452     my $e = $mgr->editor;
 453
 454     my $lid = $e->retrieve_acq_lineitem_detail([
 455         $lid_id,
 456         {   flesh => 1,
 457             flesh_fields => {
 458                 acqlid => ['fund_debit']
 459             }
 460         }
 461     ]) or return 0;
 462
 463     return 1 unless $lid->recv_time;
 464
 465     $lid->clear_recv_time;
 466     $e->update_acq_lineitem_detail($lid) or return 0;
 467
 468     my $copy = $e->retrieve_asset_copy($lid->eg_copy_id) or return 0;
 469     $copy->status(OILS_COPY_STATUS_ON_ORDER);
 470     $copy->edit_date('now');
 471     $copy->editor($e->requestor->id);
 472     $e->update_asset_copy($copy) or return 0;
 473
 474     if($lid->fund_debit) {
 475         $lid->fund_debit->encumbrance('t');
 476         $e->update_acq_fund_debit($lid->fund_debit) or return 0;
 477     }
 478
 479     $mgr->add_lid;
 480     return $lid;
 481 }
 482
 483 # ----------------------------------------------------------------------------
 484 # Lineitem Attr
 485 # ----------------------------------------------------------------------------
 486 sub set_lineitem_attr {
 487     my($mgr, %args) = @_;
 488     my $attr_type = $args{attr_type};
 489
 490     # first, see if it's already set.  May just need to overwrite it
 491     my $attr = $mgr->editor->search_acq_lineitem_attr({
 492         lineitem => $args{lineitem},
 493         attr_type => $args{attr_type},
 494         attr_name => $args{attr_name}
 495     })->[0];
 496
 497     if($attr) {
 498         $attr->attr_value($args{attr_value});
 499         return $attr if $mgr->editor->update_acq_lineitem_attr($attr);
 500         return undef;
 501
 502     } else {
 503
 504         $attr = Fieldmapper::acq::lineitem_attr->new;
 505         $attr->$_($args{$_}) for keys %args;
 506
 507         unless($attr->definition) {
 508             my $find = "search_acq_$attr_type";
 509             my $attr_def_id = $mgr->editor->$find({code => $attr->attr_name}, {idlist=>1})->[0] or return 0;
 510             $attr->definition($attr_def_id);
 511         }
 512         return $mgr->editor->create_acq_lineitem_attr($attr);
 513     }
 514 }
 515
 516 sub get_li_price {
 517     my $li = shift;
 518     my $attrs = $li->attributes;
 519     my ($marc_estimated, $local_estimated, $local_actual, $prov_estimated, $prov_actual);
 520
 521     for my $attr (@$attrs) {
 522         if($attr->attr_name eq 'estimated_price') {
 523             $local_estimated = $attr->attr_value
 524                 if $attr->attr_type eq 'lineitem_local_attr_definition';
 525             $prov_estimated = $attr->attr_value
 526                 if $attr->attr_type eq 'lineitem_prov_attr_definition';
 527             $marc_estimated = $attr->attr_value
 528                 if $attr->attr_type eq 'lineitem_marc_attr_definition';
 529
 530         } elsif($attr->attr_name eq 'actual_price') {
 531             $local_actual = $attr->attr_value
 532                 if $attr->attr_type eq 'lineitem_local_attr_definition';
 533             $prov_actual = $attr->attr_value
 534                 if $attr->attr_type eq 'lineitem_prov_attr_definition';
 535         }
 536     }
 537
 538     return ($local_actual, 1) if $local_actual;
 539     return ($prov_actual, 2) if $prov_actual;
 540     return ($local_estimated, 1) if $local_estimated;
 541     return ($prov_estimated, 2) if $prov_estimated;
 542     return ($marc_estimated, 3);
 543 }
 544
 545
 546 # ----------------------------------------------------------------------------
 547 # Lineitem Debits
 548 # ----------------------------------------------------------------------------
 549 sub create_lineitem_debits {
 550     my($mgr, $li, $price, $ptype) = @_;
 551
 552     ($price, $ptype) = get_li_price($li) unless $price;
 553
 554     unless($price) {
 555         $mgr->editor->event(OpenILS::Event->new('ACQ_LINEITEM_NO_PRICE', payload => $li->id));
 556         $mgr->editor->rollback;
 557         return 0;
 558     }
 559
 560     unless($li->provider) {
 561         $mgr->editor->event(OpenILS::Event->new('ACQ_LINEITEM_NO_PROVIDER', payload => $li->id));
 562         $mgr->editor->rollback;
 563         return 0;
 564     }
 565
 566     my $lid_ids = $mgr->editor->search_acq_lineitem_detail(
 567         {lineitem => $li->id},
 568         {idlist=>1}
 569     );
 570
 571     for my $lid_id (@$lid_ids) {
 572
 573         my $lid = $mgr->editor->retrieve_acq_lineitem_detail([
 574             $lid_id,
 575             {   flesh => 1,
 576                 flesh_fields => {acqlid => ['fund']}
 577             }
 578         ]);
 579
 580         create_lineitem_detail_debit($mgr, $li, $lid, $price, $ptype) or return 0;
 581     }
 582
 583     return 1;
 584 }
 585
 586
 587 # flesh li->provider
 588 # flesh lid->fund
 589 # ptype 1=local, 2=provider, 3=marc
 590 sub create_lineitem_detail_debit {
 591     my($mgr, $li, $lid, $price, $ptype) = @_;
 592
 593     unless(ref $li and ref $li->provider) {
 594        $li = $mgr->editor->retrieve_acq_lineitem([
 595             $li,
 596             {   flesh => 1,
 597                 flesh_fields => {jub => ['provider']},
 598             }
 599         ]);
 600     }
 601
 602     unless(ref $lid and ref $lid->fund) {
 603         $lid = $mgr->editor->retrieve_acq_lineitem_detail([
 604             $lid,
 605             {   flesh => 1,
 606                 flesh_fields => {acqlid => ['fund']}
 607             }
 608         ]);
 609     }
 610
 611     my $ctype = $lid->fund->currency_type;
 612     my $amount = $price;
 613
 614     if($ptype == 2) { # price from vendor
 615         $ctype = $li->provider->currency_type;
 616         $amount = currency_conversion($mgr, $ctype, $lid->fund->currency_type, $price);
 617     }
 618
 619     my $debit = create_fund_debit(
 620         $mgr,
 621         fund => $lid->fund->id,
 622         origin_amount => $price,
 623         origin_currency_type => $ctype,
 624         amount => $amount
 625     ) or return 0;
 626
 627     $lid->fund_debit($debit->id);
 628     $lid->fund($lid->fund->id);
 629     $mgr->editor->update_acq_lineitem_detail($lid) or return 0;
 630     return $debit;
 631 }
 632
 633
 634 # ----------------------------------------------------------------------------
 635 # Fund Debit
 636 # ----------------------------------------------------------------------------
 637 sub create_fund_debit {
 638     my($mgr, %args) = @_;
 639
 640     # Verify the fund is not being spent beyond the hard stop amount
 641     my $fund = $mgr->editor->retrieve_acq_fund($args{fund}) or return 0;
 642
 643     if($fund->balance_stop_percent) {
 644
 645         my $balance = $mgr->editor->search_acq_fund_combined_balance({fund => $fund->id})->[0];
 646         my $allocations = $mgr->editor->search_acq_fund_allocation_total({fund => $fund->id})->[0];
 647         $balance = ($balance) ? $balance->amount : 0;
 648         $allocations = ($allocations) ? $allocations->amount : 0;
 649
 650         if(
 651             $allocations == 0 || # if no allocations were ever made, assume we have hit the stop percent
 652             ( ( ( ($balance - $args{amount}) / $allocations ) * 100 ) < $fund->balance_stop_percent))
 653         {
 654                 $mgr->editor->event(OpenILS::Event->new(
 655                     'FUND_EXCEEDS_STOP_PERCENT',
 656                     payload => {fund => $fund->id, debit_amount => $args{amount}}
 657                 ));
 658                 return 0;
 659         }
 660     }
 661
 662     my $debit = Fieldmapper::acq::fund_debit->new;
 663     $debit->debit_type('purchase');
 664     $debit->encumbrance('t');
 665     $debit->$_($args{$_}) for keys %args;
 666     $debit->clear_id;
 667     $mgr->add_debit($debit->amount);
 668     return $mgr->editor->create_acq_fund_debit($debit);
 669 }
 670
 671 sub currency_conversion {
 672     my($mgr, $src_currency, $dest_currency, $amount) = @_;
 673     my $result = $mgr->editor->json_query(
 674         {from => ['acq.exchange_ratio', $src_currency, $dest_currency, $amount]});
 675     return $result->[0]->{'acq.exchange_ratio'};
 676 }
 677
 678
 679 # ----------------------------------------------------------------------------
 680 # Picklist
 681 # ----------------------------------------------------------------------------
 682 sub create_picklist {
 683     my($mgr, %args) = @_;
 684     my $picklist = Fieldmapper::acq::picklist->new;
 685     $picklist->creator($mgr->editor->requestor->id);
 686     $picklist->owner($picklist->creator);
 687     $picklist->editor($picklist->creator);
 688     $picklist->create_time('now');
 689     $picklist->edit_time('now');
 690     $picklist->org_unit($mgr->editor->requestor->ws_ou);
 691     $picklist->owner($mgr->editor->requestor->id);
 692     $picklist->$_($args{$_}) for keys %args;
 693     $picklist->clear_id;
 694     $mgr->picklist($picklist);
 695     return $mgr->editor->create_acq_picklist($picklist);
 696 }
 697
 698 sub update_picklist {
 699     my($mgr, $picklist) = @_;
 700     $picklist = $mgr->editor->retrieve_acq_picklist($picklist) unless ref $picklist;
 701     $picklist->edit_time('now');
 702     $picklist->editor($mgr->editor->requestor->id);
 703     $mgr->picklist($picklist);
 704     return $picklist if $mgr->editor->update_acq_picklist($picklist);
 705     return undef;
 706 }
 707
 708 sub delete_picklist {
 709     my($mgr, $picklist) = @_;
 710     $picklist = $mgr->editor->retrieve_acq_picklist($picklist) unless ref $picklist;
 711
 712     # delete all 'new' lineitems
 713     my $li_ids = $mgr->editor->search_acq_lineitem({picklist => $picklist->id, state => 'new'}, {idlist => 1});
 714     for my $li_id (@$li_ids) {
 715         my $li = $mgr->editor->retrieve_acq_lineitem($li_id);
 716         return 0 unless delete_lineitem($mgr, $li);
 717         $mgr->respond;
 718     }
 719
 720     # detach all non-'new' lineitems
 721     $li_ids = $mgr->editor->search_acq_lineitem({picklist => $picklist->id, state => {'!=' => 'new'}}, {idlist => 1});
 722     for my $li_id (@$li_ids) {
 723         my $li = $mgr->editor->retrieve_acq_lineitem($li_id);
 724         $li->clear_picklist;
 725         return 0 unless update_lineitem($mgr, $li);
 726         $mgr->respond;
 727     }
 728
 729     # remove any picklist-specific object perms
 730     my $ops = $mgr->editor->search_permission_usr_object_perm_map({object_type => 'acqpl', object_id => ''.$picklist->id});
 731     for my $op (@$ops) {
 732         return 0 unless $mgr->editor->delete_usr_object_perm_map($op);
 733     }
 734
 735     return $mgr->editor->delete_acq_picklist($picklist);
 736 }
 737
 738 # ----------------------------------------------------------------------------
 739 # Purchase Order
 740 # ----------------------------------------------------------------------------
 741 sub update_purchase_order {
 742     my($mgr, $po) = @_;
 743     $po = $mgr->editor->retrieve_acq_purchase_order($po) unless ref $po;
 744     $po->editor($mgr->editor->requestor->id);
 745     $po->edit_time('now');
 746     $mgr->purchase_order($po);
 747     return $po if $mgr->editor->update_acq_purchase_order($po);
 748     return undef;
 749 }
 750
 751 sub create_purchase_order {
 752     my($mgr, %args) = @_;
 753
 754     # verify the chosen provider is still active
 755     my $provider = $mgr->editor->retrieve_acq_provider($args{provider}) or return 0;
 756     unless($U->is_true($provider->active)) {
 757         $logger->error("provider is not active.  cannot create PO");
 758         $mgr->editor->event(OpenILS::Event->new('ACQ_PROVIDER_INACTIVE'));
 759         return 0;
 760     }
 761
 762     my $po = Fieldmapper::acq::purchase_order->new;
 763     $po->creator($mgr->editor->requestor->id);
 764     $po->editor($mgr->editor->requestor->id);
 765     $po->owner($mgr->editor->requestor->id);
 766     $po->edit_time('now');
 767     $po->create_time('now');
 768     $po->state('pending');
 769     $po->ordering_agency($mgr->editor->requestor->ws_ou);
 770     $po->$_($args{$_}) for keys %args;
 771     $po->clear_id;
 772     $mgr->purchase_order($po);
 773     return $mgr->editor->create_acq_purchase_order($po);
 774 }
 775
 776 # ----------------------------------------------------------------------------
 777 # if all of the lineitems for this PO are received,
 778 # mark the PO as received
 779 # ----------------------------------------------------------------------------
 780 sub check_purchase_order_received {
 781     my($mgr, $po_id) = @_;
 782
 783     my $non_recv_li = $mgr->editor->search_acq_lineitem(
 784         {   purchase_order => $po_id,
 785             state => {'!=' => 'received'}
 786         }, {idlist=>1});
 787
 788     return 1 if @$non_recv_li;
 789
 790     my $po = $mgr->editor->retrieve_acq_purchase_order($po_id);
 791     $po->state('received');
 792     return update_purchase_order($mgr, $po);
 793 }
 794
 795
 796 # ----------------------------------------------------------------------------
 797 # Bib, Callnumber, and Copy data
 798 # ----------------------------------------------------------------------------
 799
 800 sub create_lineitem_assets {
 801     my($mgr, $li_id) = @_;
 802     my $evt;
 803
 804     my $li = $mgr->editor->retrieve_acq_lineitem([
 805         $li_id,
 806         {   flesh => 1,
 807             flesh_fields => {jub => ['purchase_order', 'attributes']}
 808         }
 809     ]) or return 0;
 810
 811     # -----------------------------------------------------------------
 812     # first, create the bib record if necessary
 813     # -----------------------------------------------------------------
 814     my $new_bib = 0;
 815     unless($li->eg_bib_id) {
 816         create_bib($mgr, $li) or return 0;
 817         $new_bib = 1;
 818     }
 819
 820     my $li_details = $mgr->editor->search_acq_lineitem_detail({lineitem => $li_id}, {idlist=>1});
 821
 822     # -----------------------------------------------------------------
 823     # for each lineitem_detail, create the volume if necessary, create
 824     # a copy, and link them all together.
 825     # -----------------------------------------------------------------
 826     my $first_cn;
 827     for my $lid_id (@{$li_details}) {
 828
 829         my $lid = $mgr->editor->retrieve_acq_lineitem_detail($lid_id) or return 0;
 830         next if $lid->eg_copy_id;
 831
 832         # use the same callnumber label for all items within this lineitem
 833         $lid->cn_label($first_cn) if $first_cn and not $lid->cn_label;
 834
 835         # apply defaults if necessary
 836         return 0 unless complete_lineitem_detail($mgr, $lid);
 837
 838         $first_cn = $lid->cn_label unless $first_cn;
 839
 840         my $org = $lid->owning_lib;
 841         my $label = $lid->cn_label;
 842         my $bibid = $li->eg_bib_id;
 843
 844         my $volume = $mgr->cache($org, "cn.$bibid.$label");
 845         unless($volume) {
 846             $volume = create_volume($mgr, $li, $lid) or return 0;
 847             $mgr->cache($org, "cn.$bibid.$label", $volume);
 848         }
 849         create_copy($mgr, $volume, $lid) or return 0;
 850     }
 851
 852     return { li => $li, new_bib => $new_bib };
 853 }
 854
 855 sub create_bib {
 856     my($mgr, $li) = @_;
 857
 858     my $record = OpenILS::Application::Cat::BibCommon->biblio_record_xml_import(
 859         $mgr->editor,
 860         $li->marc,
 861         undef, # bib source
 862         undef,
 863         1, # override tcn collisions
 864     );
 865
 866     if($U->event_code($record)) {
 867         $mgr->editor->event($record);
 868         $mgr->editor->rollback;
 869         return 0;
 870     }
 871
 872     $li->eg_bib_id($record->id);
 873     $mgr->add_bib;
 874     return update_lineitem($mgr, $li);
 875 }
 876
 877 sub create_volume {
 878     my($mgr, $li, $lid) = @_;
 879
 880     my ($volume, $evt) =
 881         OpenILS::Application::Cat::AssetCommon->find_or_create_volume(
 882             $mgr->editor,
 883             $lid->cn_label,
 884             $li->eg_bib_id,
 885             $lid->owning_lib
 886         );
 887
 888     if($evt) {
 889         $mgr->editor->event($evt);
 890         return 0;
 891     }
 892
 893     return $volume;
 894 }
 895
 896 sub create_copy {
 897     my($mgr, $volume, $lid) = @_;
 898     my $copy = Fieldmapper::asset::copy->new;
 899     $copy->isnew(1);
 900     $copy->loan_duration(2);
 901     $copy->fine_level(2);
 902     $copy->status(OILS_COPY_STATUS_ON_ORDER);
 903     $copy->barcode($lid->barcode);
 904     $copy->location($lid->location);
 905     $copy->call_number($volume->id);
 906     $copy->circ_lib($volume->owning_lib);
 907     $copy->circ_modifier($lid->circ_modifier);
 908
 909     my $evt = OpenILS::Application::Cat::AssetCommon->create_copy($mgr->editor, $volume, $copy);
 910     if($evt) {
 911         $mgr->editor->event($evt);
 912         return 0;
 913     }
 914
 915     $mgr->add_copy;
 916     $lid->eg_copy_id($copy->id);
 917     $mgr->editor->update_acq_lineitem_detail($lid) or return 0;
 918 }
 919
 920
 921
 922
 923
 924
 925 # ----------------------------------------------------------------------------
 926 # Workflow: Build a selection list from a Z39.50 search
 927 # ----------------------------------------------------------------------------
 928
 929 __PACKAGE__->register_method(
 930         method => 'zsearch',
 931         api_name => 'open-ils.acq.picklist.search.z3950',
 932     stream => 1,
 933         signature => {
 934         desc => 'Performs a z3950 federated search and creates a picklist and associated lineitems',
 935         params => [
 936             {desc => 'Authentication token', type => 'string'},
 937             {desc => 'Search definition', type => 'object'},
 938             {desc => 'Picklist name, optional', type => 'string'},
 939         ]
 940     }
 941 );
 942
 943 sub zsearch {
 944     my($self, $conn, $auth, $search, $name, $options) = @_;
 945     my $e = new_editor(authtoken=>$auth);
 946     return $e->event unless $e->checkauth;
 947     return $e->event unless $e->allowed('CREATE_PICKLIST');
 948
 949     $search->{limit} ||= 10;
 950     $options ||= {};
 951
 952     my $ses = OpenSRF::AppSession->create('open-ils.search');
 953     my $req = $ses->request('open-ils.search.z3950.search_class', $auth, $search);
 954
 955     my $first = 1;
 956     my $picklist;
 957     my $mgr;
 958     while(my $resp = $req->recv(timeout=>60)) {
 959
 960         if($first) {
 961             my $e = new_editor(requestor=>$e->requestor, xact=>1);
 962             $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
 963             $picklist = zsearch_build_pl($mgr, $name);
 964             $first = 0;
 965         }
 966
 967         my $result = $resp->content;
 968         my $count = $result->{count};
 969         $mgr->total( (($count < $search->{limit}) ? $count : $search->{limit})+1 );
 970
 971         for my $rec (@{$result->{records}}) {
 972
 973             my $li = create_lineitem($mgr,
 974                 picklist => $picklist->id,
 975                 source_label => $result->{service},
 976                 marc => $rec->{marcxml},
 977                 eg_bib_id => $rec->{bibid}
 978             );
 979
 980             if($$options{respond_li}) {
 981                 $li->attributes($mgr->editor->search_acq_lineitem_attr({lineitem => $li->id}))
 982                     if $$options{flesh_attrs};
 983                 $li->clear_marc if $$options{clear_marc};
 984                 $mgr->respond(lineitem => $li);
 985             } else {
 986                 $mgr->respond;
 987             }
 988         }
 989     }
 990
 991     $mgr->editor->commit;
 992     return $mgr->respond_complete;
 993 }
 994
 995 sub zsearch_build_pl {
 996     my($mgr, $name) = @_;
 997     $name ||= '';
 998
 999     my $picklist = $mgr->editor->search_acq_picklist({
1000         owner => $mgr->editor->requestor->id,
1001         name => $name
1002     })->[0];
1003
1004     if($name eq '' and $picklist) {
1005         return 0 unless delete_picklist($mgr, $picklist);
1006         $picklist = undef;
1007     }
1008
1009     return update_picklist($mgr, $picklist) if $picklist;
1010     return create_picklist($mgr, name => $name);
1011 }
1012
1013
1014 # ----------------------------------------------------------------------------
1015 # Workflow: Build a selection list / PO by importing a batch of MARC records
1016 # ----------------------------------------------------------------------------
1017
1018 __PACKAGE__->register_method(
1019     method => 'upload_records',
1020     api_name => 'open-ils.acq.process_upload_records',
1021     stream => 1,
1022 );
1023
1024 sub upload_records {
1025     my($self, $conn, $auth, $key) = @_;
1026
1027         my $e = new_editor(authtoken => $auth, xact => 1);
1028     return $e->die_event unless $e->checkauth;
1029     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1030
1031     my $cache = OpenSRF::Utils::Cache->new;
1032
1033     my $data = $cache->get_cache("vandelay_import_spool_$key");
1034         my $purpose = $data->{purpose};
1035     my $filename = $data->{path};
1036     my $provider = $data->{provider};
1037     my $picklist = $data->{picklist};
1038     my $create_po = $data->{create_po};
1039     my $ordering_agency = $data->{ordering_agency};
1040     my $create_assets = $data->{create_assets};
1041     my $po;
1042     my $evt;
1043
1044     unless(-r $filename) {
1045         $logger->error("unable to read MARC file $filename");
1046         $e->rollback;
1047         return OpenILS::Event->new('FILE_UPLOAD_ERROR', payload => {filename => $filename});
1048     }
1049
1050     $provider = $e->retrieve_acq_provider($provider) or return $e->die_event;
1051
1052     if($picklist) {
1053         $picklist = $e->retrieve_acq_picklist($picklist) or return $e->die_event;
1054         if($picklist->owner != $e->requestor->id) {
1055             return $e->die_event unless
1056                 $e->allowed('CREATE_PICKLIST', $picklist->org_unit, $picklist);
1057         }
1058         $mgr->picklist($picklist);
1059     }
1060
1061     if($create_po) {
1062
1063         $po = create_purchase_order($mgr,
1064             ordering_agency => $ordering_agency,
1065             provider => $provider->id,
1066             state => 'on-order'
1067         ) or return $mgr->editor->die_event;
1068     }
1069
1070     $logger->info("acq processing MARC file=$filename");
1071
1072     my $marctype = 'USMARC'; # ?
1073         my $batch = new MARC::Batch ($marctype, $filename);
1074         $batch->strict_off;
1075
1076         my $count = 0;
1077     my @li_list;
1078
1079         while(1) {
1080
1081             my $err;
1082         my $xml;
1083                 $count++;
1084         my $r;
1085
1086                 try {
1087             $r = $batch->next;
1088         } catch Error with {
1089             $err = shift;
1090                         $logger->warn("Proccessing of record $count in set $key failed with error $err.  Skipping this record");
1091         };
1092
1093         next if $err;
1094         last unless $r;
1095
1096                 try {
1097             ($xml = $r->as_xml_record()) =~ s/\n//sog;
1098             $xml =~ s/^<\?xml.+\?\s*>//go;
1099             $xml =~ s/>\s+</></go;
1100             $xml =~ s/\p{Cc}//go;
1101             $xml = $U->entityize($xml);
1102             $xml =~ s/[\x00-\x1f]//go;
1103
1104                 } catch Error with {
1105                         $err = shift;
1106                         $logger->warn("Proccessing XML of record $count in set $key failed with error $err.  Skipping this record");
1107                 };
1108
1109         next if $err or not $xml;
1110
1111         my %args = (
1112             source_label => $provider->code,
1113             provider => $provider->id,
1114             marc => $xml,
1115         );
1116
1117         $args{picklist} = $picklist->id if $picklist;
1118         if($po) {
1119             $args{purchase_order} = $po->id;
1120             $args{state} = 'on-order';
1121         }
1122
1123         my $li = create_lineitem($mgr, %args) or return $mgr->editor->die_event;
1124         $mgr->respond;
1125         $li->provider($provider); # flesh it, we'll need it later
1126
1127         import_lineitem_details($mgr, $ordering_agency, $li) or return $mgr->editor->die_event;
1128         $mgr->respond;
1129
1130         push(@li_list, $li->id);
1131         $mgr->respond;
1132         }
1133
1134         $e->commit;
1135     unlink($filename);
1136     $cache->delete_cache('vandelay_import_spool_' . $key);
1137
1138     if($create_assets) {
1139         create_lineitem_list_assets($mgr, \@li_list) or return $e->die_event;
1140     }
1141
1142     return $mgr->respond_complete;
1143 }
1144
1145 sub import_lineitem_details {
1146     my($mgr, $ordering_agency, $li) = @_;
1147
1148     my $holdings = $mgr->editor->json_query({from => ['acq.extract_provider_holding_data', $li->id]});
1149     return 1 unless @$holdings;
1150     my $org_path = $U->get_org_ancestors($ordering_agency);
1151     $org_path = [ reverse (@$org_path) ];
1152     my $price;
1153
1154     my $idx = 1;
1155     while(1) {
1156         # create a lineitem detail for each copy in the data
1157
1158         my $compiled = extract_lineitem_detail_data($mgr, $org_path, $holdings, $idx);
1159         last unless defined $compiled;
1160         return 0 unless $compiled;
1161
1162         # this takes the price of the last copy and uses it as the lineitem price
1163         # need to determine if a given record would include different prices for the same item
1164         $price = $$compiled{price};
1165
1166         for(1..$$compiled{quantity}) {
1167             my $lid = create_lineitem_detail($mgr,
1168                 lineitem => $li->id,
1169                 owning_lib => $$compiled{owning_lib},
1170                 cn_label => $$compiled{call_number},
1171                 fund => $$compiled{fund},
1172                 circ_modifier => $$compiled{circ_modifier},
1173                 note => $$compiled{note},
1174                 location => $$compiled{copy_location},
1175                 collection_code => $$compiled{collection_code}
1176             ) or return 0;
1177         }
1178
1179         $mgr->respond;
1180         $idx++;
1181     }
1182
1183     # set the price attr so we'll know the source of the price
1184     set_lineitem_attr(
1185         $mgr,
1186         attr_name => 'estimated_price',
1187         attr_type => 'lineitem_local_attr_definition',
1188         attr_value => $price,
1189         lineitem => $li->id
1190     ) or return 0;
1191
1192     # if we're creating a purchase order, create the debits
1193     if($li->purchase_order) {
1194         create_lineitem_debits($mgr, $li, $price, 2) or return 0;
1195         $mgr->respond;
1196     }
1197
1198     return 1;
1199 }
1200
1201 # return hash on success, 0 on error, undef on no more holdings
1202 sub extract_lineitem_detail_data {
1203     my($mgr, $org_path, $holdings, $index) = @_;
1204
1205     my @data_list = grep { $_->{holding} eq $index } @$holdings;
1206     return undef unless @data_list;
1207
1208     my %compiled = map { $_->{attr} => $_->{data} } @data_list;
1209     my $base_org = $$org_path[0];
1210
1211     my $killme = sub {
1212         my $msg = shift;
1213         $logger->error("Item import extraction error: $msg");
1214         $logger->error('Holdings Data: ' . OpenSRF::Utils::JSON->perl2JSON(\%compiled));
1215         $mgr->editor->rollback;
1216         $mgr->editor->event(OpenILS::Event->new('ACQ_IMPORT_ERROR', payload => $msg));
1217         return 0;
1218     };
1219
1220     $compiled{quantity} ||= 1;
1221
1222     # ---------------------------------------------------------------------
1223     # Fund
1224     my $code = $compiled{fund_code};
1225     return $killme->('no fund code provided') unless $code;
1226
1227     my $fund = $mgr->cache($base_org, "fund.$code");
1228     unless($fund) {
1229         # search up the org tree for the most appropriate fund
1230         for my $org (@$org_path) {
1231             $fund = $mgr->editor->search_acq_fund(
1232                 {org => $org, code => $code, year => DateTime->now->year}, {idlist => 1})->[0];
1233             last if $fund;
1234         }
1235     }
1236     return $killme->("no fund with code $code at orgs [@$org_path]") unless $fund;
1237     $compiled{fund} = $fund;
1238     $mgr->cache($base_org, "fund.$code", $fund);
1239
1240
1241     # ---------------------------------------------------------------------
1242     # Owning lib
1243     my $sn = $compiled{owning_lib};
1244     return $killme->('no owning_lib defined') unless $sn;
1245     my $org_id =
1246         $mgr->cache($base_org, "orgsn.$sn") ||
1247             $mgr->editor->search_actor_org_unit({shortname => $sn}, {idlist => 1})->[0];
1248     return $killme->("invalid owning_lib defined: $sn") unless $org_id;
1249     $compiled{owning_lib} = $org_id;
1250     $mgr->cache($$org_path[0], "orgsn.$sn", $org_id);
1251
1252
1253     # ---------------------------------------------------------------------
1254     # Circ Modifier
1255     my $mod;
1256     $code = $compiled{circ_modifier};
1257
1258     if($code) {
1259
1260         $mod = $mgr->cache($base_org, "mod.$code") ||
1261             $mgr->editor->retrieve_config_circ_modifier($code);
1262         return $killme->("invlalid circ_modifier $code") unless $mod;
1263         $mgr->cache($base_org, "mod.$code", $mod);
1264
1265     } else {
1266         # try the default
1267         $mod = get_default_circ_modifier($mgr, $base_org)
1268             or return $killme->('no circ_modifier defined');
1269     }
1270
1271     $compiled{circ_modifier} = $mod;
1272
1273
1274     # ---------------------------------------------------------------------
1275     # Shelving Location
1276     my $name = $compiled{copy_location};
1277     if($name) {
1278         my $loc = $mgr->cache($base_org, "copy_loc.$name");
1279         unless($loc) {
1280             for my $org (@$org_path) {
1281                 $loc = $mgr->editor->search_asset_copy_location(
1282                     {owning_lib => $org, name => $name}, {idlist => 1})->[0];
1283                 last if $loc;
1284             }
1285         }
1286         return $killme->("Invalid copy location $name") unless $loc;
1287         $compiled{copy_location} = $loc;
1288         $mgr->cache($base_org, "copy_loc.$name", $loc);
1289     }
1290
1291     return \%compiled;
1292 }
1293
1294
1295
1296 # ----------------------------------------------------------------------------
1297 # Workflow: Given an existing purchase order, import/create the bibs,
1298 # callnumber and copy objects
1299 # ----------------------------------------------------------------------------
1300
1301 __PACKAGE__->register_method(
1302         method => 'create_po_assets',
1303         api_name        => 'open-ils.acq.purchase_order.assets.create',
1304         signature => {
1305         desc => q/Creates assets for each lineitem in the purchase order/,
1306         params => [
1307             {desc => 'Authentication token', type => 'string'},
1308             {desc => 'The purchase order id', type => 'number'},
1309         ],
1310         return => {desc => 'Streams a total versus completed counts object, event on error'}
1311     }
1312 );
1313
1314 sub create_po_assets {
1315     my($self, $conn, $auth, $po_id) = @_;
1316
1317     my $e = new_editor(authtoken=>$auth, xact=>1);
1318     return $e->die_event unless $e->checkauth;
1319     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1320
1321     my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->die_event;
1322
1323     my $li_ids = $e->search_acq_lineitem({purchase_order => $po_id}, {idlist => 1});
1324
1325     # it's ugly, but it's fast.  Get the total count of lineitem detail objects to process
1326     my $lid_total = $e->json_query({
1327         select => { acqlid => [{aggregate => 1, transform => 'count', column => 'id'}] },
1328         from => {
1329             acqlid => {
1330                 jub => {
1331                     fkey => 'lineitem',
1332                     field => 'id',
1333                     join => {acqpo => {fkey => 'purchase_order', field => 'id'}}
1334                 }
1335             }
1336         },
1337         where => {'+acqpo' => {id => $po_id}}
1338     })->[0]->{id};
1339
1340     $mgr->total(scalar(@$li_ids) + $lid_total);
1341
1342     create_lineitem_list_assets($mgr, $li_ids) or return $e->die_event;
1343
1344     $e->xact_begin;
1345     update_purchase_order($mgr, $po) or return $e->die_event;
1346     $e->commit;
1347
1348     return $mgr->respond_complete;
1349 }
1350
1351
1352
1353 __PACKAGE__->register_method(
1354         method => 'create_purchase_order_api',
1355         api_name        => 'open-ils.acq.purchase_order.create',
1356         signature => {
1357         desc => 'Creates a new purchase order',
1358         params => [
1359             {desc => 'Authentication token', type => 'string'},
1360             {desc => 'purchase_order to create', type => 'object'}
1361         ],
1362         return => {desc => 'The purchase order id, Event on failure'}
1363     }
1364 );
1365
1366 sub create_purchase_order_api {
1367     my($self, $conn, $auth, $po, $args) = @_;
1368     $args ||= {};
1369
1370     my $e = new_editor(xact=>1, authtoken=>$auth);
1371     return $e->die_event unless $e->checkauth;
1372     return $e->die_event unless $e->allowed('CREATE_PURCHASE_ORDER', $po->ordering_agency);
1373     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1374
1375     # create the PO
1376     my %pargs = (ordering_agency => $e->requestor->ws_ou); # default
1377     $pargs{provider} = $po->provider if $po->provider;
1378     $pargs{ordering_agency} = $po->ordering_agency if $po->ordering_agency;
1379     $po = create_purchase_order($mgr, %pargs) or return $e->die_event;
1380
1381     my $li_ids = $$args{lineitems};
1382
1383     if($li_ids) {
1384
1385         for my $li_id (@$li_ids) {
1386
1387             my $li = $e->retrieve_acq_lineitem([
1388                 $li_id,
1389                 {flesh => 1, flesh_fields => {jub => ['attributes']}}
1390             ]) or return $e->die_event;
1391
1392             $li->provider($po->provider);
1393             $li->purchase_order($po->id);
1394             $li->state('pending-order');
1395             update_lineitem($mgr, $li) or return $e->die_event;
1396             $mgr->respond;
1397
1398             create_lineitem_debits($mgr, $li) or return $e->die_event;
1399         }
1400     }
1401
1402     # commit before starting the asset creation
1403     $e->xact_commit;
1404
1405     if($li_ids and $$args{create_assets}) {
1406         create_lineitem_list_assets($mgr, $li_ids) or return $e->die_event;
1407     }
1408
1409     return $mgr->respond_complete;
1410 }
1411
1412
1413 __PACKAGE__->register_method(
1414         method => 'lineitem_detail_CUD_batch',
1415         api_name => 'open-ils.acq.lineitem_detail.cud.batch',
1416     stream => 1,
1417         signature => {
1418         desc => q/Creates a new purchase order line item detail.
1419             Additionally creates the associated fund_debit/,
1420         params => [
1421             {desc => 'Authentication token', type => 'string'},
1422             {desc => 'List of lineitem_details to create', type => 'array'},
1423         ],
1424         return => {desc => 'Streaming response of current position in the array'}
1425     }
1426 );
1427
1428 sub lineitem_detail_CUD_batch {
1429     my($self, $conn, $auth, $li_details) = @_;
1430
1431     my $e = new_editor(xact=>1, authtoken=>$auth);
1432     return $e->die_event unless $e->checkauth;
1433     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1434
1435     # XXX perms
1436
1437     $mgr->total(scalar(@$li_details));
1438
1439     my %li_cache;
1440
1441     for my $lid (@$li_details) {
1442
1443         my $li = $li_cache{$lid->lineitem} || $e->retrieve_acq_lineitem($lid->lineitem);
1444
1445         if($lid->isnew) {
1446             create_lineitem_detail($mgr, %{$lid->to_bare_hash}) or return $e->die_event;
1447
1448         } elsif($lid->ischanged) {
1449             $e->update_acq_lineitem_detail($lid) or return $e->die_event;
1450
1451         } elsif($lid->isdeleted) {
1452             delete_lineitem_detail($mgr, $lid) or return $e->die_event;
1453         }
1454
1455         $mgr->respond(li => $li);
1456         $li_cache{$lid->lineitem} = $li;
1457     }
1458
1459     $e->commit;
1460     return $mgr->respond_complete;
1461 }
1462
1463
1464 __PACKAGE__->register_method(
1465         method => 'receive_po_api',
1466         api_name        => 'open-ils.acq.purchase_order.receive'
1467 );
1468
1469 sub receive_po_api {
1470     my($self, $conn, $auth, $po_id) = @_;
1471     my $e = new_editor(xact => 1, authtoken => $auth);
1472     return $e->die_event unless $e->checkauth;
1473     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1474
1475     my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->die_event;
1476     return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency);
1477
1478     my $li_ids = $e->search_acq_lineitem({purchase_order => $po_id}, {idlist => 1});
1479
1480     for my $li_id (@$li_ids) {
1481         receive_lineitem($mgr, $li_id) or return $e->die_event;
1482         $mgr->respond;
1483     }
1484
1485     $po->state('received');
1486     update_purchase_order($mgr, $po) or return $e->die_event;
1487
1488     $e->commit;
1489     return $mgr->respond_complete;
1490 }
1491
1492
1493 __PACKAGE__->register_method(
1494         method => 'receive_lineitem_detail_api',
1495         api_name        => 'open-ils.acq.lineitem_detail.receive',
1496         signature => {
1497         desc => 'Mark a lineitem_detail as received',
1498         params => [
1499             {desc => 'Authentication token', type => 'string'},
1500             {desc => 'lineitem detail ID', type => 'number'}
1501         ],
1502         return => {desc => '1 on success, Event on error'}
1503     }
1504 );
1505
1506 sub receive_lineitem_detail_api {
1507     my($self, $conn, $auth, $lid_id) = @_;
1508
1509     my $e = new_editor(xact=>1, authtoken=>$auth);
1510     return $e->die_event unless $e->checkauth;
1511     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1512
1513     my $lid = $e->retrieve_acq_lineitem_detail([
1514         $lid_id, {
1515             flesh => 2,
1516             flesh_fields => {
1517                 acqlid => ['lineitem'],
1518                 jub => ['purchase_order']
1519             }
1520         }
1521     ]);
1522
1523     return $e->die_event unless $e->allowed(
1524         'RECEIVE_PURCHASE_ORDER', $lid->lineitem->purchase_order->ordering_agency);
1525
1526     receive_lineitem_detail($mgr, $lid_id) or return $e->die_event;
1527     $e->commit;
1528     return 1;
1529 }
1530
1531 __PACKAGE__->register_method(
1532         method => 'receive_lineitem_api',
1533         api_name        => 'open-ils.acq.lineitem.receive',
1534         signature => {
1535         desc => 'Mark a lineitem as received',
1536         params => [
1537             {desc => 'Authentication token', type => 'string'},
1538             {desc => 'lineitem detail ID', type => 'number'}
1539         ],
1540         return => {desc => '1 on success, Event on error'}
1541     }
1542 );
1543
1544 sub receive_lineitem_api {
1545     my($self, $conn, $auth, $li_id) = @_;
1546
1547     my $e = new_editor(xact=>1, authtoken=>$auth);
1548     return $e->die_event unless $e->checkauth;
1549     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1550
1551     my $li = $e->retrieve_acq_lineitem([
1552         $li_id, {
1553             flesh => 1,
1554             flesh_fields => {
1555                 jub => ['purchase_order']
1556             }
1557         }
1558     ]) or return $e->die_event;
1559
1560     return $e->die_event unless $e->allowed(
1561         'RECEIVE_PURCHASE_ORDER', $li->purchase_order->ordering_agency);
1562
1563     receive_lineitem($mgr, $li_id) or return $e->die_event;
1564     $e->commit;
1565     return 1;
1566 }
1567
1568
1569 __PACKAGE__->register_method(
1570         method => 'rollback_receive_po_api',
1571         api_name        => 'open-ils.acq.purchase_order.receive.rollback'
1572 );
1573
1574 sub rollback_receive_po_api {
1575     my($self, $conn, $auth, $po_id) = @_;
1576     my $e = new_editor(xact => 1, authtoken => $auth);
1577     return $e->die_event unless $e->checkauth;
1578     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1579
1580     my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->die_event;
1581     return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency);
1582
1583     my $li_ids = $e->search_acq_lineitem({purchase_order => $po_id}, {idlist => 1});
1584
1585     for my $li_id (@$li_ids) {
1586         rollback_receive_lineitem($mgr, $li_id) or return $e->die_event;
1587         $mgr->respond;
1588     }
1589
1590     $po->state('on-order');
1591     update_purchase_order($mgr, $po) or return $e->die_event;
1592
1593     $e->commit;
1594     return $mgr->respond_complete;
1595 }
1596
1597
1598 __PACKAGE__->register_method(
1599         method => 'rollback_receive_lineitem_detail_api',
1600         api_name        => 'open-ils.acq.lineitem_detail.receive.rollback',
1601         signature => {
1602         desc => 'Mark a lineitem_detail as received',
1603         params => [
1604             {desc => 'Authentication token', type => 'string'},
1605             {desc => 'lineitem detail ID', type => 'number'}
1606         ],
1607         return => {desc => '1 on success, Event on error'}
1608     }
1609 );
1610
1611 sub rollback_receive_lineitem_detail_api {
1612     my($self, $conn, $auth, $lid_id) = @_;
1613
1614     my $e = new_editor(xact=>1, authtoken=>$auth);
1615     return $e->die_event unless $e->checkauth;
1616     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1617
1618     my $lid = $e->retrieve_acq_lineitem_detail([
1619         $lid_id, {
1620             flesh => 2,
1621             flesh_fields => {
1622                 acqlid => ['lineitem'],
1623                 jub => ['purchase_order']
1624             }
1625         }
1626     ]);
1627     my $li = $lid->lineitem;
1628     my $po = $li->purchase_order;
1629
1630     return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency);
1631     rollback_receive_lineitem_detail($mgr, $lid_id) or return $e->die_event;
1632
1633     $li->state('on-order');
1634     $po->state('on-order');
1635     udpate_lineitem($mgr, $li) or return $e->die_event;
1636     udpate_purchase_order($mgr, $po) or return $e->die_event;
1637
1638     $e->commit;
1639     return 1;
1640 }
1641
1642 __PACKAGE__->register_method(
1643         method => 'rollback_receive_lineitem_api',
1644         api_name        => 'open-ils.acq.lineitem.receive.rollback',
1645         signature => {
1646         desc => 'Mark a lineitem as received',
1647         params => [
1648             {desc => 'Authentication token', type => 'string'},
1649             {desc => 'lineitem detail ID', type => 'number'}
1650         ],
1651         return => {desc => '1 on success, Event on error'}
1652     }
1653 );
1654
1655 sub rollback_receive_lineitem_api {
1656     my($self, $conn, $auth, $li_id) = @_;
1657
1658     my $e = new_editor(xact=>1, authtoken=>$auth);
1659     return $e->die_event unless $e->checkauth;
1660     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1661
1662     my $li = $e->retrieve_acq_lineitem_detail([
1663         $li_id, {
1664             flesh => 1,
1665             flesh_fields => {
1666                 jub => ['purchase_order']
1667             }
1668         }
1669     ]);
1670     my $po = $li->purchase_order;
1671
1672     return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency);
1673
1674     rollback_receive_lineitem($mgr, $li_id) or return $e->die_event;
1675
1676     $po->state('on-order');
1677     update_purchase_order($mgr, $po) or return $e->die_event;
1678
1679     $e->commit;
1680     return 1;
1681 }
1682
1683
1684 __PACKAGE__->register_method(
1685         method => 'set_lineitem_price_api',
1686         api_name        => 'open-ils.acq.lineitem.price.set',
1687         signature => {
1688         desc => 'Set lineitem price.  If debits already exist, update them as well',
1689         params => [
1690             {desc => 'Authentication token', type => 'string'},
1691             {desc => 'lineitem ID', type => 'number'}
1692         ],
1693         return => {desc => 'status blob, Event on error'}
1694     }
1695 );
1696
1697 sub set_lineitem_price_api {
1698     my($self, $conn, $auth, $li_id, $price, $currency) = @_;
1699
1700     my $e = new_editor(xact=>1, authtoken=>$auth);
1701     return $e->die_event unless $e->checkauth;
1702     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1703
1704     # XXX perms
1705
1706     my $li = $e->retrieve_acq_lineitem($li_id) or return $e->die_event;
1707
1708     # update the local attr for estimated price
1709     set_lineitem_attr(
1710         $mgr,
1711         attr_name => 'estimated_price',
1712         attr_type => 'lineitem_local_attr_definition',
1713         attr_value => $price,
1714         lineitem => $li_id
1715     ) or return $e->die_event;
1716
1717     my $lid_ids = $e->search_acq_lineitem_detail(
1718         {lineitem => $li_id, fund_debit => {'!=' => undef}},
1719         {idlist => 1}
1720     );
1721
1722     for my $lid_id (@$lid_ids) {
1723
1724         my $lid = $e->retrieve_acq_lineitem_detail([
1725             $lid_id, {
1726             flesh => 1, flesh_fields => {acqlid => ['fund', 'fund_debit']}}
1727         ]);
1728
1729         # onless otherwise specified, assume currency of new price is same as currency type of the fund
1730         $currency ||= $lid->fund->currency_type;
1731         my $amount = $price;
1732
1733         if($lid->fund->currency_type ne $currency) {
1734             $amount = currency_conversion($mgr, $currency, $lid->fund->currency_type, $price);
1735         }
1736
1737         $lid->fund_debit->origin_currency_type($currency);
1738         $lid->fund_debit->origin_amount($price);
1739         $lid->fund_debit->amount($amount);
1740
1741         $e->update_acq_fund_debit($lid->fund_debit) or return $e->die_event;
1742         $mgr->add_lid;
1743         $mgr->respond;
1744     }
1745
1746     $e->commit;
1747     return $mgr->respond_complete;
1748 }
1749
1750
1751 __PACKAGE__->register_method(
1752         method => 'clone_picklist_api',
1753         api_name        => 'open-ils.acq.picklist.clone',
1754         signature => {
1755         desc => 'Clones a picklist, including lineitem and lineitem details',
1756         params => [
1757             {desc => 'Authentication token', type => 'string'},
1758             {desc => 'Picklist ID', type => 'number'},
1759             {desc => 'New Picklist Name', type => 'string'}
1760         ],
1761         return => {desc => 'status blob, Event on error'}
1762     }
1763 );
1764
1765 sub clone_picklist_api {
1766     my($self, $conn, $auth, $pl_id, $name) = @_;
1767
1768     my $e = new_editor(xact=>1, authtoken=>$auth);
1769     return $e->die_event unless $e->checkauth;
1770     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1771
1772     my $old_pl = $e->retrieve_acq_picklist($pl_id);
1773     my $new_pl = create_picklist($mgr, %{$old_pl->to_bare_hash}, name => $name) or return $e->die_event;
1774
1775     my $li_ids = $e->search_acq_lineitem({picklist => $pl_id}, {idlist => 1});
1776
1777     for my $li_id (@$li_ids) {
1778
1779         # copy the lineitems
1780         my $li = $e->retrieve_acq_lineitem($li_id);
1781         my $new_li = create_lineitem($mgr, %{$li->to_bare_hash}, picklist => $new_pl->id) or return $e->die_event;
1782
1783         my $lid_ids = $e->search_acq_lineitem_detail({lineitem => $li_id}, {idlist => 1});
1784         for my $lid_id (@$lid_ids) {
1785
1786             # copy the lineitem details
1787             my $lid = $e->retrieve_acq_lineitem_detail($lid_id);
1788             create_lineitem_detail($mgr, %{$lid->to_bare_hash}, lineitem => $new_li->id) or return $e->die_event;
1789         }
1790
1791         $mgr->respond;
1792     }
1793
1794     $e->commit;
1795     return $mgr->respond_complete;
1796 }
1797
1798
1799 __PACKAGE__->register_method(
1800         method => 'merge_picklist_api',
1801         api_name        => 'open-ils.acq.picklist.merge',
1802         signature => {
1803         desc => 'Merges 2 or more picklists into a single list',
1804         params => [
1805             {desc => 'Authentication token', type => 'string'},
1806             {desc => 'Lead Picklist ID', type => 'number'},
1807             {desc => 'List of subordinate picklist IDs', type => 'array'}
1808         ],
1809         return => {desc => 'status blob, Event on error'}
1810     }
1811 );
1812
1813 sub merge_picklist_api {
1814     my($self, $conn, $auth, $lead_pl, $pl_list) = @_;
1815
1816     my $e = new_editor(xact=>1, authtoken=>$auth);
1817     return $e->die_event unless $e->checkauth;
1818     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1819
1820     # XXX perms on each picklist modified
1821
1822     # point all of the lineitems at the lead picklist
1823     my $li_ids = $e->search_acq_lineitem({picklist => $pl_list}, {idlist => 1});
1824
1825     for my $li_id (@$li_ids) {
1826         my $li = $e->retrieve_acq_lineitem($li_id);
1827         $li->picklist($lead_pl);
1828         update_lineitem($mgr, $li) or return $e->die_event;
1829         $mgr->respond;
1830     }
1831
1832     # now delete the subordinate lists
1833     for my $pl_id (@$pl_list) {
1834         my $pl = $e->retrieve_acq_picklist($pl_id);
1835         $e->delete_acq_picklist($pl) or return $e->die_event;
1836     }
1837
1838     $e->commit;
1839     return $mgr->respond_complete;
1840 }
1841
1842
1843 __PACKAGE__->register_method(
1844         method => 'delete_picklist_api',
1845         api_name        => 'open-ils.acq.picklist.delete',
1846         signature => {
1847         desc => q/Deletes a picklist.  It also deletes any lineitems in the "new" state.
1848             Other attached lineitems are detached'/,
1849         params => [
1850             {desc => 'Authentication token', type => 'string'},
1851             {desc => 'Picklist ID to delete', type => 'number'}
1852         ],
1853         return => {desc => '1 on success, Event on error'}
1854     }
1855 );
1856
1857 sub delete_picklist_api {
1858     my($self, $conn, $auth, $picklist_id) = @_;
1859     my $e = new_editor(xact=>1, authtoken=>$auth);
1860     return $e->die_event unless $e->checkauth;
1861     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1862     my $pl = $e->retrieve_acq_picklist($picklist_id) or return $e->die_event;
1863     delete_picklist($mgr, $pl) or return $e->die_event;
1864     $e->commit;
1865     return $mgr->respond_complete;
1866 }
1867
1868
1869
1870 __PACKAGE__->register_method(
1871         method => 'activate_purchase_order',
1872         api_name        => 'open-ils.acq.purchase_order.activate',
1873         signature => {
1874         desc => q/Activates a purchase order.  This updates the status of the PO
1875             and Lineitems to 'on-order'.  Activated PO's are ready for EDI delivery
1876             if appropriate./,
1877         params => [
1878             {desc => 'Authentication token', type => 'string'},
1879             {desc => 'Purchase ID', type => 'number'}
1880         ],
1881         return => {desc => '1 on success, Event on error'}
1882     }
1883 );
1884
1885 sub activate_purchase_order {
1886     my($self, $conn, $auth, $po_id) = @_;
1887     my $e = new_editor(xact=>1, authtoken=>$auth);
1888     return $e->die_event unless $e->checkauth;
1889     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1890
1891     my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->die_event;
1892     return $e->die_event unless $e->allowed('CREATE_PURCHASE_ORDER', $po->ordering_agency);
1893
1894     $po->state('on-order');
1895     update_purchase_order($mgr, $po) or return $e->die_event;
1896
1897     my $query = [
1898         {purchase_order => $po_id, state => 'pending-order'},
1899         {limit => 1}
1900     ];
1901
1902     while( my $li = $e->search_acq_lineitem($query)->[0] ) {
1903         $li->state('on-order');
1904         update_lineitem($mgr, $li) or return $e->die_event;
1905         $mgr->respond;
1906     }
1907
1908     $e->commit;
1909     return 1;
1910 }
1911
1912
1913 __PACKAGE__->register_method(
1914         method => 'split_purchase_order_by_lineitems',
1915         api_name        => 'open-ils.acq.purchase_order.split_by_lineitems',
1916         signature => {
1917         desc => q/Splits a PO into many POs, 1 per lineitem.  Only works for
1918         POs a) with more than one lineitems, and b) in the "pending" state./,
1919         params => [
1920             {desc => 'Authentication token', type => 'string'},
1921             {desc => 'Purchase order ID', type => 'number'}
1922         ],
1923         return => {desc => 'list of new PO IDs on success, Event on error'}
1924     }
1925 );
1926
1927 sub split_purchase_order_by_lineitems {
1928     my ($self, $conn, $auth, $po_id) = @_;
1929
1930     my $e = new_editor("xact" => 1, "authtoken" => $auth);
1931     return $e->die_event unless $e->checkauth;
1932
1933     my $po = $e->retrieve_acq_purchase_order([
1934         $po_id, {
1935             "flesh" => 1,
1936             "flesh_fields" => {"acqpo" => [qw/lineitems notes/]}
1937         }
1938     ]) or return $e->die_event;
1939
1940     return $e->die_event
1941         unless $e->allowed("CREATE_PURCHASE_ORDER", $po->ordering_agency);
1942
1943     unless ($po->state eq "pending") {
1944         $e->rollback;
1945         return new OpenILS::Event("ACQ_PURCHASE_ORDER_TOO_LATE");
1946     }
1947
1948     unless (@{$po->lineitems} > 1) {
1949         $e->rollback;
1950         return new OpenILS::Event("ACQ_PURCHASE_ORDER_TOO_SHORT");
1951     }
1952
1953     # To split an existing PO into many, it seems unwise to just delete the
1954     # original PO, so we'll instead detach all of the original POs' lineitems
1955     # but the first, then create new POs for each of the remaining LIs, and
1956     # then attach the LIs to their new POs.
1957
1958     my @po_ids = ($po->id);
1959     my @moving_li = @{$po->lineitems};
1960     shift @moving_li;    # discard first LI
1961
1962     foreach my $li (@moving_li) {
1963         my $new_po = $po->clone;
1964         $new_po->clear_id;
1965         $new_po->clear_name;
1966         $new_po->creator($e->requestor->id);
1967         $new_po->editor($e->requestor->id);
1968         $new_po->owner($e->requestor->id);
1969         $new_po->edit_time("now");
1970         $new_po->create_time("now");
1971
1972         $new_po = $e->create_acq_purchase_order($new_po);
1973
1974         # Clone any notes attached to the old PO and attach to the new one.
1975         foreach my $note (@{$po->notes}) {
1976             my $new_note = $note->clone;
1977             $new_note->clear_id;
1978             $new_note->edit_time("now");
1979             $new_note->purchase_order($new_po->id);
1980             $e->create_acq_po_note($new_note);
1981         }
1982
1983         $li->edit_time("now");
1984         $li->purchase_order($new_po->id);
1985         $e->update_acq_lineitem($li);
1986
1987         push @po_ids, $new_po->id;
1988     }
1989
1990     $po->edit_time("now");
1991     $e->update_acq_purchase_order($po);
1992
1993     return \@po_ids if $e->commit;
1994     return $e->die_event;
1995 }
1996
1997
1998 1;