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