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

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