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