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

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