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;
8 my($class, %args) = @_;
9 my $self = bless(\%args, $class);
18 purchase_order => undef,
26 $self->throttle(4) unless $self->throttle;
27 $self->{post_proc_queue} = [];
28 $self->{last_respond_progress} = 0;
34 $self->{conn} = $val if $val;
39 $self->{throttle} = $val if $val;
40 return $self->{throttle};
43 my($self, %other_args) = @_;
44 if($self->throttle and not %other_args) {
46 ($self->{args}->{progress} - $self->{last_respond_progress}) >= $self->throttle
49 $self->conn->respond({ %{$self->{args}}, %other_args });
50 $self->{last_respond_progress} = $self->{args}->{progress};
51 $self->throttle($self->throttle * 2) unless $self->throttle >= 256;
53 sub respond_complete {
54 my($self, %other_args) = @_;
56 $self->conn->respond_complete({ %{$self->{args}}, %other_args });
57 $self->run_post_response_hooks;
61 # run the post response hook subs, shifting them off as we go
62 sub run_post_response_hooks {
64 (shift @{$self->{post_proc_queue}})->() while @{$self->{post_proc_queue}};
67 # any subs passed to this method will be run after the call to respond_complete
70 push(@{$self->{post_proc_queue}}, $sub);
75 $self->{args}->{total} = $val if defined $val;
76 $self->{args}->{maximum} = $self->{args}->{total};
77 return $self->{args}->{total};
81 $self->{args}->{purchase_order} = $val if $val;
86 $self->{args}->{picklist} = $val if $val;
91 $self->{args}->{lid} += 1;
92 $self->{args}->{progress} += 1;
97 $self->{args}->{li} += 1;
98 $self->{args}->{progress} += 1;
103 $self->{args}->{vqbr} += 1;
104 $self->{args}->{progress} += 1;
109 $self->{args}->{copies} += 1;
110 $self->{args}->{progress} += 1;
115 $self->{args}->{bibs} += 1;
116 $self->{args}->{progress} += 1;
120 my($self, $amount) = @_;
121 $self->{args}->{debits_accrued} += $amount;
122 $self->{args}->{progress} += 1;
126 my($self, $editor) = @_;
127 $self->{editor} = $editor if defined $editor;
128 return $self->{editor};
132 $self->{args}->{complete} = 1;
137 my($self, $org, $key, $val) = @_;
138 $self->{cache}->{$org} = {} unless $self->{cache}->{org};
139 $self->{cache}->{$org}->{$key} = $val if defined $val;
140 return $self->{cache}->{$org}->{$key};
144 package OpenILS::Application::Acq::Order;
145 use base qw/OpenILS::Application/;
146 use strict; use warnings;
147 # ----------------------------------------------------------------------------
148 # Break up each component of the order process and pieces into managable
149 # actions that can be shared across different workflows
150 # ----------------------------------------------------------------------------
152 use OpenSRF::Utils::Logger qw(:logger);
153 use OpenSRF::Utils::JSON;
154 use OpenSRF::AppSession;
155 use OpenILS::Utils::Fieldmapper;
156 use OpenILS::Utils::CStoreEditor q/:funcs/;
157 use OpenILS::Utils::Normalize qw/clean_marc/;
158 use OpenILS::Const qw/:const/;
159 use OpenSRF::EX q/:try/;
160 use OpenILS::Application::AppUtils;
161 use OpenILS::Application::Cat::BibCommon;
162 use OpenILS::Application::Cat::AssetCommon;
165 use MARC::File::XML (BinaryEncoding => 'UTF-8');
166 use Digest::MD5 qw(md5_hex);
168 $Data::Dumper::Indent = 0;
169 my $U = 'OpenILS::Application::AppUtils';
172 # ----------------------------------------------------------------------------
174 # ----------------------------------------------------------------------------
175 sub create_lineitem {
176 my($mgr, %args) = @_;
177 my $li = Fieldmapper::acq::lineitem->new;
178 $li->creator($mgr->editor->requestor->id);
179 $li->selector($li->creator);
180 $li->editor($li->creator);
181 $li->create_time('now');
182 $li->edit_time('now');
184 $li->$_($args{$_}) for keys %args;
187 $mgr->editor->create_acq_lineitem($li) or return 0;
189 unless($li->estimated_unit_price) {
190 # extract the price from the MARC data
191 my $price = get_li_price_from_attr($mgr->editor, $li) or return $li;
192 $li->estimated_unit_price($price);
193 return update_lineitem($mgr, $li);
199 sub get_li_price_from_attr {
201 my $attrs = $li->attributes || $e->search_acq_lineitem_attr({lineitem => $li->id});
203 for my $attr_type (qw/
204 lineitem_local_attr_definition
205 lineitem_prov_attr_definition
206 lineitem_marc_attr_definition/) {
209 $_->attr_name eq 'estimated_price' and
210 $_->attr_type eq $attr_type } @$attrs;
212 return $attr->attr_value if $attr;
219 sub update_lineitem {
221 $li->edit_time('now');
222 $li->editor($mgr->editor->requestor->id);
224 return $mgr->editor->retrieve_acq_lineitem($mgr->editor->data) if
225 $mgr->editor->update_acq_lineitem($li);
230 # ----------------------------------------------------------------------------
231 # Create real holds from patron requests for a given lineitem
232 # ----------------------------------------------------------------------------
233 sub promote_lineitem_holds {
236 my $requests = $mgr->editor->search_acq_user_request(
237 { lineitem => $li->id,
239 [ { need_before => {'>' => 'now'} },
240 { need_before => undef }
245 for my $request ( @$requests ) {
247 $request->eg_bib( $li->eg_bib_id );
248 $mgr->editor->update_acq_user_request( $request ) or return 0;
250 next unless ($U->is_true( $request->hold ));
252 my $hold = Fieldmapper::action::hold_request->new;
253 $hold->usr( $request->usr );
254 $hold->requestor( $request->usr );
255 $hold->request_time( $request->request_date );
256 $hold->pickup_lib( $request->pickup_lib );
257 $hold->request_lib( $request->pickup_lib );
258 $hold->selection_ou( $request->pickup_lib );
259 $hold->phone_notify( $request->phone_notify );
260 $hold->email_notify( $request->email_notify );
261 $hold->expire_time( $request->need_before );
263 if ($request->holdable_formats) {
264 my $mrm = $mgr->editor->search_metabib_metarecord_source_map( { source => $li->eg_bib_id } )->[0];
266 $hold->hold_type( 'M' );
267 $hold->holdable_formats( $request->holdable_formats );
268 $hold->target( $mrm->metarecord );
272 if (!$hold->target) {
273 $hold->hold_type( 'T' );
274 $hold->target( $li->eg_bib_id );
277 # if behind-the-desk holds are supported at the
278 # pickup library, apply the patron default
279 my $bdous = $U->ou_ancestor_setting_value(
281 'circ.holds.behind_desk_pickup_supported',
286 my $set = $mgr->editor->search_actor_user_setting(
287 {usr => $hold->usr, name => 'circ.holds_behind_desk'})->[0];
289 $hold->behind_desk('t') if $set and
290 OpenSRF::Utils::JSON->JSON2perl($set->value);
293 $mgr->editor->create_action_hold_request( $hold ) or return 0;
299 sub delete_lineitem {
301 $li = $mgr->editor->retrieve_acq_lineitem($li) unless ref $li;
303 # delete the attached lineitem_details
304 my $lid_ids = $mgr->editor->search_acq_lineitem_detail({lineitem => $li->id}, {idlist=>1});
305 for my $lid_id (@$lid_ids) {
306 return 0 unless delete_lineitem_detail($mgr, $lid_id);
310 return $mgr->editor->delete_acq_lineitem($li);
313 # begins and commit transactions as it goes
314 # bib_only exits before creation of copies and callnumbers
315 sub create_lineitem_list_assets {
316 my($mgr, $li_ids, $vandelay, $bib_only) = @_;
318 # Do not create line items if none are specified
319 return {} unless (scalar(@$li_ids));
321 if (check_import_li_marc_perms($mgr, $li_ids)) { # event on error
322 $logger->error("acq-vl: user does not have permission to import acq records");
326 my $res = import_li_bibs_via_vandelay($mgr, $li_ids, $vandelay);
327 return undef unless $res;
328 return $res if $bib_only;
330 # create the bibs/volumes/copies for the successfully imported records
331 for my $li_id (@{$res->{li_ids}}) {
332 $mgr->editor->xact_begin;
333 my $data = create_lineitem_assets($mgr, $li_id) or return undef;
334 $mgr->editor->xact_commit;
341 sub test_vandelay_import_args {
342 my $vandelay = shift;
343 my $q_needed = shift;
345 # we need valid args and (sometimes) a queue
346 return 0 unless $vandelay and (
348 $vandelay->{queue_name} or
349 $vandelay->{existing_queue}
352 # match-based merge/overlay import
353 return 2 if $vandelay->{merge_profile} and (
354 $vandelay->{auto_overlay_exact} or
355 $vandelay->{auto_overlay_1match} or
356 $vandelay->{auto_overlay_best_match}
360 return 2 if $vandelay->{import_no_match};
362 return 1; # queue only
365 sub find_or_create_vandelay_queue {
366 my ($e, $vandelay) = @_;
369 if (my $name = $vandelay->{queue_name}) {
371 # first, see if a queue w/ this name already exists
372 # for this user. If so, use that instead.
374 $queue = $e->search_vandelay_bib_queue(
375 {name => $name, owner => $e->requestor->id})->[0];
379 $logger->info("acq-vl: using existing queue $name");
383 $logger->info("acq-vl: creating new vandelay queue $name");
385 $queue = new Fieldmapper::vandelay::bib_queue;
387 $queue->queue_type('acq');
388 $queue->owner($e->requestor->id);
389 $queue->match_set($vandelay->{match_set} || undef); # avoid ''
390 $queue = $e->create_vandelay_bib_queue($queue) or return undef;
394 $queue = $e->retrieve_vandelay_bib_queue($vandelay->{existing_queue})
402 sub import_li_bibs_via_vandelay {
403 my ($mgr, $li_ids, $vandelay) = @_;
404 my $res = {li_ids => []};
405 my $e = $mgr->editor;
408 my $needs_importing = $e->search_acq_lineitem(
409 {id => $li_ids, eg_bib_id => undef},
413 if (!@$needs_importing) {
414 $logger->info("acq-vl: all records already imported. no Vandelay work to do");
415 return {li_ids => $li_ids};
418 # see if we have any records that are not yet linked to VL records (i.e.
419 # not in a queue). This will tell us if lack of a queue name is an error.
420 my $non_queued = $e->search_acq_lineitem(
421 {id => $needs_importing, queued_record => undef},
425 # add the already-imported records to the response list
426 push(@{$res->{li_ids}}, grep { $_ != @$needs_importing } @$li_ids);
428 $logger->info("acq-vl: processing recs via Vandelay with args: ".Dumper($vandelay));
430 my $vl_stat = test_vandelay_import_args($vandelay, scalar(@$non_queued));
432 $logger->error("acq-vl: invalid vandelay arguments for acq import (queue needed)");
438 # when any non-queued lineitems exist, their vandelay counterparts
439 # require a place to live.
440 $queue = find_or_create_vandelay_queue($e, $vandelay) or return $res;
443 # if all lineitems are already queued, the queue reported to the user
444 # is purely for information / convenience. pick a random queue.
445 $queue = $e->retrieve_acq_lineitem([
446 $needs_importing->[0], {
449 jub => ['queued_record'],
453 ])->queued_record->queue;
456 $mgr->{args}->{queue} = $queue;
458 # load the lineitems into the queue for merge processing
461 for my $li_id (@$needs_importing) {
463 my $li = $e->retrieve_acq_lineitem($li_id) or return $res;
465 if ($li->queued_record) {
466 $logger->info("acq-vl: $li_id already linked to a vandelay record");
467 push(@vqbr_ids, $li->queued_record);
470 $logger->info("acq-vl: creating new vandelay record for lineitem $li_id");
472 # create a new VL queued record and link it up
473 my $vqbr = Fieldmapper::vandelay::queued_bib_record->new;
474 $vqbr->marc($li->marc);
475 $vqbr->queue($queue->id);
476 $vqbr->bib_source($vandelay->{bib_source} || undef); # avoid ''
477 $vqbr = $e->create_vandelay_queued_bib_record($vqbr) or return $res;
478 push(@vqbr_ids, $vqbr->id);
480 # tell the acq record which vandelay record it's linked to
481 $li->queued_record($vqbr->id);
482 $e->update_acq_lineitem($li) or return $res;
490 $logger->info("acq-vl: created vandelay records [@vqbr_ids]");
492 # we have to commit the transaction now since
493 # vandelay uses its own transactions.
496 return $res if $vl_stat == 1; # queue only
498 # Import the bibs via vandelay. Note: Vandely will
499 # update acq.lineitem.eg_bib_id on successful import.
501 $vandelay->{report_all} = 1;
502 my $ses = OpenSRF::AppSession->create('open-ils.vandelay');
503 my $req = $ses->request(
504 'open-ils.vandelay.bib_record.list.import',
505 $e->authtoken, \@vqbr_ids, $vandelay);
507 # pull the responses, noting all that were successfully imported
509 while (my $resp = $req->recv(timeout => 600)) {
510 my $stat = $resp->content;
512 if(!$stat or $U->event_code($stat)) { # import failure
513 $logger->error("acq-vl: error importing vandelay record " . Dumper($stat));
517 # "imported" refers to the vqbr id, not the
518 # success/failure of the vqbr merge attempt
519 next unless $stat->{imported};
521 my ($imported) = grep {$_->queued_record eq $stat->{imported}} @lis;
522 my $li_id = $imported->id;
524 if ($stat->{no_import}) {
525 $logger->info("acq-vl: acq lineitem $li_id did not import");
527 } else { # successful import
529 push(@success_lis, $li_id);
532 $logger->info("acq-vl: acq lineitem $li_id successfully merged/imported");
537 $logger->info("acq-vl: successfully imported lineitems [@success_lis]");
539 # add the successfully imported lineitems to the already-imported lineitems
540 push (@{$res->{li_ids}}, @success_lis);
545 # returns event on error, undef on success
546 sub check_import_li_marc_perms {
547 my($mgr, $li_ids) = @_;
549 # if there are any order records that are not linked to
550 # in-db bib records, verify staff has perms to import order records
551 my $order_li = $mgr->editor->search_acq_lineitem(
552 [{id => $li_ids, eg_bib_id => undef}, {limit => 1}], {idlist => 1})->[0];
555 return $mgr->editor->die_event unless
556 $mgr->editor->allowed('IMPORT_ACQ_LINEITEM_BIB_RECORD');
563 # ----------------------------------------------------------------------------
564 # if all of the lineitem details for this lineitem have
565 # been received, mark the lineitem as received
566 # returns 1 on non-received, li on received, 0 on error
567 # ----------------------------------------------------------------------------
569 sub describe_affected_po {
573 OpenILS::Application::Acq::Financials::build_price_summary(
578 "state" => $po->state,
579 "amount_encumbered" => $enc,
580 "amount_spent" => $spent
585 sub check_lineitem_received {
586 my($mgr, $li_id) = @_;
588 my $non_recv = $mgr->editor->search_acq_lineitem_detail(
589 {recv_time => undef, lineitem => $li_id}, {idlist=>1});
591 return 1 if @$non_recv;
593 my $li = $mgr->editor->retrieve_acq_lineitem($li_id);
594 $li->state('received');
595 return update_lineitem($mgr, $li);
598 sub receive_lineitem {
599 my($mgr, $li_id, $skip_complete_check) = @_;
600 my $li = $mgr->editor->retrieve_acq_lineitem($li_id) or return 0;
602 return 0 unless $li->state eq 'on-order' or $li->state eq 'cancelled'; # sic
604 $li->clear_cancel_reason; # un-cancel on receive
606 my $lid_ids = $mgr->editor->search_acq_lineitem_detail(
607 {lineitem => $li_id, recv_time => undef}, {idlist => 1});
609 for my $lid_id (@$lid_ids) {
610 receive_lineitem_detail($mgr, $lid_id, 1) or return 0;
614 $li->state('received');
616 $li = update_lineitem($mgr, $li) or return 0;
617 $mgr->post_process( sub { create_lineitem_status_events($mgr, $li_id, 'aur.received'); });
621 $skip_complete_check or (
622 $po = check_purchase_order_received($mgr, $li->purchase_order)
625 my $result = {"li" => {$li->id => {"state" => $li->state}}};
626 $result->{"po"} = describe_affected_po($mgr->editor, $po) if ref $po;
630 sub rollback_receive_lineitem {
631 my($mgr, $li_id) = @_;
632 my $li = $mgr->editor->retrieve_acq_lineitem($li_id) or return 0;
634 my $lid_ids = $mgr->editor->search_acq_lineitem_detail(
635 {lineitem => $li_id, recv_time => {'!=' => undef}}, {idlist => 1});
637 for my $lid_id (@$lid_ids) {
638 rollback_receive_lineitem_detail($mgr, $lid_id, 1) or return 0;
642 $li->state('on-order');
643 return update_lineitem($mgr, $li);
647 sub create_lineitem_status_events {
648 my($mgr, $li_id, $hook) = @_;
650 my $ses = OpenSRF::AppSession->create('open-ils.trigger');
652 my $user_reqs = $mgr->editor->search_acq_user_request([
653 {lineitem => $li_id},
654 {flesh => 1, flesh_fields => {aur => ['usr']}}
657 for my $user_req (@$user_reqs) {
658 my $req = $ses->request('open-ils.trigger.event.autocreate', $hook, $user_req, $user_req->usr->home_ou);
666 # ----------------------------------------------------------------------------
668 # ----------------------------------------------------------------------------
669 sub create_lineitem_detail {
670 my($mgr, %args) = @_;
671 my $lid = Fieldmapper::acq::lineitem_detail->new;
672 $lid->$_($args{$_}) for keys %args;
675 return $mgr->editor->create_acq_lineitem_detail($lid);
679 # flesh out any required data with default values where appropriate
680 sub complete_lineitem_detail {
682 unless($lid->barcode) {
683 my $pfx = $U->ou_ancestor_setting_value($lid->owning_lib, 'acq.tmp_barcode_prefix') || 'ACQ';
684 $lid->barcode($pfx.$lid->id);
687 unless($lid->cn_label) {
688 my $pfx = $U->ou_ancestor_setting_value($lid->owning_lib, 'acq.tmp_callnumber_prefix') || 'ACQ';
689 $lid->cn_label($pfx.$lid->id);
692 if(!$lid->location and my $loc = $U->ou_ancestor_setting_value($lid->owning_lib, 'acq.default_copy_location')) {
693 $lid->location($loc);
696 $lid->circ_modifier(get_default_circ_modifier($mgr, $lid->owning_lib))
697 unless defined $lid->circ_modifier;
699 $mgr->editor->update_acq_lineitem_detail($lid) or return 0;
703 sub get_default_circ_modifier {
705 my $code = $mgr->cache($org, 'def_circ_mod');
706 $code = $U->ou_ancestor_setting_value($org, 'acq.default_circ_modifier') unless defined $code;
707 return $mgr->cache($org, 'def_circ_mod', $code) if defined $code;
711 sub delete_lineitem_detail {
713 $lid = $mgr->editor->retrieve_acq_lineitem_detail($lid) unless ref $lid;
714 return $mgr->editor->delete_acq_lineitem_detail($lid);
718 sub receive_lineitem_detail {
719 my($mgr, $lid_id, $skip_complete_check) = @_;
720 my $e = $mgr->editor;
722 my $lid = $e->retrieve_acq_lineitem_detail([
726 acqlid => ['fund_debit']
731 return 1 if $lid->recv_time;
733 # if the LID is marked as canceled, remove the cancel reason,
734 # and reinstate fund debits where deleted by cancelation.
735 if ($lid->cancel_reason) {
736 my $cr = $e->retrieve_acq_cancel_reason($lid->cancel_reason);
738 if (!$U->is_true($cr->keep_debits)) {
739 # debits were removed during cancelation.
740 create_lineitem_detail_debit(
741 $mgr, $lid->lineitem, $lid) or return 0;
743 $lid->clear_cancel_reason;
746 $lid->receiver($e->requestor->id);
747 $lid->recv_time('now');
748 $e->update_acq_lineitem_detail($lid) or return 0;
750 if ($lid->eg_copy_id) {
751 my $copy = $e->retrieve_asset_copy($lid->eg_copy_id) or return 0;
752 # only update status if it hasn't already been updated
753 $copy->status(OILS_COPY_STATUS_IN_PROCESS) if $copy->status == OILS_COPY_STATUS_ON_ORDER;
754 $copy->edit_date('now');
755 $copy->editor($e->requestor->id);
756 $copy->creator($e->requestor->id) if $U->ou_ancestor_setting_value(
757 $e->requestor->ws_ou, 'acq.copy_creator_uses_receiver', $e);
758 $e->update_asset_copy($copy) or return 0;
763 return 1 if $skip_complete_check;
765 my $li = check_lineitem_received($mgr, $lid->lineitem) or return 0;
766 return 1 if $li == 1; # li not received
768 return check_purchase_order_received($mgr, $li->purchase_order) or return 0;
772 sub rollback_receive_lineitem_detail {
773 my($mgr, $lid_id) = @_;
774 my $e = $mgr->editor;
776 my $lid = $e->retrieve_acq_lineitem_detail([
780 acqlid => ['fund_debit']
785 return 1 unless $lid->recv_time;
787 $lid->clear_receiver;
788 $lid->clear_recv_time;
789 $e->update_acq_lineitem_detail($lid) or return 0;
791 if ($lid->eg_copy_id) {
792 my $copy = $e->retrieve_asset_copy($lid->eg_copy_id) or return 0;
793 $copy->status(OILS_COPY_STATUS_ON_ORDER);
794 $copy->edit_date('now');
795 $copy->editor($e->requestor->id);
796 $e->update_asset_copy($copy) or return 0;
803 # ----------------------------------------------------------------------------
805 # ----------------------------------------------------------------------------
806 sub set_lineitem_attr {
807 my($mgr, %args) = @_;
808 my $attr_type = $args{attr_type};
810 # first, see if it's already set. May just need to overwrite it
811 my $attr = $mgr->editor->search_acq_lineitem_attr({
812 lineitem => $args{lineitem},
813 attr_type => $args{attr_type},
814 attr_name => $args{attr_name}
818 $attr->attr_value($args{attr_value});
819 return $attr if $mgr->editor->update_acq_lineitem_attr($attr);
824 $attr = Fieldmapper::acq::lineitem_attr->new;
825 $attr->$_($args{$_}) for keys %args;
827 unless($attr->definition) {
828 my $find = "search_acq_$attr_type";
829 my $attr_def_id = $mgr->editor->$find({code => $attr->attr_name}, {idlist=>1})->[0] or return 0;
830 $attr->definition($attr_def_id);
832 return $mgr->editor->create_acq_lineitem_attr($attr);
836 # ----------------------------------------------------------------------------
838 # ----------------------------------------------------------------------------
839 sub create_lineitem_debits {
840 my ($mgr, $li, $options) = @_;
842 my $dry_run = $options->{dry_run};
844 unless($li->estimated_unit_price) {
845 $mgr->editor->event(OpenILS::Event->new('ACQ_LINEITEM_NO_PRICE', payload => $li->id));
846 $mgr->editor->rollback;
850 unless($li->provider) {
851 $mgr->editor->event(OpenILS::Event->new('ACQ_LINEITEM_NO_PROVIDER', payload => $li->id));
852 $mgr->editor->rollback;
856 my $lid_ids = $mgr->editor->search_acq_lineitem_detail(
857 {lineitem => $li->id},
861 if (@$lid_ids == 0 and !$options->{zero_copy_activate}) {
862 $mgr->editor->event(OpenILS::Event->new('ACQ_LINEITEM_NO_COPIES', payload => $li->id));
863 $mgr->editor->rollback;
867 for my $lid_id (@$lid_ids) {
869 my $lid = $mgr->editor->retrieve_acq_lineitem_detail([
872 flesh_fields => {acqlid => ['fund']}
876 create_lineitem_detail_debit($mgr, $li, $lid, $dry_run) or return 0;
885 sub create_lineitem_detail_debit {
886 my ($mgr, $li, $lid, $dry_run, $no_translate) = @_;
888 # don't create the debit if one already exists
889 return $mgr->editor->retrieve_acq_fund_debit($lid->fund_debit) if $lid->fund_debit;
891 my $li_id = ref($li) ? $li->id : $li;
893 unless(ref $li and ref $li->provider) {
894 $li = $mgr->editor->retrieve_acq_lineitem([
897 flesh_fields => {jub => ['provider']},
903 $lid->fund($mgr->editor->retrieve_acq_fund($lid->fund)) unless(ref $lid->fund);
905 $lid = $mgr->editor->retrieve_acq_lineitem_detail([
908 flesh_fields => {acqlid => ['fund']}
913 unless ($lid->fund) {
915 new OpenILS::Event("ACQ_FUND_NOT_FOUND") # close enough
920 my $amount = $li->estimated_unit_price;
921 if($li->provider->currency_type ne $lid->fund->currency_type and !$no_translate) {
923 # At Fund debit creation time, translate into the currency of the fund
924 # TODO: org setting to disable automatic currency conversion at debit create time?
926 $amount = $mgr->editor->json_query({
928 'acq.exchange_ratio',
929 $li->provider->currency_type, # source currency
930 $lid->fund->currency_type, # destination currency
931 $li->estimated_unit_price # source amount
933 })->[0]->{'acq.exchange_ratio'};
936 my $debit = create_fund_debit(
939 fund => $lid->fund->id,
940 origin_amount => $li->estimated_unit_price,
941 origin_currency_type => $li->provider->currency_type,
945 $lid->fund_debit($debit->id);
946 $lid->fund($lid->fund->id);
947 $mgr->editor->update_acq_lineitem_detail($lid) or return 0;
952 __PACKAGE__->register_method(
953 "method" => "fund_exceeds_balance_percent_api",
954 "api_name" => "open-ils.acq.fund.check_balance_percentages",
956 "desc" => q/Determine whether a given fund exceeds its defined
957 "balance stop and warning percentages"/,
959 {"desc" => "Authentication token", "type" => "string"},
960 {"desc" => "Fund ID", "type" => "number"},
961 {"desc" => "Theoretical debit amount (optional)",
964 "return" => {"desc" => q/An array of two values, for stop and warning,
965 in that order: 1 if fund exceeds that balance percentage, else 0/}
969 sub fund_exceeds_balance_percent_api {
970 my ($self, $conn, $auth, $fund_id, $debit_amount) = @_;
974 my $e = new_editor("authtoken" => $auth);
975 return $e->die_event unless $e->checkauth;
977 my $fund = $e->retrieve_acq_fund($fund_id) or return $e->die_event;
978 return $e->die_event unless $e->allowed("VIEW_FUND", $fund->org);
981 fund_exceeds_balance_percent($fund, $debit_amount, $e, "stop"),
982 fund_exceeds_balance_percent($fund, $debit_amount, $e, "warning")
989 sub fund_exceeds_balance_percent {
990 my ($fund, $debit_amount, $e, $which) = @_;
992 my ($method_name, $event_name) = @{{
994 "balance_warning_percent", "ACQ_FUND_EXCEEDS_WARN_PERCENT"
997 "balance_stop_percent", "ACQ_FUND_EXCEEDS_STOP_PERCENT"
1001 if ($fund->$method_name) {
1003 $e->search_acq_fund_combined_balance({"fund" => $fund->id})->[0];
1005 $e->search_acq_fund_allocation_total({"fund" => $fund->id})->[0];
1007 $balance = ($balance) ? $balance->amount : 0;
1008 $allocations = ($allocations) ? $allocations->amount : 0;
1011 $allocations == 0 || # if no allocations were ever made, assume we have hit the stop percent
1012 ((($allocations - $balance + $debit_amount) / $allocations) * 100) > $fund->$method_name
1014 $logger->info("fund would hit a limit: " . $fund->id . ", $balance, $debit_amount, $allocations, $method_name");
1019 "fund" => $fund, "debit_amount" => $debit_amount
1029 # ----------------------------------------------------------------------------
1031 # ----------------------------------------------------------------------------
1032 sub create_fund_debit {
1033 my($mgr, $dry_run, %args) = @_;
1035 # Verify the fund is not being spent beyond the hard stop amount
1036 my $fund = $mgr->editor->retrieve_acq_fund($args{fund}) or return 0;
1039 fund_exceeds_balance_percent(
1040 $fund, $args{"amount"}, $mgr->editor, "stop"
1043 $dry_run and fund_exceeds_balance_percent(
1044 $fund, $args{"amount"}, $mgr->editor, "warning"
1047 my $debit = Fieldmapper::acq::fund_debit->new;
1048 $debit->debit_type('purchase');
1049 $debit->encumbrance('t');
1050 $debit->$_($args{$_}) for keys %args;
1052 $mgr->add_debit($debit->amount);
1053 return $mgr->editor->create_acq_fund_debit($debit);
1057 # ----------------------------------------------------------------------------
1059 # ----------------------------------------------------------------------------
1060 sub create_picklist {
1061 my($mgr, %args) = @_;
1062 my $picklist = Fieldmapper::acq::picklist->new;
1063 $picklist->creator($mgr->editor->requestor->id);
1064 $picklist->owner($picklist->creator);
1065 $picklist->editor($picklist->creator);
1066 $picklist->create_time('now');
1067 $picklist->edit_time('now');
1068 $picklist->org_unit($mgr->editor->requestor->ws_ou);
1069 $picklist->owner($mgr->editor->requestor->id);
1070 $picklist->$_($args{$_}) for keys %args;
1071 $picklist->clear_id;
1072 $mgr->picklist($picklist);
1073 return $mgr->editor->create_acq_picklist($picklist);
1076 sub update_picklist {
1077 my($mgr, $picklist) = @_;
1078 $picklist = $mgr->editor->retrieve_acq_picklist($picklist) unless ref $picklist;
1079 $picklist->edit_time('now');
1080 $picklist->editor($mgr->editor->requestor->id);
1081 if ($mgr->editor->update_acq_picklist($picklist)) {
1082 $picklist = $mgr->editor->retrieve_acq_picklist($mgr->editor->data);
1083 $mgr->picklist($picklist);
1090 sub delete_picklist {
1091 my($mgr, $picklist) = @_;
1092 $picklist = $mgr->editor->retrieve_acq_picklist($picklist) unless ref $picklist;
1094 # delete all 'new' lineitems
1095 my $li_ids = $mgr->editor->search_acq_lineitem(
1097 picklist => $picklist->id,
1098 "-or" => {state => "new", purchase_order => undef}
1102 for my $li_id (@$li_ids) {
1103 my $li = $mgr->editor->retrieve_acq_lineitem($li_id);
1104 return 0 unless delete_lineitem($mgr, $li);
1108 # detach all non-'new' lineitems
1109 $li_ids = $mgr->editor->search_acq_lineitem({picklist => $picklist->id, state => {'!=' => 'new'}}, {idlist => 1});
1110 for my $li_id (@$li_ids) {
1111 my $li = $mgr->editor->retrieve_acq_lineitem($li_id);
1112 $li->clear_picklist;
1113 return 0 unless update_lineitem($mgr, $li);
1117 # remove any picklist-specific object perms
1118 my $ops = $mgr->editor->search_permission_usr_object_perm_map({object_type => 'acqpl', object_id => ''.$picklist->id});
1119 for my $op (@$ops) {
1120 return 0 unless $mgr->editor->delete_usr_object_perm_map($op);
1123 return $mgr->editor->delete_acq_picklist($picklist);
1126 # ----------------------------------------------------------------------------
1128 # ----------------------------------------------------------------------------
1129 sub update_purchase_order {
1131 $po = $mgr->editor->retrieve_acq_purchase_order($po) unless ref $po;
1132 $po->editor($mgr->editor->requestor->id);
1133 $po->edit_time('now');
1134 $mgr->purchase_order($po);
1135 return $mgr->editor->retrieve_acq_purchase_order($mgr->editor->data)
1136 if $mgr->editor->update_acq_purchase_order($po);
1140 sub create_purchase_order {
1141 my($mgr, %args) = @_;
1143 # verify the chosen provider is still active
1144 my $provider = $mgr->editor->retrieve_acq_provider($args{provider}) or return 0;
1145 unless($U->is_true($provider->active)) {
1146 $logger->error("provider is not active. cannot create PO");
1147 $mgr->editor->event(OpenILS::Event->new('ACQ_PROVIDER_INACTIVE'));
1151 my $po = Fieldmapper::acq::purchase_order->new;
1152 $po->creator($mgr->editor->requestor->id);
1153 $po->editor($mgr->editor->requestor->id);
1154 $po->owner($mgr->editor->requestor->id);
1155 $po->edit_time('now');
1156 $po->create_time('now');
1157 $po->state('pending');
1158 $po->ordering_agency($mgr->editor->requestor->ws_ou);
1159 $po->$_($args{$_}) for keys %args;
1161 $mgr->purchase_order($po);
1162 return $mgr->editor->create_acq_purchase_order($po);
1165 # ----------------------------------------------------------------------------
1166 # if all of the lineitems for this PO are received,
1167 # mark the PO as received
1168 # ----------------------------------------------------------------------------
1169 sub check_purchase_order_received {
1170 my($mgr, $po_id) = @_;
1172 my $non_recv_li = $mgr->editor->search_acq_lineitem(
1173 { purchase_order => $po_id,
1174 state => {'!=' => 'received'}
1177 my $po = $mgr->editor->retrieve_acq_purchase_order($po_id);
1178 return $po if @$non_recv_li;
1180 $po->state('received');
1181 return update_purchase_order($mgr, $po);
1185 # ----------------------------------------------------------------------------
1186 # Bib, Callnumber, and Copy data
1187 # ----------------------------------------------------------------------------
1189 sub create_lineitem_assets {
1190 my($mgr, $li_id) = @_;
1193 my $li = $mgr->editor->retrieve_acq_lineitem([
1196 flesh_fields => {jub => ['purchase_order', 'attributes']}
1200 # note: at this point, the bib record this LI links to should already be created
1202 # -----------------------------------------------------------------
1203 # The lineitem is going live, promote user request holds to real holds
1204 # -----------------------------------------------------------------
1205 promote_lineitem_holds($mgr, $li) or return 0;
1207 my $li_details = $mgr->editor->search_acq_lineitem_detail({lineitem => $li_id}, {idlist=>1});
1209 # -----------------------------------------------------------------
1210 # for each lineitem_detail, create the volume if necessary, create
1211 # a copy, and link them all together.
1212 # -----------------------------------------------------------------
1214 for my $lid_id (@{$li_details}) {
1216 my $lid = $mgr->editor->retrieve_acq_lineitem_detail($lid_id) or return 0;
1217 next if $lid->eg_copy_id;
1219 # use the same callnumber label for all items within this lineitem
1220 $lid->cn_label($first_cn) if $first_cn and not $lid->cn_label;
1222 # apply defaults if necessary
1223 return 0 unless complete_lineitem_detail($mgr, $lid);
1225 $first_cn = $lid->cn_label unless $first_cn;
1227 my $org = $lid->owning_lib;
1228 my $label = $lid->cn_label;
1229 my $bibid = $li->eg_bib_id;
1231 my $volume = $mgr->cache($org, "cn.$bibid.$label");
1233 $volume = create_volume($mgr, $li, $lid) or return 0;
1234 $mgr->cache($org, "cn.$bibid.$label", $volume);
1236 create_copy($mgr, $volume, $lid, $li) or return 0;
1239 return { li => $li };
1243 my($mgr, $li, $lid) = @_;
1245 my ($volume, $evt) =
1246 OpenILS::Application::Cat::AssetCommon->find_or_create_volume(
1254 $mgr->editor->event($evt);
1262 my($mgr, $volume, $lid, $li) = @_;
1263 my $copy = Fieldmapper::asset::copy->new;
1265 $copy->loan_duration(2);
1266 $copy->fine_level(2);
1267 $copy->status(($lid->recv_time) ? OILS_COPY_STATUS_IN_PROCESS : OILS_COPY_STATUS_ON_ORDER);
1268 $copy->barcode($lid->barcode);
1269 $copy->location($lid->location);
1270 $copy->call_number($volume->id);
1271 $copy->circ_lib($volume->owning_lib);
1272 $copy->circ_modifier($lid->circ_modifier);
1274 # AKA list price. We might need a $li->list_price field since
1275 # estimated price is not necessarily the same as list price
1276 $copy->price($li->estimated_unit_price);
1278 my $evt = OpenILS::Application::Cat::AssetCommon->create_copy($mgr->editor, $volume, $copy);
1280 $mgr->editor->event($evt);
1285 $lid->eg_copy_id($copy->id);
1286 $mgr->editor->update_acq_lineitem_detail($lid) or return 0;
1294 # ----------------------------------------------------------------------------
1295 # Workflow: Build a selection list from a Z39.50 search
1296 # ----------------------------------------------------------------------------
1298 __PACKAGE__->register_method(
1299 method => 'zsearch',
1300 api_name => 'open-ils.acq.picklist.search.z3950',
1303 desc => 'Performs a z3950 federated search and creates a picklist and associated lineitems',
1305 {desc => 'Authentication token', type => 'string'},
1306 {desc => 'Search definition', type => 'object'},
1307 {desc => 'Picklist name, optional', type => 'string'},
1313 my($self, $conn, $auth, $search, $name, $options) = @_;
1314 my $e = new_editor(authtoken=>$auth);
1315 return $e->event unless $e->checkauth;
1316 return $e->event unless $e->allowed('CREATE_PICKLIST');
1318 $search->{limit} ||= 10;
1321 my $ses = OpenSRF::AppSession->create('open-ils.search');
1322 my $req = $ses->request('open-ils.search.z3950.search_class', $auth, $search);
1327 while(my $resp = $req->recv(timeout=>60)) {
1330 my $e = new_editor(requestor=>$e->requestor, xact=>1);
1331 $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1332 $picklist = zsearch_build_pl($mgr, $name);
1336 my $result = $resp->content;
1337 my $count = $result->{count} || 0;
1338 $mgr->total( (($count < $search->{limit}) ? $count : $search->{limit})+1 );
1340 for my $rec (@{$result->{records}}) {
1342 my $li = create_lineitem($mgr,
1343 picklist => $picklist->id,
1344 source_label => $result->{service},
1345 marc => $rec->{marcxml},
1346 eg_bib_id => $rec->{bibid}
1349 if($$options{respond_li}) {
1350 $li->attributes($mgr->editor->search_acq_lineitem_attr({lineitem => $li->id}))
1351 if $$options{flesh_attrs};
1352 $li->clear_marc if $$options{clear_marc};
1353 $mgr->respond(lineitem => $li);
1360 $mgr->editor->commit;
1361 return $mgr->respond_complete;
1364 sub zsearch_build_pl {
1365 my($mgr, $name) = @_;
1368 my $picklist = $mgr->editor->search_acq_picklist({
1369 owner => $mgr->editor->requestor->id,
1373 if($name eq '' and $picklist) {
1374 return 0 unless delete_picklist($mgr, $picklist);
1378 return update_picklist($mgr, $picklist) if $picklist;
1379 return create_picklist($mgr, name => $name);
1383 # ----------------------------------------------------------------------------
1384 # Workflow: Build a selection list / PO by importing a batch of MARC records
1385 # ----------------------------------------------------------------------------
1387 __PACKAGE__->register_method(
1388 method => 'upload_records',
1389 api_name => 'open-ils.acq.process_upload_records',
1391 max_chunk_count => 1
1394 sub upload_records {
1395 my($self, $conn, $auth, $key, $args) = @_;
1398 my $e = new_editor(authtoken => $auth, xact => 1);
1399 return $e->die_event unless $e->checkauth;
1400 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1402 my $cache = OpenSRF::Utils::Cache->new;
1404 my $data = $cache->get_cache("vandelay_import_spool_$key");
1405 my $filename = $data->{path};
1406 my $provider = $args->{provider};
1407 my $picklist = $args->{picklist};
1408 my $create_po = $args->{create_po};
1409 my $activate_po = $args->{activate_po};
1410 my $vandelay = $args->{vandelay};
1411 my $ordering_agency = $args->{ordering_agency} || $e->requestor->ws_ou;
1412 my $fiscal_year = $args->{fiscal_year};
1414 # if the user provides no fiscal year, find the
1415 # current fiscal year for the ordering agency.
1416 $fiscal_year ||= $U->simplereq(
1418 'open-ils.acq.org_unit.current_fiscal_year',
1426 unless(-r $filename) {
1427 $logger->error("unable to read MARC file $filename");
1429 return OpenILS::Event->new('FILE_UPLOAD_ERROR', payload => {filename => $filename});
1432 $provider = $e->retrieve_acq_provider($provider) or return $e->die_event;
1435 $picklist = $e->retrieve_acq_picklist($picklist) or return $e->die_event;
1436 if($picklist->owner != $e->requestor->id) {
1437 return $e->die_event unless
1438 $e->allowed('CREATE_PICKLIST', $picklist->org_unit, $picklist);
1440 $mgr->picklist($picklist);
1444 return $e->die_event unless
1445 $e->allowed('CREATE_PURCHASE_ORDER', $ordering_agency);
1447 $po = create_purchase_order($mgr,
1448 ordering_agency => $ordering_agency,
1449 provider => $provider->id,
1450 state => 'pending' # will be updated later if activated
1451 ) or return $mgr->editor->die_event;
1454 $logger->info("acq processing MARC file=$filename");
1456 my $batch = new MARC::Batch ('USMARC', $filename);
1464 my ($err, $xml, $r);
1469 } catch Error with {
1471 $logger->warn("Proccessing of record $count in set $key failed with error $err. Skipping this record");
1478 $xml = clean_marc($r);
1479 } catch Error with {
1481 $logger->warn("Proccessing XML of record $count in set $key failed with error $err. Skipping this record");
1484 next if $err or not $xml;
1487 source_label => $provider->code,
1488 provider => $provider->id,
1492 $args{picklist} = $picklist->id if $picklist;
1494 $args{purchase_order} = $po->id;
1495 $args{state} = 'pending-order';
1498 my $li = create_lineitem($mgr, %args) or return $mgr->editor->die_event;
1500 $li->provider($provider); # flesh it, we'll need it later
1502 import_lineitem_details($mgr, $ordering_agency, $li, $fiscal_year)
1503 or return $mgr->editor->die_event;
1506 push(@li_list, $li->id);
1511 $evt = extract_po_name($mgr, $po, \@li_list);
1512 return $evt if $evt;
1517 $cache->delete_cache('vandelay_import_spool_' . $key);
1519 if ($po and $activate_po) {
1520 my $die_event = activate_purchase_order_impl($mgr, $po->id, $vandelay);
1521 return $die_event if $die_event;
1523 } elsif ($vandelay) {
1524 $vandelay->{new_rec_perm} = 'IMPORT_ACQ_LINEITEM_BIB_RECORD_UPLOAD';
1525 create_lineitem_list_assets($mgr, \@li_list, $vandelay,
1526 !$vandelay->{create_assets}) or return $e->die_event;
1529 return $mgr->respond_complete;
1532 # see if the PO name is encoded in the newly imported records
1533 sub extract_po_name {
1534 my ($mgr, $po, $li_ids) = @_;
1535 my $e = $mgr->editor;
1537 # find the first instance of the name
1538 my $attr = $e->search_acq_lineitem_attr([
1539 { lineitem => $li_ids,
1540 attr_type => 'lineitem_provider_attr_definition',
1541 attr_name => 'purchase_order'
1543 order_by => {aqlia => 'id'},
1546 ])->[0] or return undef;
1548 my $name = $attr->attr_value;
1550 # see if another PO already has the name, provider, and org
1551 my $existing = $e->search_acq_purchase_order(
1553 ordering_agency => $po->ordering_agency,
1554 provider => $po->provider
1559 # if a PO exists with the same name (and provider/org)
1560 # tack the po ID into the name to differentiate
1561 $name = sprintf("$name (%s)", $po->id) if $existing;
1563 $logger->info("Extracted PO name: $name");
1566 update_purchase_order($mgr, $po) or return $e->die_event;
1570 sub import_lineitem_details {
1571 my($mgr, $ordering_agency, $li, $fiscal_year) = @_;
1573 my $holdings = $mgr->editor->json_query({from => ['acq.extract_provider_holding_data', $li->id]});
1574 return 1 unless @$holdings;
1575 my $org_path = $U->get_org_ancestors($ordering_agency);
1576 $org_path = [ reverse (@$org_path) ];
1582 # create a lineitem detail for each copy in the data
1584 my $compiled = extract_lineitem_detail_data($mgr, $org_path, $holdings, $idx, $fiscal_year);
1585 last unless defined $compiled;
1586 return 0 unless $compiled;
1588 # this takes the price of the last copy and uses it as the lineitem price
1589 # need to determine if a given record would include different prices for the same item
1590 $price = $$compiled{estimated_price};
1592 last unless $$compiled{quantity};
1594 for(1..$$compiled{quantity}) {
1595 my $lid = create_lineitem_detail(
1597 lineitem => $li->id,
1598 owning_lib => $$compiled{owning_lib},
1599 cn_label => $$compiled{call_number},
1600 fund => $$compiled{fund},
1601 circ_modifier => $$compiled{circ_modifier},
1602 note => $$compiled{note},
1603 location => $$compiled{copy_location},
1604 collection_code => $$compiled{collection_code},
1605 barcode => $$compiled{barcode}
1613 $li->estimated_unit_price($price);
1614 update_lineitem($mgr, $li) or return 0;
1618 # return hash on success, 0 on error, undef on no more holdings
1619 sub extract_lineitem_detail_data {
1620 my($mgr, $org_path, $holdings, $index, $fiscal_year) = @_;
1622 my @data_list = grep { $_->{holding} eq $index } @$holdings;
1623 return undef unless @data_list;
1625 my %compiled = map { $_->{attr} => $_->{data} } @data_list;
1626 my $base_org = $$org_path[0];
1630 $logger->error("Item import extraction error: $msg");
1631 $logger->error('Holdings Data: ' . OpenSRF::Utils::JSON->perl2JSON(\%compiled));
1632 $mgr->editor->rollback;
1633 $mgr->editor->event(OpenILS::Event->new('ACQ_IMPORT_ERROR', payload => $msg));
1637 # ---------------------------------------------------------------------
1639 if(my $code = $compiled{fund_code}) {
1641 my $fund = $mgr->cache($base_org, "fund.$code");
1643 # search up the org tree for the most appropriate fund
1644 for my $org (@$org_path) {
1645 $fund = $mgr->editor->search_acq_fund(
1646 {org => $org, code => $code, year => $fiscal_year}, {idlist => 1})->[0];
1650 return $killme->("no fund with code $code at orgs [@$org_path]") unless $fund;
1651 $compiled{fund} = $fund;
1652 $mgr->cache($base_org, "fund.$code", $fund);
1656 # ---------------------------------------------------------------------
1658 if(my $sn = $compiled{owning_lib}) {
1659 my $org_id = $mgr->cache($base_org, "orgsn.$sn") ||
1660 $mgr->editor->search_actor_org_unit({shortname => $sn}, {idlist => 1})->[0];
1661 return $killme->("invalid owning_lib defined: $sn") unless $org_id;
1662 $compiled{owning_lib} = $org_id;
1663 $mgr->cache($$org_path[0], "orgsn.$sn", $org_id);
1667 # ---------------------------------------------------------------------
1669 my $code = $compiled{circ_modifier};
1673 # verify this is a valid circ modifier
1674 return $killme->("invlalid circ_modifier $code") unless
1675 defined $mgr->cache($base_org, "mod.$code") or
1676 $mgr->editor->retrieve_config_circ_modifier($code);
1678 # if valid, cache for future tests
1679 $mgr->cache($base_org, "mod.$code", $code);
1682 $compiled{circ_modifier} = get_default_circ_modifier($mgr, $base_org);
1686 # ---------------------------------------------------------------------
1688 if( my $name = $compiled{copy_location}) {
1690 my $cp_base_org = $base_org;
1692 if ($compiled{owning_lib}) {
1693 # start looking for copy locations at the copy
1694 # owning lib instaed of the upload context org
1695 $cp_base_org = $compiled{owning_lib};
1698 my $loc = $mgr->cache($cp_base_org, "copy_loc.$name");
1700 my $org = $cp_base_org;
1702 $loc = $mgr->editor->search_asset_copy_location(
1703 {owning_lib => $org, name => $name}, {idlist => 1})->[0];
1705 $org = $mgr->editor->retrieve_actor_org_unit($org)->parent_ou;
1708 return $killme->("Invalid copy location $name") unless $loc;
1709 $compiled{copy_location} = $loc;
1710 $mgr->cache($cp_base_org, "copy_loc.$name", $loc);
1718 # ----------------------------------------------------------------------------
1719 # Workflow: Given an existing purchase order, import/create the bibs,
1720 # callnumber and copy objects
1721 # ----------------------------------------------------------------------------
1723 __PACKAGE__->register_method(
1724 method => 'create_po_assets',
1725 api_name => 'open-ils.acq.purchase_order.assets.create',
1727 desc => q/Creates assets for each lineitem in the purchase order/,
1729 {desc => 'Authentication token', type => 'string'},
1730 {desc => 'The purchase order id', type => 'number'},
1732 return => {desc => 'Streams a total versus completed counts object, event on error'}
1734 max_chunk_count => 1
1737 sub create_po_assets {
1738 my($self, $conn, $auth, $po_id, $args) = @_;
1741 my $e = new_editor(authtoken=>$auth, xact=>1);
1742 return $e->die_event unless $e->checkauth;
1743 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1745 my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->die_event;
1747 my $li_ids = $e->search_acq_lineitem({purchase_order => $po_id}, {idlist => 1});
1749 # it's ugly, but it's fast. Get the total count of lineitem detail objects to process
1750 my $lid_total = $e->json_query({
1751 select => { acqlid => [{aggregate => 1, transform => 'count', column => 'id'}] },
1757 join => {acqpo => {fkey => 'purchase_order', field => 'id'}}
1761 where => {'+acqpo' => {id => $po_id}}
1764 $mgr->total(scalar(@$li_ids) + $lid_total);
1766 create_lineitem_list_assets($mgr, $li_ids, $args->{vandelay})
1767 or return $e->die_event;
1770 update_purchase_order($mgr, $po) or return $e->die_event;
1773 return $mgr->respond_complete;
1778 __PACKAGE__->register_method(
1779 method => 'create_purchase_order_api',
1780 api_name => 'open-ils.acq.purchase_order.create',
1782 desc => 'Creates a new purchase order',
1784 {desc => 'Authentication token', type => 'string'},
1785 {desc => 'purchase_order to create', type => 'object'}
1787 return => {desc => 'The purchase order id, Event on failure'}
1789 max_chunk_count => 1
1792 sub create_purchase_order_api {
1793 my($self, $conn, $auth, $po, $args) = @_;
1796 my $e = new_editor(xact=>1, authtoken=>$auth);
1797 return $e->die_event unless $e->checkauth;
1798 return $e->die_event unless $e->allowed('CREATE_PURCHASE_ORDER', $po->ordering_agency);
1799 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1802 my %pargs = (ordering_agency => $e->requestor->ws_ou); # default
1803 $pargs{provider} = $po->provider if $po->provider;
1804 $pargs{ordering_agency} = $po->ordering_agency if $po->ordering_agency;
1805 $pargs{prepayment_required} = $po->prepayment_required if $po->prepayment_required;
1806 $pargs{name} = $po->name if $po->name;
1807 my $vandelay = $args->{vandelay};
1809 $po = create_purchase_order($mgr, %pargs) or return $e->die_event;
1811 my $li_ids = $$args{lineitems};
1815 for my $li_id (@$li_ids) {
1817 my $li = $e->retrieve_acq_lineitem([
1819 {flesh => 1, flesh_fields => {jub => ['attributes']}}
1820 ]) or return $e->die_event;
1822 return $e->die_event(
1824 "BAD_PARAMS", payload => $li,
1825 note => "acq.lineitem #" . $li->id .
1826 ": purchase_order #" . $li->purchase_order
1828 ) if $li->purchase_order;
1830 $li->provider($po->provider);
1831 $li->purchase_order($po->id);
1832 $li->state('pending-order');
1833 update_lineitem($mgr, $li) or return $e->die_event;
1838 # see if we have a PO name encoded in any of our lineitems
1839 my $evt = extract_po_name($mgr, $po, $li_ids);
1840 return $evt if $evt;
1842 # commit before starting the asset creation
1848 create_lineitem_list_assets(
1849 $mgr, $li_ids, $vandelay, !$$args{create_assets})
1850 or return $e->die_event;
1854 apply_default_copies($mgr, $po) or return $e->die_event;
1858 return $mgr->respond_complete;
1861 # !transaction must be managed by the caller
1862 # creates the default number of copies for each lineitem on the PO.
1863 # when a LI already has copies attached, no default copies are added.
1864 # without li_id, all lineitems are checked/applied
1865 # returns 1 on success, 0 on error
1866 sub apply_default_copies {
1867 my ($mgr, $po, $li_id) = @_;
1869 my $e = $mgr->editor;
1871 my $provider = ref($po->provider) ? $po->provider :
1872 $e->retrieve_acq_provider($po->provider);
1874 my $copy_count = $provider->default_copy_count || return 1;
1876 $logger->info("Applying $copy_count default copies for PO ".$po->id);
1878 my $li_ids = $li_id ? [$li_id] :
1879 $e->search_acq_lineitem({
1880 purchase_order => $po->id,
1881 cancel_reason => undef
1886 for my $li_id (@$li_ids) {
1888 my $lid_ids = $e->search_acq_lineitem_detail(
1889 {lineitem => $li_id}, {idlist => 1});
1891 # do not apply default copies when copies already exist
1894 for (1 .. $copy_count) {
1895 create_lineitem_detail($mgr,
1897 owning_lib => $e->requestor->ws_ou
1907 __PACKAGE__->register_method(
1908 method => 'update_lineitem_fund_batch',
1909 api_name => 'open-ils.acq.lineitem.fund.update.batch',
1912 desc => q/Given a set of lineitem IDS, updates the fund for all attached lineitem details/
1916 sub update_lineitem_fund_batch {
1917 my($self, $conn, $auth, $li_ids, $fund_id) = @_;
1918 my $e = new_editor(xact=>1, authtoken=>$auth);
1919 return $e->die_event unless $e->checkauth;
1920 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1921 for my $li_id (@$li_ids) {
1922 my ($li, $evt) = fetch_and_check_li($e, $li_id, 'write');
1923 return $evt if $evt;
1924 my $li_details = $e->search_acq_lineitem_detail({lineitem => $li_id});
1925 $_->fund($fund_id) and $_->ischanged(1) for @$li_details;
1926 $evt = lineitem_detail_CUD_batch($mgr, $li_details);
1927 return $evt if $evt;
1932 return $mgr->respond_complete;
1937 __PACKAGE__->register_method(
1938 method => 'lineitem_detail_CUD_batch_api',
1939 api_name => 'open-ils.acq.lineitem_detail.cud.batch',
1942 desc => q/Creates a new purchase order line item detail. / .
1943 q/Additionally creates the associated fund_debit/,
1945 {desc => 'Authentication token', type => 'string'},
1946 {desc => 'List of lineitem_details to create', type => 'array'},
1947 {desc => 'Create Debits. Used for creating post-po-asset-creation debits', type => 'bool'},
1949 return => {desc => 'Streaming response of current position in the array'}
1953 __PACKAGE__->register_method(
1954 method => 'lineitem_detail_CUD_batch_api',
1955 api_name => 'open-ils.acq.lineitem_detail.cud.batch.dry_run',
1959 Dry run version of open-ils.acq.lineitem_detail.cud.batch.
1960 In dry_run mode, updated fund_debit's the exceed the warning
1961 percent return an event.
1967 sub lineitem_detail_CUD_batch_api {
1968 my($self, $conn, $auth, $li_details, $create_debits) = @_;
1969 my $e = new_editor(xact=>1, authtoken=>$auth);
1970 return $e->die_event unless $e->checkauth;
1971 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1972 my $dry_run = ($self->api_name =~ /dry_run/o);
1973 my $evt = lineitem_detail_CUD_batch($mgr, $li_details, $create_debits, $dry_run);
1974 return $evt if $evt;
1976 return $mgr->respond_complete;
1980 sub lineitem_detail_CUD_batch {
1981 my($mgr, $li_details, $create_debits, $dry_run) = @_;
1983 $mgr->total(scalar(@$li_details));
1984 my $e = $mgr->editor;
1988 my $fund_cache = {};
1991 for my $lid (@$li_details) {
1993 unless($li = $li_cache{$lid->lineitem}) {
1994 ($li, $evt) = fetch_and_check_li($e, $lid->lineitem, 'write');
1995 return $evt if $evt;
1999 $lid = create_lineitem_detail($mgr, %{$lid->to_bare_hash}) or return $e->die_event;
2000 if($create_debits) {
2001 $li->provider($e->retrieve_acq_provider($li->provider)) or return $e->die_event;
2002 $lid->fund($e->retrieve_acq_fund($lid->fund)) or return $e->die_event;
2003 create_lineitem_detail_debit($mgr, $li, $lid, 0, 1) or return $e->die_event;
2006 } elsif($lid->ischanged) {
2007 return $evt if $evt = handle_changed_lid($e, $lid, $dry_run, $fund_cache);
2009 } elsif($lid->isdeleted) {
2010 delete_lineitem_detail($mgr, $lid) or return $e->die_event;
2013 $mgr->respond(li => $li);
2014 $li_cache{$lid->lineitem} = $li;
2020 sub handle_changed_lid {
2021 my($e, $lid, $dry_run, $fund_cache) = @_;
2023 my $orig_lid = $e->retrieve_acq_lineitem_detail($lid->id) or return $e->die_event;
2025 # updating the fund, so update the debit
2026 if($orig_lid->fund_debit and $orig_lid->fund != $lid->fund) {
2028 my $debit = $e->retrieve_acq_fund_debit($orig_lid->fund_debit);
2029 my $new_fund = $$fund_cache{$lid->fund} =
2030 $$fund_cache{$lid->fund} || $e->retrieve_acq_fund($lid->fund);
2032 # check the thresholds
2033 return $e->die_event if
2034 fund_exceeds_balance_percent($new_fund, $debit->amount, $e, "stop");
2035 return $e->die_event if $dry_run and
2036 fund_exceeds_balance_percent($new_fund, $debit->amount, $e, "warning");
2038 $debit->fund($new_fund->id);
2039 $e->update_acq_fund_debit($debit) or return $e->die_event;
2042 $e->update_acq_lineitem_detail($lid) or return $e->die_event;
2047 __PACKAGE__->register_method(
2048 method => 'receive_po_api',
2049 api_name => 'open-ils.acq.purchase_order.receive'
2052 sub receive_po_api {
2053 my($self, $conn, $auth, $po_id) = @_;
2054 my $e = new_editor(xact => 1, authtoken => $auth);
2055 return $e->die_event unless $e->checkauth;
2056 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
2058 my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->die_event;
2059 return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency);
2061 my $li_ids = $e->search_acq_lineitem({purchase_order => $po_id}, {idlist => 1});
2063 for my $li_id (@$li_ids) {
2064 receive_lineitem($mgr, $li_id) or return $e->die_event;
2068 $po->state('received');
2069 update_purchase_order($mgr, $po) or return $e->die_event;
2072 return $mgr->respond_complete;
2076 # At the moment there's a lack of parallelism between the receive and unreceive
2077 # API methods for POs and the API methods for LIs and LIDs. The methods for
2078 # POs stream back objects as they act, whereas the methods for LIs and LIDs
2079 # atomically return an object that describes only what changed (in LIs and LIDs
2080 # themselves or in the objects to which to LIs and LIDs belong).
2082 # The methods for LIs and LIDs work the way they do to faciliate the UI's
2083 # maintaining correct information about the state of these things when a user
2084 # wants to receive or unreceive these objects without refreshing their whole
2085 # display. The UI feature for receiving and un-receiving a whole PO just
2086 # refreshes the whole display, so this absence of parallelism in the UI is also
2087 # relected in this module.
2089 # This could be neatened in the future by making POs receive and unreceive in
2090 # the same way the LIs and LIDs do.
2092 __PACKAGE__->register_method(
2093 method => 'receive_lineitem_detail_api',
2094 api_name => 'open-ils.acq.lineitem_detail.receive',
2096 desc => 'Mark a lineitem_detail as received',
2098 {desc => 'Authentication token', type => 'string'},
2099 {desc => 'lineitem detail ID', type => 'number'}
2102 "on success, object describing changes to LID and possibly " .
2103 "to LI and PO; on error, Event"
2108 sub receive_lineitem_detail_api {
2109 my($self, $conn, $auth, $lid_id) = @_;
2111 my $e = new_editor(xact=>1, authtoken=>$auth);
2112 return $e->die_event unless $e->checkauth;
2113 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
2116 "flesh" => 2, "flesh_fields" => {
2117 "acqlid" => ["lineitem"], "jub" => ["purchase_order"]
2121 my $lid = $e->retrieve_acq_lineitem_detail([$lid_id, $fleshing]);
2123 return $e->die_event unless $e->allowed(
2124 'RECEIVE_PURCHASE_ORDER', $lid->lineitem->purchase_order->ordering_agency);
2127 my $recvd = receive_lineitem_detail($mgr, $lid_id) or return $e->die_event;
2129 # .. and re-retrieve
2130 $lid = $e->retrieve_acq_lineitem_detail([$lid_id, $fleshing]);
2132 # Now build result data structure.
2133 my $result = {"lid" => {$lid->id => {"recv_time" => $lid->recv_time}}};
2136 if ($recvd->class_name =~ /::purchase_order/) {
2137 $result->{"po"} = describe_affected_po($e, $recvd);
2139 $lid->lineitem->id => {"state" => $lid->lineitem->state}
2141 } elsif ($recvd->class_name =~ /::lineitem/) {
2142 $result->{"li"} = {$recvd->id => {"state" => $recvd->state}};
2146 describe_affected_po($e, $lid->lineitem->purchase_order);
2152 __PACKAGE__->register_method(
2153 method => 'receive_lineitem_api',
2154 api_name => 'open-ils.acq.lineitem.receive',
2156 desc => 'Mark a lineitem as received',
2158 {desc => 'Authentication token', type => 'string'},
2159 {desc => 'lineitem ID', type => 'number'}
2162 "on success, object describing changes to LI and possibly PO; " .
2168 sub receive_lineitem_api {
2169 my($self, $conn, $auth, $li_id) = @_;
2171 my $e = new_editor(xact=>1, authtoken=>$auth);
2172 return $e->die_event unless $e->checkauth;
2173 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
2175 my $li = $e->retrieve_acq_lineitem([
2179 jub => ['purchase_order']
2182 ]) or return $e->die_event;
2184 return $e->die_event unless $e->allowed(
2185 'RECEIVE_PURCHASE_ORDER', $li->purchase_order->ordering_agency);
2187 my $res = receive_lineitem($mgr, $li_id) or return $e->die_event;
2189 $conn->respond_complete($res);
2190 $mgr->run_post_response_hooks
2194 __PACKAGE__->register_method(
2195 method => 'receive_lineitem_batch_api',
2196 api_name => 'open-ils.acq.lineitem.receive.batch',
2199 desc => 'Mark lineitems as received',
2201 {desc => 'Authentication token', type => 'string'},
2202 {desc => 'lineitem ID list', type => 'array'}
2205 q/On success, stream of objects describing changes to LIs and
2206 possibly PO; onerror, Event. Any event, even after lots of other
2207 objects, should mean general failure of whole batch operation./
2212 sub receive_lineitem_batch_api {
2213 my ($self, $conn, $auth, $li_idlist) = @_;
2215 return unless ref $li_idlist eq 'ARRAY' and @$li_idlist;
2217 my $e = new_editor(xact => 1, authtoken => $auth);
2218 return $e->die_event unless $e->checkauth;
2220 my $mgr = new OpenILS::Application::Acq::BatchManager(
2221 editor => $e, conn => $conn
2224 for my $li_id (map { int $_ } @$li_idlist) {
2225 my $li = $e->retrieve_acq_lineitem([
2228 flesh_fields => { jub => ['purchase_order'] }
2230 ]) or return $e->die_event;
2232 return $e->die_event unless $e->allowed(
2233 'RECEIVE_PURCHASE_ORDER', $li->purchase_order->ordering_agency
2236 receive_lineitem($mgr, $li_id) or return $e->die_event;
2240 $e->commit or return $e->die_event;
2241 $mgr->respond_complete;
2242 $mgr->run_post_response_hooks;
2245 __PACKAGE__->register_method(
2246 method => 'rollback_receive_po_api',
2247 api_name => 'open-ils.acq.purchase_order.receive.rollback'
2250 sub rollback_receive_po_api {
2251 my($self, $conn, $auth, $po_id) = @_;
2252 my $e = new_editor(xact => 1, authtoken => $auth);
2253 return $e->die_event unless $e->checkauth;
2254 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
2256 my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->die_event;
2257 return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency);
2259 my $li_ids = $e->search_acq_lineitem({purchase_order => $po_id}, {idlist => 1});
2261 for my $li_id (@$li_ids) {
2262 rollback_receive_lineitem($mgr, $li_id) or return $e->die_event;
2266 $po->state('on-order');
2267 update_purchase_order($mgr, $po) or return $e->die_event;
2270 return $mgr->respond_complete;
2274 __PACKAGE__->register_method(
2275 method => 'rollback_receive_lineitem_detail_api',
2276 api_name => 'open-ils.acq.lineitem_detail.receive.rollback',
2278 desc => 'Mark a lineitem_detail as Un-received',
2280 {desc => 'Authentication token', type => 'string'},
2281 {desc => 'lineitem detail ID', type => 'number'}
2284 "on success, object describing changes to LID and possibly " .
2285 "to LI and PO; on error, Event"
2290 sub rollback_receive_lineitem_detail_api {
2291 my($self, $conn, $auth, $lid_id) = @_;
2293 my $e = new_editor(xact=>1, authtoken=>$auth);
2294 return $e->die_event unless $e->checkauth;
2295 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
2297 my $lid = $e->retrieve_acq_lineitem_detail([
2301 acqlid => ['lineitem'],
2302 jub => ['purchase_order']
2306 my $li = $lid->lineitem;
2307 my $po = $li->purchase_order;
2309 return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency);
2313 my $recvd = rollback_receive_lineitem_detail($mgr, $lid_id)
2314 or return $e->die_event;
2317 $result->{"lid"} = {$recvd->id => {"recv_time" => $recvd->recv_time}};
2319 $result->{"lid"} = {$lid->id => {"recv_time" => $lid->recv_time}};
2322 if ($li->state eq "received") {
2323 $li->state("on-order");
2324 $li = update_lineitem($mgr, $li) or return $e->die_event;
2325 $result->{"li"} = {$li->id => {"state" => $li->state}};
2328 if ($po->state eq "received") {
2329 $po->state("on-order");
2330 $po = update_purchase_order($mgr, $po) or return $e->die_event;
2332 $result->{"po"} = describe_affected_po($e, $po);
2334 $e->commit and return $result or return $e->die_event;
2337 __PACKAGE__->register_method(
2338 method => 'rollback_receive_lineitem_api',
2339 api_name => 'open-ils.acq.lineitem.receive.rollback',
2341 desc => 'Mark a lineitem as Un-received',
2343 {desc => 'Authentication token', type => 'string'},
2344 {desc => 'lineitem ID', type => 'number'}
2347 "on success, object describing changes to LI and possibly PO; " .
2353 sub rollback_receive_lineitem_api {
2354 my($self, $conn, $auth, $li_id) = @_;
2356 my $e = new_editor(xact=>1, authtoken=>$auth);
2357 return $e->die_event unless $e->checkauth;
2358 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
2360 my $li = $e->retrieve_acq_lineitem([
2362 "flesh" => 1, "flesh_fields" => {"jub" => ["purchase_order"]}
2365 my $po = $li->purchase_order;
2367 return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency);
2369 $li = rollback_receive_lineitem($mgr, $li_id) or return $e->die_event;
2371 my $result = {"li" => {$li->id => {"state" => $li->state}}};
2372 if ($po->state eq "received") {
2373 $po->state("on-order");
2374 $po = update_purchase_order($mgr, $po) or return $e->die_event;
2376 $result->{"po"} = describe_affected_po($e, $po);
2378 $e->commit and return $result or return $e->die_event;
2381 __PACKAGE__->register_method(
2382 method => 'rollback_receive_lineitem_batch_api',
2383 api_name => 'open-ils.acq.lineitem.receive.rollback.batch',
2386 desc => 'Mark a list of lineitems as Un-received',
2388 {desc => 'Authentication token', type => 'string'},
2389 {desc => 'lineitem ID list', type => 'array'}
2392 q/on success, a stream of objects describing changes to LI and
2393 possibly PO; on error, Event. Any event means all previously
2394 returned objects indicate changes that didn't really happen./
2399 sub rollback_receive_lineitem_batch_api {
2400 my ($self, $conn, $auth, $li_idlist) = @_;
2402 return unless ref $li_idlist eq 'ARRAY' and @$li_idlist;
2404 my $e = new_editor(xact => 1, authtoken => $auth);
2405 return $e->die_event unless $e->checkauth;
2407 my $mgr = new OpenILS::Application::Acq::BatchManager(
2408 editor => $e, conn => $conn
2411 for my $li_id (map { int $_ } @$li_idlist) {
2412 my $li = $e->retrieve_acq_lineitem([
2415 "flesh_fields" => {"jub" => ["purchase_order"]}
2419 my $po = $li->purchase_order;
2421 return $e->die_event unless
2422 $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency);
2424 $li = rollback_receive_lineitem($mgr, $li_id) or return $e->die_event;
2426 my $result = {"li" => {$li->id => {"state" => $li->state}}};
2427 if ($po->state eq "received") { # should happen first time, not after
2428 $po->state("on-order");
2429 $po = update_purchase_order($mgr, $po) or return $e->die_event;
2431 $result->{"po"} = describe_affected_po($e, $po);
2433 $mgr->respond(%$result);
2436 $e->commit or return $e->die_event;
2437 $mgr->respond_complete;
2438 $mgr->run_post_response_hooks;
2442 __PACKAGE__->register_method(
2443 method => 'set_lineitem_price_api',
2444 api_name => 'open-ils.acq.lineitem.price.set',
2446 desc => 'Set lineitem price. If debits already exist, update them as well',
2448 {desc => 'Authentication token', type => 'string'},
2449 {desc => 'lineitem ID', type => 'number'}
2451 return => {desc => 'status blob, Event on error'}
2455 sub set_lineitem_price_api {
2456 my($self, $conn, $auth, $li_id, $price) = @_;
2458 my $e = new_editor(xact=>1, authtoken=>$auth);
2459 return $e->die_event unless $e->checkauth;
2460 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
2462 my ($li, $evt) = fetch_and_check_li($e, $li_id, 'write');
2463 return $evt if $evt;
2465 $li->estimated_unit_price($price);
2466 update_lineitem($mgr, $li) or return $e->die_event;
2468 my $lid_ids = $e->search_acq_lineitem_detail(
2469 {lineitem => $li_id, fund_debit => {'!=' => undef}},
2473 for my $lid_id (@$lid_ids) {
2475 my $lid = $e->retrieve_acq_lineitem_detail([
2477 flesh => 1, flesh_fields => {acqlid => ['fund', 'fund_debit']}}
2480 $lid->fund_debit->amount($price);
2481 $e->update_acq_fund_debit($lid->fund_debit) or return $e->die_event;
2487 return $mgr->respond_complete;
2491 __PACKAGE__->register_method(
2492 method => 'clone_picklist_api',
2493 api_name => 'open-ils.acq.picklist.clone',
2495 desc => 'Clones a picklist, including lineitem and lineitem details',
2497 {desc => 'Authentication token', type => 'string'},
2498 {desc => 'Picklist ID', type => 'number'},
2499 {desc => 'New Picklist Name', type => 'string'}
2501 return => {desc => 'status blob, Event on error'}
2505 sub clone_picklist_api {
2506 my($self, $conn, $auth, $pl_id, $name) = @_;
2508 my $e = new_editor(xact=>1, authtoken=>$auth);
2509 return $e->die_event unless $e->checkauth;
2510 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
2512 my $old_pl = $e->retrieve_acq_picklist($pl_id);
2513 my $new_pl = create_picklist($mgr, %{$old_pl->to_bare_hash}, name => $name) or return $e->die_event;
2515 my $li_ids = $e->search_acq_lineitem({picklist => $pl_id}, {idlist => 1});
2517 # get the current user
2518 my $cloner = $mgr->editor->requestor->id;
2520 for my $li_id (@$li_ids) {
2522 # copy the lineitems' MARC
2523 my $marc = ($e->retrieve_acq_lineitem($li_id))->marc;
2525 # create a skeletal clone of the item
2526 my $li = Fieldmapper::acq::lineitem->new;
2527 $li->creator($cloner);
2528 $li->selector($cloner);
2529 $li->editor($cloner);
2532 my $new_li = create_lineitem($mgr, %{$li->to_bare_hash}, picklist => $new_pl->id) or return $e->die_event;
2538 return $mgr->respond_complete;
2542 __PACKAGE__->register_method(
2543 method => 'merge_picklist_api',
2544 api_name => 'open-ils.acq.picklist.merge',
2546 desc => 'Merges 2 or more picklists into a single list',
2548 {desc => 'Authentication token', type => 'string'},
2549 {desc => 'Lead Picklist ID', type => 'number'},
2550 {desc => 'List of subordinate picklist IDs', type => 'array'}
2552 return => {desc => 'status blob, Event on error'}
2556 sub merge_picklist_api {
2557 my($self, $conn, $auth, $lead_pl, $pl_list) = @_;
2559 my $e = new_editor(xact=>1, authtoken=>$auth);
2560 return $e->die_event unless $e->checkauth;
2561 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
2563 # XXX perms on each picklist modified
2565 $lead_pl = $e->retrieve_acq_picklist($lead_pl) or return $e->die_event;
2566 # point all of the lineitems at the lead picklist
2567 my $li_ids = $e->search_acq_lineitem({picklist => $pl_list}, {idlist => 1});
2569 for my $li_id (@$li_ids) {
2570 my $li = $e->retrieve_acq_lineitem($li_id);
2571 $li->picklist($lead_pl);
2572 update_lineitem($mgr, $li) or return $e->die_event;
2576 # now delete the subordinate lists
2577 for my $pl_id (@$pl_list) {
2578 my $pl = $e->retrieve_acq_picklist($pl_id);
2579 $e->delete_acq_picklist($pl) or return $e->die_event;
2582 update_picklist($mgr, $lead_pl) or return $e->die_event;
2585 return $mgr->respond_complete;
2589 __PACKAGE__->register_method(
2590 method => 'delete_picklist_api',
2591 api_name => 'open-ils.acq.picklist.delete',
2593 desc => q/Deletes a picklist. It also deletes any lineitems in the "new" state. / .
2594 q/Other attached lineitems are detached/,
2596 {desc => 'Authentication token', type => 'string'},
2597 {desc => 'Picklist ID to delete', type => 'number'}
2599 return => {desc => '1 on success, Event on error'}
2603 sub delete_picklist_api {
2604 my($self, $conn, $auth, $picklist_id) = @_;
2605 my $e = new_editor(xact=>1, authtoken=>$auth);
2606 return $e->die_event unless $e->checkauth;
2607 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
2608 my $pl = $e->retrieve_acq_picklist($picklist_id) or return $e->die_event;
2609 delete_picklist($mgr, $pl) or return $e->die_event;
2611 return $mgr->respond_complete;
2616 __PACKAGE__->register_method(
2617 method => 'activate_purchase_order',
2618 api_name => 'open-ils.acq.purchase_order.activate.dry_run'
2621 __PACKAGE__->register_method(
2622 method => 'activate_purchase_order',
2623 api_name => 'open-ils.acq.purchase_order.activate',
2625 desc => q/Activates a purchase order. This updates the status of the PO / .
2626 q/and Lineitems to 'on-order'. Activated PO's are ready for EDI delivery if appropriate./,
2628 {desc => 'Authentication token', type => 'string'},
2629 {desc => 'Purchase ID', type => 'number'}
2631 return => {desc => '1 on success, Event on error'}
2635 sub activate_purchase_order {
2636 my($self, $conn, $auth, $po_id, $vandelay, $options) = @_;
2638 $$options{dry_run} = ($self->api_name =~ /\.dry_run/) ? 1 : 0;
2640 my $e = new_editor(authtoken=>$auth);
2641 return $e->die_event unless $e->checkauth;
2642 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
2643 my $die_event = activate_purchase_order_impl($mgr, $po_id, $vandelay, $options);
2644 return $e->die_event if $die_event;
2645 $conn->respond_complete(1);
2646 $mgr->run_post_response_hooks unless $$options{dry_run};
2650 # xacts managed within
2651 sub activate_purchase_order_impl {
2652 my ($mgr, $po_id, $vandelay, $options) = @_;
2654 my $dry_run = $$options{dry_run};
2655 my $no_assets = $$options{no_assets};
2657 # read-only until lineitem asset creation
2658 my $e = $mgr->editor;
2661 my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->die_event;
2662 return $e->die_event unless $e->allowed('CREATE_PURCHASE_ORDER', $po->ordering_agency);
2664 return $e->die_event(OpenILS::Event->new('PO_ALREADY_ACTIVATED'))
2665 if $po->order_date; # PO cannot be re-activated
2667 my $provider = $e->retrieve_acq_provider($po->provider);
2669 # find lineitems and create assets for all
2672 purchase_order => $po_id,
2673 state => [qw/pending-order new order-ready/]
2676 my $li_ids = $e->search_acq_lineitem($query, {idlist => 1});
2678 my $vl_resp; # imported li's and the managing queue
2679 unless ($dry_run or $no_assets) {
2680 $e->rollback; # read-only thus far
2682 # list_assets manages its own transactions
2683 $vl_resp = create_lineitem_list_assets($mgr, $li_ids, $vandelay)
2684 or return OpenILS::Event->new('ACQ_LI_IMPORT_FAILED');
2688 # create fund debits for lineitems
2690 for my $li_id (@$li_ids) {
2691 my $li = $e->retrieve_acq_lineitem($li_id);
2693 unless ($li->eg_bib_id or $dry_run or $no_assets) {
2694 # we encountered a lineitem that was not successfully imported.
2695 # we cannot continue. rollback and report.
2697 return OpenILS::Event->new('ACQ_LI_IMPORT_FAILED', {queue => $vl_resp->{queue}});
2700 $li->state('on-order');
2701 $li->claim_policy($provider->default_claim_policy)
2702 if $provider->default_claim_policy and !$li->claim_policy;
2703 create_lineitem_debits($mgr, $li, $options) or return $e->die_event;
2704 update_lineitem($mgr, $li) or return $e->die_event;
2705 $mgr->post_process( sub { create_lineitem_status_events($mgr, $li->id, 'aur.ordered'); });
2709 # create po-item debits
2711 for my $po_item (@{$e->search_acq_po_item({purchase_order => $po_id})}) {
2713 my $debit = create_fund_debit(
2716 debit_type => 'direct_charge', # to match invoicing
2717 origin_amount => $po_item->estimated_cost,
2718 origin_currency_type => $e->retrieve_acq_fund($po_item->fund)->currency_type,
2719 amount => $po_item->estimated_cost,
2720 fund => $po_item->fund
2721 ) or return $e->die_event;
2722 $po_item->fund_debit($debit->id);
2723 $e->update_acq_po_item($po_item) or return $e->die_event;
2727 # mark PO as ordered
2729 $po->state('on-order');
2730 $po->order_date('now');
2731 update_purchase_order($mgr, $po) or return $e->die_event;
2734 $dry_run and $e->rollback or $e->commit;
2736 # tell the world we activated a PO
2737 $U->create_events_for_hook('acqpo.activated', $po, $po->ordering_agency) unless $dry_run;
2743 __PACKAGE__->register_method(
2744 method => 'split_purchase_order_by_lineitems',
2745 api_name => 'open-ils.acq.purchase_order.split_by_lineitems',
2747 desc => q/Splits a PO into many POs, 1 per lineitem. Only works for / .
2748 q/POs a) with more than one lineitems, and b) in the "pending" state./,
2750 {desc => 'Authentication token', type => 'string'},
2751 {desc => 'Purchase order ID', type => 'number'}
2753 return => {desc => 'list of new PO IDs on success, Event on error'}
2757 sub split_purchase_order_by_lineitems {
2758 my ($self, $conn, $auth, $po_id) = @_;
2760 my $e = new_editor("xact" => 1, "authtoken" => $auth);
2761 return $e->die_event unless $e->checkauth;
2763 my $po = $e->retrieve_acq_purchase_order([
2766 "flesh_fields" => {"acqpo" => [qw/lineitems notes/]}
2768 ]) or return $e->die_event;
2770 return $e->die_event
2771 unless $e->allowed("CREATE_PURCHASE_ORDER", $po->ordering_agency);
2773 unless ($po->state eq "pending") {
2775 return new OpenILS::Event("ACQ_PURCHASE_ORDER_TOO_LATE");
2778 unless (@{$po->lineitems} > 1) {
2780 return new OpenILS::Event("ACQ_PURCHASE_ORDER_TOO_SHORT");
2783 # To split an existing PO into many, it seems unwise to just delete the
2784 # original PO, so we'll instead detach all of the original POs' lineitems
2785 # but the first, then create new POs for each of the remaining LIs, and
2786 # then attach the LIs to their new POs.
2788 my @po_ids = ($po->id);
2789 my @moving_li = @{$po->lineitems};
2790 shift @moving_li; # discard first LI
2792 foreach my $li (@moving_li) {
2793 my $new_po = $po->clone;
2795 $new_po->clear_name;
2796 $new_po->creator($e->requestor->id);
2797 $new_po->editor($e->requestor->id);
2798 $new_po->owner($e->requestor->id);
2799 $new_po->edit_time("now");
2800 $new_po->create_time("now");
2802 $new_po = $e->create_acq_purchase_order($new_po);
2804 # Clone any notes attached to the old PO and attach to the new one.
2805 foreach my $note (@{$po->notes}) {
2806 my $new_note = $note->clone;
2807 $new_note->clear_id;
2808 $new_note->edit_time("now");
2809 $new_note->purchase_order($new_po->id);
2810 $e->create_acq_po_note($new_note);
2813 $li->edit_time("now");
2814 $li->purchase_order($new_po->id);
2815 $e->update_acq_lineitem($li);
2817 push @po_ids, $new_po->id;
2820 $po->edit_time("now");
2821 $e->update_acq_purchase_order($po);
2823 return \@po_ids if $e->commit;
2824 return $e->die_event;
2828 sub not_cancelable {
2830 (ref $o eq "HASH" and $o->{"textcode"} eq "ACQ_NOT_CANCELABLE");
2833 __PACKAGE__->register_method(
2834 method => "cancel_purchase_order_api",
2835 api_name => "open-ils.acq.purchase_order.cancel",
2837 desc => q/Cancels an on-order purchase order/,
2839 {desc => "Authentication token", type => "string"},
2840 {desc => "PO ID to cancel", type => "number"},
2841 {desc => "Cancel reason ID", type => "number"}
2843 return => {desc => q/Object describing changed POs, LIs and LIDs
2844 on success; Event on error./}
2848 sub cancel_purchase_order_api {
2849 my ($self, $conn, $auth, $po_id, $cancel_reason) = @_;
2851 my $e = new_editor("xact" => 1, "authtoken" => $auth);
2852 return $e->die_event unless $e->checkauth;
2853 my $mgr = new OpenILS::Application::Acq::BatchManager(
2854 "editor" => $e, "conn" => $conn
2857 $cancel_reason = $mgr->editor->retrieve_acq_cancel_reason($cancel_reason) or
2858 return new OpenILS::Event(
2859 "BAD_PARAMS", "note" => "Provide cancel reason ID"
2862 my $result = cancel_purchase_order($mgr, $po_id, $cancel_reason) or
2863 return $e->die_event;
2864 if (not_cancelable($result)) { # event not from CStoreEditor
2867 } elsif ($result == -1) {
2869 return new OpenILS::Event("ACQ_ALREADY_CANCELED");
2872 $e->commit or return $e->die_event;
2874 # XXX create purchase order status events?
2876 if ($mgr->{post_commit}) {
2877 foreach my $func (@{$mgr->{post_commit}}) {
2885 sub cancel_purchase_order {
2886 my ($mgr, $po_id, $cancel_reason) = @_;
2888 my $po = $mgr->editor->retrieve_acq_purchase_order($po_id) or return 0;
2890 # XXX is "cancelled" a typo? It's not correct US spelling, anyway.
2891 # Depending on context, this may not warrant an event.
2892 return -1 if $po->state eq "cancelled";
2894 # But this always does.
2895 return new OpenILS::Event(
2896 "ACQ_NOT_CANCELABLE", "note" => "purchase_order $po_id"
2897 ) unless ($po->state eq "on-order" or $po->state eq "pending");
2900 $mgr->editor->allowed("CREATE_PURCHASE_ORDER", $po->ordering_agency);
2902 $po->state("cancelled");
2903 $po->cancel_reason($cancel_reason->id);
2905 my $li_ids = $mgr->editor->search_acq_lineitem(
2906 {"purchase_order" => $po_id}, {"idlist" => 1}
2909 my $result = {"li" => {}, "lid" => {}};
2910 foreach my $li_id (@$li_ids) {
2911 my $li_result = cancel_lineitem($mgr, $li_id, $cancel_reason)
2914 next if $li_result == -1; # already canceled:skip.
2915 return $li_result if not_cancelable($li_result); # not cancelable:stop.
2917 # Merge in each LI result (there's only going to be
2918 # one per call to cancel_lineitem).
2919 my ($k, $v) = each %{$li_result->{"li"}};
2920 $result->{"li"}->{$k} = $v;
2922 # Merge in each LID result (there may be many per call to
2924 while (($k, $v) = each %{$li_result->{"lid"}}) {
2925 $result->{"lid"}->{$k} = $v;
2929 # TODO who/what/where/how do we indicate this change for electronic orders?
2930 # TODO return changes to encumbered/spent
2931 # TODO maybe cascade up from smaller object to container object if last
2932 # smaller object in the container has been canceled?
2934 update_purchase_order($mgr, $po) or return 0;
2936 $po_id => {"state" => $po->state, "cancel_reason" => $cancel_reason}
2942 __PACKAGE__->register_method(
2943 method => "cancel_lineitem_api",
2944 api_name => "open-ils.acq.lineitem.cancel",
2946 desc => q/Cancels an on-order lineitem/,
2948 {desc => "Authentication token", type => "string"},
2949 {desc => "Lineitem ID to cancel", type => "number"},
2950 {desc => "Cancel reason ID", type => "number"}
2952 return => {desc => q/Object describing changed LIs and LIDs on success;
2957 __PACKAGE__->register_method(
2958 method => "cancel_lineitem_api",
2959 api_name => "open-ils.acq.lineitem.cancel.batch",
2961 desc => q/Batched version of open-ils.acq.lineitem.cancel/,
2962 return => {desc => q/Object describing changed LIs and LIDs on success;
2967 sub cancel_lineitem_api {
2968 my ($self, $conn, $auth, $li_id, $cancel_reason) = @_;
2970 my $batched = $self->api_name =~ /\.batch/;
2972 my $e = new_editor("xact" => 1, "authtoken" => $auth);
2973 return $e->die_event unless $e->checkauth;
2974 my $mgr = new OpenILS::Application::Acq::BatchManager(
2975 "editor" => $e, "conn" => $conn
2978 $cancel_reason = $mgr->editor->retrieve_acq_cancel_reason($cancel_reason) or
2979 return new OpenILS::Event(
2980 "BAD_PARAMS", "note" => "Provide cancel reason ID"
2983 my ($result, $maybe_event);
2986 $result = {"li" => {}, "lid" => {}};
2987 foreach my $one_li_id (@$li_id) {
2988 my $one = cancel_lineitem($mgr, $one_li_id, $cancel_reason) or
2989 return $e->die_event;
2990 if (not_cancelable($one)) {
2991 $maybe_event = $one;
2992 } elsif ($result == -1) {
2993 $maybe_event = new OpenILS::Event("ACQ_ALREADY_CANCELED");
2997 while (($k, $v) = each %{$one->{"li"}}) {
2998 $result->{"li"}->{$k} = $v;
3001 if ($one->{"lid"}) {
3002 while (($k, $v) = each %{$one->{"lid"}}) {
3003 $result->{"lid"}->{$k} = $v;
3009 $result = cancel_lineitem($mgr, $li_id, $cancel_reason) or
3010 return $e->die_event;
3012 if (not_cancelable($result)) {
3015 } elsif ($result == -1) {
3017 return new OpenILS::Event("ACQ_ALREADY_CANCELED");
3021 if ($batched and not scalar keys %{$result->{"li"}}) {
3023 return $maybe_event;
3025 $e->commit or return $e->die_event;
3026 # create_lineitem_status_events should handle array li_id ok
3027 create_lineitem_status_events($mgr, $li_id, "aur.cancelled");
3029 if ($mgr->{post_commit}) {
3030 foreach my $func (@{$mgr->{post_commit}}) {
3039 sub cancel_lineitem {
3040 my ($mgr, $li_id, $cancel_reason) = @_;
3042 my $li = $mgr->editor->retrieve_acq_lineitem([
3043 $li_id, {flesh => 1,
3044 flesh_fields => {jub => ['purchase_order','cancel_reason']}}
3047 return 0 unless $mgr->editor->allowed(
3048 "CREATE_PURCHASE_ORDER", $li->purchase_order->ordering_agency
3051 # Depending on context, this may not warrant an event.
3052 return -1 if $li->state eq "cancelled"
3053 and $li->cancel_reason->keep_debits eq 'f';
3055 # But this always does. Note that this used to be looser, but you can
3056 # no longer cancel lineitems that lack a PO or that are in "pending-order"
3057 # state (you could in the past).
3058 return new OpenILS::Event(
3059 "ACQ_NOT_CANCELABLE", "note" => "lineitem $li_id"
3060 ) unless $li->purchase_order and
3061 ($li->state eq "on-order" or $li->state eq "cancelled");
3063 $li->state("cancelled");
3064 $li->cancel_reason($cancel_reason->id);
3066 my $lids = $mgr->editor->search_acq_lineitem_detail([{
3067 "lineitem" => $li_id
3070 flesh_fields => { acqlid => ['eg_copy_id'] }
3073 my $result = {"lid" => {}};
3075 foreach my $lid (@$lids) {
3076 my $lid_result = cancel_lineitem_detail($mgr, $lid->id, $cancel_reason)
3079 # gathering any real copies for deletion
3080 if ($lid->eg_copy_id) {
3081 $lid->eg_copy_id->isdeleted('t');
3082 push @$copies, $lid->eg_copy_id;
3085 next if $lid_result == -1; # already canceled: just skip it.
3086 return $lid_result if not_cancelable($lid_result); # not cxlable: stop.
3088 # Merge in each LID result (there's only going to be one per call to
3089 # cancel_lineitem_detail).
3090 my ($k, $v) = each %{$lid_result->{"lid"}};
3091 $result->{"lid"}->{$k} = $v;
3094 # Attempt to delete the gathered copies (this will also handle volume deletion and bib deletion)
3095 # Delete empty bibs according org unit setting
3096 my $force_delete_empty_bib = $U->ou_ancestor_setting_value(
3097 $mgr->editor->requestor->ws_ou, 'cat.bib.delete_on_no_copy_via_acq_lineitem_cancel', $mgr->editor);
3098 if (scalar(@$copies)>0) {
3100 my $delete_stats = undef;
3101 my $retarget_holds = [];
3102 my $cat_evt = OpenILS::Application::Cat::AssetCommon->update_fleshed_copies(
3103 $mgr->editor, $override, undef, $copies, $delete_stats, $retarget_holds,$force_delete_empty_bib);
3106 $logger->info("fleshed copy update failed with event: ".OpenSRF::Utils::JSON->perl2JSON($cat_evt));
3107 return new OpenILS::Event(
3108 "ACQ_NOT_CANCELABLE", "note" => "lineitem $li_id", "payload" => $cat_evt
3112 # We can't do the following and stay within the same transaction, but that's okay, the hold targeter will pick these up later.
3113 #my $ses = OpenSRF::AppSession->create('open-ils.circ');
3114 #$ses->request('open-ils.circ.hold.reset.batch', $auth, $retarget_holds);
3117 # if we have a bib, check to see whether it has been deleted. if so, cancel any active holds targeting that bib
3118 if ($li->eg_bib_id) {
3119 my $bib = $mgr->editor->retrieve_biblio_record_entry($li->eg_bib_id) or return new OpenILS::Event(
3120 "ACQ_NOT_CANCELABLE", "note" => "Could not retrieve bib " . $li->eg_bib_id . " for lineitem $li_id"
3122 if ($U->is_true($bib->deleted)) {
3123 my $holds = $mgr->editor->search_action_hold_request(
3124 { cancel_time => undef,
3125 fulfillment_time => undef,
3126 target => $li->eg_bib_id
3130 my %cached_usr_home_ou = ();
3132 for my $hold (@$holds) {
3134 $logger->info("Cancelling hold ".$hold->id.
3135 " due to acq lineitem cancellation.");
3137 $hold->cancel_time('now');
3138 $hold->cancel_cause(5); # 'Staff forced'--we may want a new hold cancel cause reason for this
3139 $hold->cancel_note('Corresponding Acquistion Lineitem/Purchase Order was cancelled.');
3140 unless($mgr->editor->update_action_hold_request($hold)) {
3141 my $evt = $mgr->editor->event;
3142 $logger->error("Error updating hold ". $evt->textcode .":". $evt->desc .":". $evt->stacktrace);
3143 return new OpenILS::Event(
3144 "ACQ_NOT_CANCELABLE", "note" => "Could not cancel hold " . $hold->id . " for lineitem $li_id", "payload" => $evt
3147 if (! defined $mgr->{post_commit}) { # we need a mechanism for creating trigger events, but only if the transaction gets committed
3148 $mgr->{post_commit} = [];
3150 push @{ $mgr->{post_commit} }, sub {
3151 my $home_ou = $cached_usr_home_ou{$hold->usr};
3153 my $user = $mgr->editor->retrieve_actor_user($hold->usr); # FIXME: how do we want to handle failures here?
3154 $home_ou = $user->home_ou;
3155 $cached_usr_home_ou{$hold->usr} = $home_ou;
3157 $U->create_events_for_hook('hold_request.cancel.cancelled_order', $hold, $home_ou);
3163 update_lineitem($mgr, $li) or return 0;
3166 "state" => $li->state,
3167 "cancel_reason" => $cancel_reason
3174 __PACKAGE__->register_method(
3175 method => "cancel_lineitem_detail_api",
3176 api_name => "open-ils.acq.lineitem_detail.cancel",
3178 desc => q/Cancels an on-order lineitem detail/,
3180 {desc => "Authentication token", type => "string"},
3181 {desc => "Lineitem detail ID to cancel", type => "number"},
3182 {desc => "Cancel reason ID", type => "number"}
3184 return => {desc => q/Object describing changed LIDs on success;
3189 sub cancel_lineitem_detail_api {
3190 my ($self, $conn, $auth, $lid_id, $cancel_reason) = @_;
3192 my $e = new_editor("xact" => 1, "authtoken" => $auth);
3193 return $e->die_event unless $e->checkauth;
3194 my $mgr = new OpenILS::Application::Acq::BatchManager(
3195 "editor" => $e, "conn" => $conn
3198 $cancel_reason = $mgr->editor->retrieve_acq_cancel_reason($cancel_reason) or
3199 return new OpenILS::Event(
3200 "BAD_PARAMS", "note" => "Provide cancel reason ID"
3203 my $result = cancel_lineitem_detail($mgr, $lid_id, $cancel_reason) or
3204 return $e->die_event;
3206 if (not_cancelable($result)) {
3209 } elsif ($result == -1) {
3211 return new OpenILS::Event("ACQ_ALREADY_CANCELED");
3214 $e->commit or return $e->die_event;
3216 # XXX create lineitem detail status events?
3220 sub cancel_lineitem_detail {
3221 my ($mgr, $lid_id, $cancel_reason) = @_;
3222 my $lid = $mgr->editor->retrieve_acq_lineitem_detail([
3226 "acqlid" => ["lineitem","cancel_reason"],
3227 "jub" => ["purchase_order"]
3232 # It's OK to cancel an already-canceled copy if the copy was
3233 # previously "delayed" -- keep_debits == true
3234 # Depending on context, this may not warrant an event.
3235 return -1 if $lid->cancel_reason
3236 and $lid->cancel_reason->keep_debits eq 'f';
3238 # But this always does.
3239 return new OpenILS::Event(
3240 "ACQ_NOT_CANCELABLE", "note" => "lineitem_detail $lid_id"
3242 (! $lid->lineitem->purchase_order) or
3244 (not $lid->recv_time) and
3246 $lid->lineitem->purchase_order and (
3247 $lid->lineitem->state eq "on-order" or
3248 $lid->lineitem->state eq "pending-order" or
3249 $lid->lineitem->state eq "cancelled"
3254 return 0 unless $mgr->editor->allowed(
3255 "CREATE_PURCHASE_ORDER",
3256 $lid->lineitem->purchase_order->ordering_agency
3257 ) or (! $lid->lineitem->purchase_order);
3259 $lid->cancel_reason($cancel_reason->id);
3261 unless($U->is_true($cancel_reason->keep_debits)) {
3262 my $debit_id = $lid->fund_debit;
3263 $lid->clear_fund_debit;
3266 # item is cancelled. Remove the fund debit.
3267 my $debit = $mgr->editor->retrieve_acq_fund_debit($debit_id);
3268 if (!$U->is_true($debit->encumbrance)) {
3269 $mgr->editor->rollback;
3270 return OpenILS::Event->new('ACQ_NOT_CANCELABLE',
3271 note => "Debit is marked as paid: $debit_id");
3273 $mgr->editor->delete_acq_fund_debit($debit) or return $mgr->editor->die_event;
3277 # XXX LIDs don't have either an editor or a edit_time field. Should we
3278 # update these on the LI when we alter an LID?
3279 $mgr->editor->update_acq_lineitem_detail($lid) or return 0;
3281 return {"lid" => {$lid_id => {"cancel_reason" => $cancel_reason}}};
3285 __PACKAGE__->register_method(
3286 method => 'user_requests',
3287 api_name => 'open-ils.acq.user_request.retrieve.by_user_id',
3290 desc => 'Retrieve fleshed user requests and related data for a given user.',
3292 { desc => 'Authentication token', type => 'string' },
3293 { desc => 'User ID of the owner, or array of IDs', },
3294 { desc => 'Options hash (optional) with any of the keys: order_by, limit, offset, state (of the lineitem)',
3299 desc => 'Fleshed user requests and related data',
3305 __PACKAGE__->register_method(
3306 method => 'user_requests',
3307 api_name => 'open-ils.acq.user_request.retrieve.by_home_ou',
3310 desc => 'Retrieve fleshed user requests and related data for a given org unit or units.',
3312 { desc => 'Authentication token', type => 'string' },
3313 { desc => 'Org unit ID, or array of IDs', },
3314 { desc => 'Options hash (optional) with any of the keys: order_by, limit, offset, state (of the lineitem)',
3319 desc => 'Fleshed user requests and related data',
3326 my($self, $conn, $auth, $search_value, $options) = @_;
3327 my $e = new_editor(authtoken => $auth);
3328 return $e->event unless $e->checkauth;
3329 my $rid = $e->requestor->id;
3333 "select"=>{"aur"=>["id"],"au"=>["home_ou", {column => 'id', alias => 'usr_id'} ]},
3334 "from"=>{ "aur" => { "au" => {}, "jub" => { "type" => "left" } } },
3338 {"id"=>undef}, # this with the left-join pulls in requests without lineitems
3339 {"state"=>["new","on-order","pending-order"]} # FIXME - probably needs softcoding
3343 "order_by"=>[{"class"=>"aur", "field"=>"request_date", "direction"=>"desc"}]
3346 foreach (qw/ order_by limit offset /) {
3347 $query->{$_} = $options->{$_} if defined $options->{$_};
3349 if (defined $options->{'state'}) {
3350 $query->{'where'}->{'+jub'}->{'-or'}->[1]->{'state'} = $options->{'state'};
3353 if ($self->api_name =~ /by_user_id/) {
3354 $query->{'where'}->{'usr'} = $search_value;
3356 $query->{'where'}->{'+au'} = { 'home_ou' => $search_value };
3359 my $pertinent_ids = $e->json_query($query);
3362 for my $id_blob (@$pertinent_ids) {
3363 if ($rid != $id_blob->{usr_id}) {
3364 if (!defined $perm_test{ $id_blob->{home_ou} }) {
3365 $perm_test{ $id_blob->{home_ou} } = $e->allowed( ['user_request.view'], $id_blob->{home_ou} );
3367 if (!$perm_test{ $id_blob->{home_ou} }) {
3371 my $aur_obj = $e->retrieve_acq_user_request([
3373 {flesh => 1, flesh_fields => { "aur" => [ 'lineitem' ] } }
3375 if (! $aur_obj) { next; }
3377 if ($aur_obj->lineitem()) {
3378 $aur_obj->lineitem()->clear_marc();
3380 $conn->respond($aur_obj);
3386 __PACKAGE__->register_method (
3387 method => 'update_user_request',
3388 api_name => 'open-ils.acq.user_request.cancel.batch',
3391 desc => 'If given a cancel reason, will update the request with that reason, otherwise, this will delete the request altogether. The ' .
3392 'intention is for staff interfaces or processes to provide cancel reasons, and for patron interfaces to just delete the requests.' ,
3394 { desc => 'Authentication token', type => 'string' },
3395 { desc => 'ID or array of IDs for the user requests to cancel' },
3396 { desc => 'Cancel Reason ID (optional)', type => 'string' }
3399 desc => 'progress object, event on error',
3403 __PACKAGE__->register_method (
3404 method => 'update_user_request',
3405 api_name => 'open-ils.acq.user_request.set_no_hold.batch',
3408 desc => 'Remove the hold from a user request or set of requests',
3410 { desc => 'Authentication token', type => 'string' },
3411 { desc => 'ID or array of IDs for the user requests to modify' }
3414 desc => 'progress object, event on error',
3419 sub update_user_request {
3420 my($self, $conn, $auth, $aur_ids, $cancel_reason) = @_;
3421 my $e = new_editor(xact => 1, authtoken => $auth);
3422 return $e->die_event unless $e->checkauth;
3423 my $rid = $e->requestor->id;
3427 for my $id (@$aur_ids) {
3429 my $aur_obj = $e->retrieve_acq_user_request([
3432 flesh_fields => { "aur" => ['lineitem', 'usr'] }
3434 ]) or return $e->die_event;
3436 my $context_org = $aur_obj->usr()->home_ou();
3437 $aur_obj->usr( $aur_obj->usr()->id() );
3439 if ($rid != $aur_obj->usr) {
3440 if (!defined $perm_test{ $context_org }) {
3441 $perm_test{ $context_org } = $e->allowed( ['user_request.update'], $context_org );
3443 if (!$perm_test{ $context_org }) {
3448 if($self->api_name =~ /set_no_hold/) {
3449 if ($U->is_true($aur_obj->hold)) {
3451 $e->update_acq_user_request($aur_obj) or return $e->die_event;
3455 if($self->api_name =~ /cancel/) {
3456 if ( $cancel_reason ) {
3457 $aur_obj->cancel_reason( $cancel_reason );
3458 $e->update_acq_user_request($aur_obj) or return $e->die_event;
3459 create_user_request_events( $e, [ $aur_obj ], 'aur.rejected' );
3461 $e->delete_acq_user_request($aur_obj);
3465 $conn->respond({maximum => scalar(@$aur_ids), progress => $x++});
3469 return {complete => 1};
3472 __PACKAGE__->register_method (
3473 method => 'new_user_request',
3474 api_name => 'open-ils.acq.user_request.create',
3476 desc => 'Create a new user request object in the DB',
3478 { desc => 'Authentication token', type => 'string' },
3479 { desc => 'User request data hash. Hash keys match the fields for the "aur" object', type => 'object' }
3482 desc => 'The created user request object, or event on error'
3487 sub new_user_request {
3488 my($self, $conn, $auth, $form_data) = @_;
3489 my $e = new_editor(xact => 1, authtoken => $auth);
3490 return $e->die_event unless $e->checkauth;
3491 my $rid = $e->requestor->id;
3492 my $target_user_fleshed;
3493 if (! defined $$form_data{'usr'}) {
3494 $$form_data{'usr'} = $rid;
3496 if ($$form_data{'usr'} != $rid) {
3497 # See if the requestor can place the request on behalf of a different user.
3498 $target_user_fleshed = $e->retrieve_actor_user($$form_data{'usr'}) or return $e->die_event;
3499 $e->allowed('user_request.create', $target_user_fleshed->home_ou) or return $e->die_event;
3501 $target_user_fleshed = $e->requestor;
3502 $e->allowed('CREATE_PURCHASE_REQUEST') or return $e->die_event;
3504 if (! defined $$form_data{'pickup_lib'}) {
3505 if ($target_user_fleshed->ws_ou) {
3506 $$form_data{'pickup_lib'} = $target_user_fleshed->ws_ou;
3508 $$form_data{'pickup_lib'} = $target_user_fleshed->home_ou;
3511 if (! defined $$form_data{'request_type'}) {
3512 $$form_data{'request_type'} = 1; # Books
3514 my $aur_obj = new Fieldmapper::acq::user_request;
3516 $aur_obj->usr( $$form_data{'usr'} );
3517 $aur_obj->request_date( 'now' );
3518 for my $field ( keys %$form_data ) {
3519 if (defined $$form_data{$field} and $field !~ /^(id|lineitem|eg_bib|request_date|cancel_reason)$/) {
3520 $aur_obj->$field( $$form_data{$field} );
3524 $aur_obj = $e->create_acq_user_request($aur_obj) or return $e->die_event;
3526 $e->commit and create_user_request_events( $e, [ $aur_obj ], 'aur.created' );
3531 sub create_user_request_events {
3532 my($e, $user_reqs, $hook) = @_;
3534 my $ses = OpenSRF::AppSession->create('open-ils.trigger');
3537 my %cached_usr_home_ou = ();
3538 for my $user_req (@$user_reqs) {
3539 my $home_ou = $cached_usr_home_ou{$user_req->usr};
3541 my $user = $e->retrieve_actor_user($user_req->usr) or return $e->die_event;
3542 $home_ou = $user->home_ou;
3543 $cached_usr_home_ou{$user_req->usr} = $home_ou;
3545 my $req = $ses->request('open-ils.trigger.event.autocreate', $hook, $user_req, $home_ou);
3554 __PACKAGE__->register_method(
3555 method => "po_note_CUD_batch",
3556 api_name => "open-ils.acq.po_note.cud.batch",
3559 desc => q/Manage purchase order notes/,
3561 {desc => "Authentication token", type => "string"},
3562 {desc => "List of po_notes to manage", type => "array"},
3564 return => {desc => "Stream of successfully managed objects"}
3568 sub po_note_CUD_batch {
3569 my ($self, $conn, $auth, $notes) = @_;
3571 my $e = new_editor("xact"=> 1, "authtoken" => $auth);
3572 return $e->die_event unless $e->checkauth;
3575 my $total = @$notes;
3578 foreach my $note (@$notes) {
3580 $note->editor($e->requestor->id);
3581 $note->edit_time("now");
3584 $note->creator($e->requestor->id);
3585 $note = $e->create_acq_po_note($note) or return $e->die_event;
3586 } elsif ($note->isdeleted) {
3587 $e->delete_acq_po_note($note) or return $e->die_event;
3588 } elsif ($note->ischanged) {
3589 $e->update_acq_po_note($note) or return $e->die_event;
3592 unless ($note->isdeleted) {
3593 $note = $e->retrieve_acq_po_note($note->id) or
3594 return $e->die_event;
3598 {"maximum" => $total, "progress" => ++$count, "note" => $note}
3602 $e->commit and $conn->respond_complete or return $e->die_event;
3606 # retrieves a lineitem, fleshes its PO and PL, checks perms
3607 # returns ($li, $evt, $org)
3608 sub fetch_and_check_li {
3611 my $perm_mode = shift || 'read';
3613 my $li = $e->retrieve_acq_lineitem([
3616 flesh_fields => {jub => ['purchase_order', 'picklist']}
3618 ]) or return (undef, $e->die_event);
3621 if(my $po = $li->purchase_order) {
3622 $org = $po->ordering_agency;
3623 my $perms = ($perm_mode eq 'read') ? 'VIEW_PURCHASE_ORDER' : 'CREATE_PURCHASE_ORDER';
3624 return ($li, $e->die_event) unless $e->allowed($perms, $org);
3626 } elsif(my $pl = $li->picklist) {
3627 $org = $pl->org_unit;
3628 my $perms = ($perm_mode eq 'read') ? 'VIEW_PICKLIST' : 'CREATE_PICKLIST';
3629 return ($li, $e->die_event) unless $e->allowed($perms, $org);
3632 return ($li, undef, $org);
3636 __PACKAGE__->register_method(
3637 method => "clone_distrib_form",
3638 api_name => "open-ils.acq.distribution_formula.clone",
3641 desc => q/Clone a distribution formula/,
3643 {desc => "Authentication token", type => "string"},
3644 {desc => "Original formula ID", type => 'integer'},
3645 {desc => "Name of new formula", type => 'string'},
3647 return => {desc => "ID of newly created formula"}
3651 sub clone_distrib_form {
3652 my($self, $client, $auth, $form_id, $new_name) = @_;
3654 my $e = new_editor("xact"=> 1, "authtoken" => $auth);
3655 return $e->die_event unless $e->checkauth;
3657 my $old_form = $e->retrieve_acq_distribution_formula($form_id) or return $e->die_event;
3658 return $e->die_event unless $e->allowed('ADMIN_ACQ_DISTRIB_FORMULA', $old_form->owner);
3660 my $new_form = Fieldmapper::acq::distribution_formula->new;
3662 $new_form->owner($old_form->owner);
3663 $new_form->name($new_name);
3664 $e->create_acq_distribution_formula($new_form) or return $e->die_event;
3666 my $entries = $e->search_acq_distribution_formula_entry({formula => $form_id});
3667 for my $entry (@$entries) {
3668 my $new_entry = Fieldmapper::acq::distribution_formula_entry->new;
3669 $new_entry->$_($entry->$_()) for $entry->real_fields;
3670 $new_entry->formula($new_form->id);
3671 $new_entry->clear_id;
3672 $e->create_acq_distribution_formula_entry($new_entry) or return $e->die_event;
3676 return $new_form->id;
3679 __PACKAGE__->register_method(
3680 method => 'add_li_to_po',
3681 api_name => 'open-ils.acq.purchase_order.add_lineitem',
3683 desc => q/Adds a lineitem to an existing purchase order/,
3685 {desc => 'Authentication token', type => 'string'},
3686 {desc => 'The purchase order id', type => 'number'},
3687 {desc => 'The lineitem ID (or an array of them)', type => 'mixed'},
3689 return => {desc => 'Streams a total versus completed counts object, event on error'}
3694 my($self, $conn, $auth, $po_id, $li_id) = @_;
3696 my $e = new_editor(authtoken => $auth, xact => 1);
3697 return $e->die_event unless $e->checkauth;
3699 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
3701 my $po = $e->retrieve_acq_purchase_order($po_id)
3702 or return $e->die_event;
3704 return $e->die_event unless
3705 $e->allowed('CREATE_PURCHASE_ORDER', $po->ordering_agency);
3707 unless ($po->state =~ /new|pending/) {
3709 return {success => 0, po => $po, error => 'bad-po-state'};
3714 if (ref $li_id eq "ARRAY") {
3715 $li_id = [ map { int($_) } @$li_id ];
3716 return $e->die_event(new OpenILS::Event("BAD_PARAMS")) unless @$li_id;
3718 $lis = $e->search_acq_lineitem({id => $li_id})
3719 or return $e->die_event;
3721 my $li = $e->retrieve_acq_lineitem(int($li_id))
3722 or return $e->die_event;
3726 foreach my $li (@$lis) {
3727 if ($li->state !~ /new|order-ready|pending-order/ or
3728 $li->purchase_order) {
3730 return {success => 0, li => $li, error => 'bad-li-state'};
3733 $li->provider($po->provider);
3734 $li->purchase_order($po_id);
3735 $li->state('pending-order');
3736 apply_default_copies($mgr, $po, $li->id) or return $e->die_event;
3737 update_lineitem($mgr, $li) or return $e->die_event;
3741 return {success => 1};
3744 __PACKAGE__->register_method(
3745 method => 'po_lineitems_no_copies',
3746 api_name => 'open-ils.acq.purchase_order.no_copy_lineitems.id_list',
3750 desc => q/Returns the set of lineitem IDs for a given PO that have no copies attached/,
3752 {desc => 'Authentication token', type => 'string'},
3753 {desc => 'The purchase order id', type => 'number'},
3755 return => {desc => 'Stream of lineitem IDs on success, event on error'}
3759 sub po_lineitems_no_copies {
3760 my ($self, $conn, $auth, $po_id) = @_;
3762 my $e = new_editor(authtoken => $auth);
3763 return $e->event unless $e->checkauth;
3765 # first check the view perms for LI's attached to this PO
3766 my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->event;
3767 return $e->event unless $e->allowed('VIEW_PURCHASE_ORDER', $po->ordering_agency);
3769 my $ids = $e->json_query({
3770 select => {jub => ['id']},
3771 from => {jub => {acqlid => {type => 'left'}}},
3773 '+jub' => {purchase_order => $po_id},
3774 '+acqlid' => {lineitem => undef}
3778 $conn->respond($_->{id}) for @$ids;
3782 __PACKAGE__->register_method(
3783 method => 'set_li_order_ident',
3784 api_name => 'open-ils.acq.lineitem.order_identifier.set',
3787 Given an existing lineitem_attr (typically a marc_attr), this will
3788 create a matching local_attr to store the name and value and mark
3789 the attr as the order_ident. Any existing local_attr marked as
3790 order_ident is removed.
3793 {desc => 'Authentication token', type => 'string'},
3794 {desc => q/Args object:
3795 source_attr_id : ID of the existing lineitem_attr to use as
3797 lineitem_id : lineitem id
3798 attr_name : name ('isbn', etc.) of a new marc_attr to add to
3799 the lineitem to use for the order ident
3800 attr_value : value for the new marc_attr
3801 no_apply_bre : if set, newly added attrs will not be applied
3802 to the lineitems' linked bib record/,
3805 return => {desc => q/Returns the attribute
3806 responsible for tracking the order identifier/}
3810 sub set_li_order_ident {
3811 my ($self, $conn, $auth, $args) = @_;
3815 my $source_attr_id = $args->{source_attr_id};
3817 my $e = new_editor(authtoken => $auth, xact => 1);
3818 return $e->die_event unless $e->checkauth;
3820 # fetch attr, LI, and check update permissions
3822 my $li_id = $args->{lineitem_id};
3824 if ($source_attr_id) {
3825 $source_attr = $e->retrieve_acq_lineitem_attr($source_attr_id)
3826 or return $e->die_event;
3827 $li_id = $source_attr->lineitem;
3830 my ($li, $evt, $perm_org) = fetch_and_check_li($e, $li_id, 'write');
3831 return $evt if $evt;
3833 return $e->die_event unless
3834 $e->allowed('ACQ_SET_LINEITEM_IDENTIFIER', $perm_org);
3836 # if needed, create a new marc attr for
3837 # the lineitem to represent the ident value
3839 ($source_attr, $evt) = apply_new_li_ident_attr(
3840 $e, $li, $perm_org, $args->{attr_name}, $args->{attr_value})
3841 unless $source_attr;
3843 return $evt if $evt;
3845 # remove the existing order_ident attribute if present
3847 my $old_attr = $e->search_acq_lineitem_attr({
3848 attr_type => 'lineitem_local_attr_definition',
3849 lineitem => $li->id,
3855 # if we already have an order_ident that matches the
3856 # source attr, there's nothing left to do.
3858 if ($old_attr->attr_name eq $source_attr->attr_name and
3859 $old_attr->attr_value eq $source_attr->attr_value) {
3865 # remove the old order_ident attribute
3866 $e->delete_acq_lineitem_attr($old_attr) or return $e->die_event;
3870 # make sure we have a local_attr_def to match the source attr def
3872 my $local_def = $e->search_acq_lineitem_local_attr_definition({
3873 code => $source_attr->attr_name
3878 $e->retrieve_acq_lineitem_attr_definition($source_attr->definition);
3879 $local_def = Fieldmapper::acq::lineitem_local_attr_definition->new;
3880 $local_def->code($source_def->code);
3881 $local_def->description($source_def->description);
3882 $local_def = $e->create_acq_lineitem_local_attr_definition($local_def)
3883 or return $e->die_event;
3886 # create the new order_ident local attr
3888 my $new_attr = Fieldmapper::acq::lineitem_attr->new;
3889 $new_attr->definition($local_def->id);
3890 $new_attr->attr_type('lineitem_local_attr_definition');
3891 $new_attr->lineitem($li->id);
3892 $new_attr->attr_name($source_attr->attr_name);
3893 $new_attr->attr_value($source_attr->attr_value);
3894 $new_attr->order_ident('t');
3896 $new_attr = $e->create_acq_lineitem_attr($new_attr)
3897 or return $e->die_event;
3904 # Given an isbn, issn, or upc, add the value to the lineitem marc.
3905 # Upon update, the value will be auto-magically represented as
3906 # a lineitem marc attr.
3907 # If the li is linked to a bib record and the user has the correct
3908 # permissions, update the bib record to match.
3909 sub apply_new_li_ident_attr {
3910 my ($e, $li, $perm_org, $attr_name, $attr_value) = @_;
3918 my $marc_field = MARC::Field->new(
3919 $tags{$attr_name}, '', '','a' => $attr_value);
3921 my $li_rec = MARC::Record->new_from_xml($li->marc, 'UTF-8', 'USMARC');
3922 $li_rec->insert_fields_ordered($marc_field);
3924 $li->marc(clean_marc($li_rec));
3925 $li->editor($e->requestor->id);
3926 $li->edit_time('now');
3928 $e->update_acq_lineitem($li) or return (undef, $e->die_event);
3930 my $source_attr = $e->search_acq_lineitem_attr({
3931 attr_name => $attr_name,
3932 attr_value => $attr_value,
3933 attr_type => 'lineitem_marc_attr_definition'
3936 if (!$source_attr) {
3937 $logger->error("ACQ lineitem update failed to produce a matching ".
3938 " marc attribute for $attr_name => $attr_value");
3939 return (undef, OpenILS::Event->new('INTERNAL_SERVER_ERROR'));
3942 return ($source_attr) unless
3944 $e->allowed('ACQ_ADD_LINEITEM_IDENTIFIER', $perm_org);
3946 # li is linked to a bib record and user has the update perms
3948 my $bre = $e->retrieve_biblio_record_entry($li->eg_bib_id);
3949 my $bre_marc = MARC::Record->new_from_xml($bre->marc, 'UTF-8', 'USMARC');
3950 $bre_marc->insert_fields_ordered($marc_field);
3952 $bre->marc(clean_marc($bre_marc));
3953 $bre->editor($e->requestor->id);
3954 $bre->edit_date('now');
3956 $e->update_biblio_record_entry($bre) or return (undef, $e->die_event);
3958 return ($source_attr);
3961 __PACKAGE__->register_method(
3962 method => 'li_existing_copies',
3963 api_name => 'open-ils.acq.lineitem.existing_copies.count',
3967 Returns the number of catalog copies (acp) which are children of
3968 the same bib record linked to by the given lineitem and which
3969 are owned at or below the lineitem context org unit.
3970 Copies with the following statuses are not counted:
3971 Lost, Missing, Discard Weed, and Lost and Paid.
3974 {desc => 'Authentication token', type => 'string'},
3975 {desc => 'Lineitem ID', type => 'number'}
3977 return => {desc => q/Count or event on error/}
3981 sub li_existing_copies {
3982 my ($self, $client, $auth, $li_id) = @_;
3983 my $e = new_editor("authtoken" => $auth);
3984 return $e->die_event unless $e->checkauth;
3986 my ($li, $evt, $org) = fetch_and_check_li($e, $li_id);
3989 # No fuzzy matching here (e.g. on ISBN). Only exact matches are supported.
3990 return 0 unless $li->eg_bib_id;
3992 my $counts = $e->json_query({
3993 select => {acp => [{
3995 transform => 'count',
4002 field => 'eg_copy_id',
4005 acn => {join => {bre => {}}}
4009 '+bre' => {id => $li->eg_bib_id},
4010 # don't count copies linked to the lineitem in question
4013 {lineitem => undef},
4014 {lineitem => {'<>' => $li_id}}
4018 owning_lib => $U->get_org_descendants($org)
4020 # NOTE: should the excluded copy statuses be an AOUS?
4021 '+acp' => {status => {'not in' => [3, 4, 13, 17]}}
4025 return $counts->[0]->{id};