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;
7 # empirically derived number of responses we can
8 # stream back before the XUL client has indigestion
9 use constant MAX_RESPONSES => 20;
12 my($class, %args) = @_;
13 my $self = bless(\%args, $class);
22 purchase_order => undef,
30 $self->throttle(4) unless $self->throttle;
31 $self->exponential_falloff(1) unless $self->exponential_falloff;
32 $self->{post_proc_queue} = [];
33 $self->{last_respond_progress} = 0;
39 $self->{conn} = $val if $val;
44 $self->{throttle} = $val if $val;
45 return $self->{throttle};
47 sub exponential_falloff {
49 $self->{exponential_falloff} = $val if defined $val;
50 return $self->{exponential_falloff};
53 my($self, %other_args) = @_;
54 if($self->throttle and not %other_args) {
56 ($self->{args}->{progress} - $self->{last_respond_progress}) >= $self->throttle
59 $self->conn->respond({ %{$self->{args}}, %other_args });
60 $self->{last_respond_progress} = $self->{args}->{progress};
61 $self->throttle($self->throttle * 2) if ($self->exponential_falloff() and $self->throttle < 256);
63 sub respond_complete {
64 my($self, %other_args) = @_;
66 $self->conn->respond_complete({ %{$self->{args}}, %other_args });
67 $self->run_post_response_hooks;
71 # run the post response hook subs, shifting them off as we go
72 sub run_post_response_hooks {
74 (shift @{$self->{post_proc_queue}})->() while @{$self->{post_proc_queue}};
77 # any subs passed to this method will be run after the call to respond_complete
80 push(@{$self->{post_proc_queue}}, $sub);
85 $self->{args}->{total} = $val if defined $val;
86 $self->{args}->{maximum} = $self->{args}->{total};
87 if ($self->{args}->{maximum}) {
88 # if a total has been set, space responses linearly
89 $self->exponential_falloff(0);
90 $self->throttle(int($self->{args}->{maximum} / MAX_RESPONSES));
91 $self->throttle(4) if $self->throttle < 4;
93 return $self->{args}->{total};
97 $self->{args}->{purchase_order} = $val if $val;
101 my($self, $val) = @_;
102 $self->{args}->{picklist} = $val if $val;
107 $self->{args}->{lid} += 1;
108 $self->{args}->{progress} += 1;
113 $self->{args}->{li} += 1;
114 $self->{args}->{progress} += 1;
119 $self->{args}->{vqbr} += 1;
120 $self->{args}->{progress} += 1;
125 $self->{args}->{copies} += 1;
126 $self->{args}->{progress} += 1;
131 $self->{args}->{bibs} += 1;
132 $self->{args}->{progress} += 1;
136 my($self, $amount) = @_;
137 $self->{args}->{debits_accrued} += $amount;
138 $self->{args}->{progress} += 1;
142 my($self, $editor) = @_;
143 $self->{editor} = $editor if defined $editor;
144 return $self->{editor};
148 $self->{args}->{complete} = 1;
153 my($self, $org, $key, $val) = @_;
154 $self->{cache}->{$org} = {} unless $self->{cache}->{org};
155 $self->{cache}->{$org}->{$key} = $val if defined $val;
156 return $self->{cache}->{$org}->{$key};
160 package OpenILS::Application::Acq::Order;
161 use base qw/OpenILS::Application/;
162 use strict; use warnings;
163 # ----------------------------------------------------------------------------
164 # Break up each component of the order process and pieces into managable
165 # actions that can be shared across different workflows
166 # ----------------------------------------------------------------------------
168 use OpenSRF::Utils::Logger qw(:logger);
169 use OpenSRF::Utils::JSON;
170 use OpenSRF::AppSession;
171 use OpenILS::Utils::Fieldmapper;
172 use OpenILS::Utils::CStoreEditor q/:funcs/;
173 use OpenILS::Utils::Normalize qw/clean_marc/;
174 use OpenILS::Const qw/:const/;
175 use OpenSRF::EX q/:try/;
176 use OpenILS::Application::AppUtils;
177 use OpenILS::Application::Cat::BibCommon;
178 use OpenILS::Application::Cat::AssetCommon;
181 use MARC::File::XML (BinaryEncoding => 'UTF-8');
182 use Digest::MD5 qw(md5_hex);
184 $Data::Dumper::Indent = 0;
185 my $U = 'OpenILS::Application::AppUtils';
188 # ----------------------------------------------------------------------------
190 # ----------------------------------------------------------------------------
191 sub create_lineitem {
192 my($mgr, %args) = @_;
193 my $li = Fieldmapper::acq::lineitem->new;
194 $li->creator($mgr->editor->requestor->id);
195 $li->selector($li->creator);
196 $li->editor($li->creator);
197 $li->create_time('now');
198 $li->edit_time('now');
200 $li->$_($args{$_}) for keys %args;
203 $mgr->editor->create_acq_lineitem($li) or return 0;
205 unless($li->estimated_unit_price) {
206 # extract the price from the MARC data
207 my $price = get_li_price_from_attr($mgr->editor, $li) or return $li;
208 $li->estimated_unit_price($price);
209 return update_lineitem($mgr, $li);
215 sub get_li_price_from_attr {
217 my $attrs = $li->attributes || $e->search_acq_lineitem_attr({lineitem => $li->id});
219 for my $attr_type (qw/
220 lineitem_local_attr_definition
221 lineitem_prov_attr_definition
222 lineitem_marc_attr_definition/) {
225 $_->attr_name eq 'estimated_price' and
226 $_->attr_type eq $attr_type } @$attrs;
228 return $attr->attr_value if $attr;
235 sub update_lineitem {
237 $li->edit_time('now');
238 $li->editor($mgr->editor->requestor->id);
240 return $mgr->editor->retrieve_acq_lineitem($mgr->editor->data) if
241 $mgr->editor->update_acq_lineitem($li);
246 # ----------------------------------------------------------------------------
247 # Create real holds from patron requests for a given lineitem
248 # ----------------------------------------------------------------------------
249 sub promote_lineitem_holds {
252 my $requests = $mgr->editor->search_acq_user_request(
253 { lineitem => $li->id,
255 [ { need_before => {'>' => 'now'} },
256 { need_before => undef }
261 for my $request ( @$requests ) {
263 $request->eg_bib( $li->eg_bib_id );
264 $mgr->editor->update_acq_user_request( $request ) or return 0;
266 next unless ($U->is_true( $request->hold ));
268 my $hold = Fieldmapper::action::hold_request->new;
269 $hold->usr( $request->usr );
270 $hold->requestor( $request->usr );
271 $hold->request_time( $request->request_date );
272 $hold->pickup_lib( $request->pickup_lib );
273 $hold->request_lib( $request->pickup_lib );
274 $hold->selection_ou( $request->pickup_lib );
275 $hold->phone_notify( $request->phone_notify );
276 $hold->email_notify( $request->email_notify );
277 $hold->expire_time( $request->need_before );
279 if ($request->holdable_formats) {
280 my $mrm = $mgr->editor->search_metabib_metarecord_source_map( { source => $li->eg_bib_id } )->[0];
282 $hold->hold_type( 'M' );
283 $hold->holdable_formats( $request->holdable_formats );
284 $hold->target( $mrm->metarecord );
288 if (!$hold->target) {
289 $hold->hold_type( 'T' );
290 $hold->target( $li->eg_bib_id );
293 # if behind-the-desk holds are supported at the
294 # pickup library, apply the patron default
295 my $bdous = $U->ou_ancestor_setting_value(
297 'circ.holds.behind_desk_pickup_supported',
302 my $set = $mgr->editor->search_actor_user_setting(
303 {usr => $hold->usr, name => 'circ.holds_behind_desk'})->[0];
305 $hold->behind_desk('t') if $set and
306 OpenSRF::Utils::JSON->JSON2perl($set->value);
309 $mgr->editor->create_action_hold_request( $hold ) or return 0;
315 sub delete_lineitem {
317 $li = $mgr->editor->retrieve_acq_lineitem($li) unless ref $li;
319 # delete the attached lineitem_details
320 my $lid_ids = $mgr->editor->search_acq_lineitem_detail({lineitem => $li->id}, {idlist=>1});
321 for my $lid_id (@$lid_ids) {
322 return 0 unless delete_lineitem_detail($mgr, $lid_id);
326 return $mgr->editor->delete_acq_lineitem($li);
329 # begins and commit transactions as it goes
330 # bib_only exits before creation of copies and callnumbers
331 sub create_lineitem_list_assets {
332 my($mgr, $li_ids, $vandelay, $bib_only) = @_;
334 # Do not create line items if none are specified
335 return {} unless (scalar(@$li_ids));
337 if (check_import_li_marc_perms($mgr, $li_ids)) { # event on error
338 $logger->error("acq-vl: user does not have permission to import acq records");
342 my $res = import_li_bibs_via_vandelay($mgr, $li_ids, $vandelay);
343 return undef unless $res;
344 return $res if $bib_only;
346 # create the bibs/volumes/copies for the successfully imported records
347 for my $li_id (@{$res->{li_ids}}) {
348 $mgr->editor->xact_begin;
349 my $data = create_lineitem_assets($mgr, $li_id) or return undef;
350 $mgr->editor->xact_commit;
357 sub test_vandelay_import_args {
358 my $vandelay = shift;
359 my $q_needed = shift;
361 # we need valid args and (sometimes) a queue
362 return 0 unless $vandelay and (
364 $vandelay->{queue_name} or
365 $vandelay->{existing_queue}
368 # match-based merge/overlay import
369 return 2 if $vandelay->{merge_profile} and (
370 $vandelay->{auto_overlay_exact} or
371 $vandelay->{auto_overlay_1match} or
372 $vandelay->{auto_overlay_best_match}
376 return 2 if $vandelay->{import_no_match};
378 return 1; # queue only
381 sub find_or_create_vandelay_queue {
382 my ($e, $vandelay) = @_;
385 if (my $name = $vandelay->{queue_name}) {
387 # first, see if a queue w/ this name already exists
388 # for this user. If so, use that instead.
390 $queue = $e->search_vandelay_bib_queue(
391 {name => $name, owner => $e->requestor->id})->[0];
395 $logger->info("acq-vl: using existing queue $name");
399 $logger->info("acq-vl: creating new vandelay queue $name");
401 $queue = new Fieldmapper::vandelay::bib_queue;
403 $queue->queue_type('acq');
404 $queue->owner($e->requestor->id);
405 $queue->match_set($vandelay->{match_set} || undef); # avoid ''
406 $queue = $e->create_vandelay_bib_queue($queue) or return undef;
410 $queue = $e->retrieve_vandelay_bib_queue($vandelay->{existing_queue})
418 sub import_li_bibs_via_vandelay {
419 my ($mgr, $li_ids, $vandelay) = @_;
420 my $res = {li_ids => []};
421 my $e = $mgr->editor;
424 my $needs_importing = $e->search_acq_lineitem(
425 {id => $li_ids, eg_bib_id => undef},
429 if (!@$needs_importing) {
430 $logger->info("acq-vl: all records already imported. no Vandelay work to do");
431 return {li_ids => $li_ids};
434 # see if we have any records that are not yet linked to VL records (i.e.
435 # not in a queue). This will tell us if lack of a queue name is an error.
436 my $non_queued = $e->search_acq_lineitem(
437 {id => $needs_importing, queued_record => undef},
441 # add the already-imported records to the response list
442 push(@{$res->{li_ids}}, grep { $_ != @$needs_importing } @$li_ids);
444 $logger->info("acq-vl: processing recs via Vandelay with args: ".Dumper($vandelay));
446 my $vl_stat = test_vandelay_import_args($vandelay, scalar(@$non_queued));
448 $logger->error("acq-vl: invalid vandelay arguments for acq import (queue needed)");
454 # when any non-queued lineitems exist, their vandelay counterparts
455 # require a place to live.
456 $queue = find_or_create_vandelay_queue($e, $vandelay) or return $res;
459 # if all lineitems are already queued, the queue reported to the user
460 # is purely for information / convenience. pick a random queue.
461 $queue = $e->retrieve_acq_lineitem([
462 $needs_importing->[0], {
465 jub => ['queued_record'],
469 ])->queued_record->queue;
472 $mgr->{args}->{queue} = $queue;
474 # load the lineitems into the queue for merge processing
477 for my $li_id (@$needs_importing) {
479 my $li = $e->retrieve_acq_lineitem($li_id) or return $res;
481 if ($li->queued_record) {
482 $logger->info("acq-vl: $li_id already linked to a vandelay record");
483 push(@vqbr_ids, $li->queued_record);
486 $logger->info("acq-vl: creating new vandelay record for lineitem $li_id");
488 # create a new VL queued record and link it up
489 my $vqbr = Fieldmapper::vandelay::queued_bib_record->new;
490 $vqbr->marc($li->marc);
491 $vqbr->queue($queue->id);
492 $vqbr->bib_source($vandelay->{bib_source} || undef); # avoid ''
493 $vqbr = $e->create_vandelay_queued_bib_record($vqbr) or return $res;
494 push(@vqbr_ids, $vqbr->id);
496 # tell the acq record which vandelay record it's linked to
497 $li->queued_record($vqbr->id);
498 $e->update_acq_lineitem($li) or return $res;
506 $logger->info("acq-vl: created vandelay records [@vqbr_ids]");
508 # we have to commit the transaction now since
509 # vandelay uses its own transactions.
512 return $res if $vl_stat == 1; # queue only
514 # Import the bibs via vandelay. Note: Vandely will
515 # update acq.lineitem.eg_bib_id on successful import.
517 $vandelay->{report_all} = 1;
518 my $ses = OpenSRF::AppSession->create('open-ils.vandelay');
519 my $req = $ses->request(
520 'open-ils.vandelay.bib_record.list.import',
521 $e->authtoken, \@vqbr_ids, $vandelay);
523 # pull the responses, noting all that were successfully imported
525 while (my $resp = $req->recv(timeout => 600)) {
526 my $stat = $resp->content;
528 if(!$stat or $U->event_code($stat)) { # import failure
529 $logger->error("acq-vl: error importing vandelay record " . Dumper($stat));
533 # "imported" refers to the vqbr id, not the
534 # success/failure of the vqbr merge attempt
535 next unless $stat->{imported};
537 my ($imported) = grep {$_->queued_record eq $stat->{imported}} @lis;
538 my $li_id = $imported->id;
540 if ($stat->{no_import}) {
541 $logger->info("acq-vl: acq lineitem $li_id did not import");
543 } else { # successful import
545 push(@success_lis, $li_id);
548 $logger->info("acq-vl: acq lineitem $li_id successfully merged/imported");
553 $logger->info("acq-vl: successfully imported lineitems [@success_lis]");
555 # add the successfully imported lineitems to the already-imported lineitems
556 push (@{$res->{li_ids}}, @success_lis);
561 # returns event on error, undef on success
562 sub check_import_li_marc_perms {
563 my($mgr, $li_ids) = @_;
565 # if there are any order records that are not linked to
566 # in-db bib records, verify staff has perms to import order records
567 my $order_li = $mgr->editor->search_acq_lineitem(
568 [{id => $li_ids, eg_bib_id => undef}, {limit => 1}], {idlist => 1})->[0];
571 return $mgr->editor->die_event unless
572 $mgr->editor->allowed('IMPORT_ACQ_LINEITEM_BIB_RECORD');
579 # ----------------------------------------------------------------------------
580 # if all of the lineitem details for this lineitem have
581 # been received, mark the lineitem as received
582 # returns 1 on non-received, li on received, 0 on error
583 # ----------------------------------------------------------------------------
585 sub describe_affected_po {
588 my ($enc, $spent, $estimated) =
589 OpenILS::Application::Acq::Financials::build_price_summary(
594 "state" => $po->state,
595 "amount_encumbered" => $enc,
596 "amount_spent" => $spent,
597 "amount_estimated" => $estimated
602 sub check_lineitem_received {
603 my($mgr, $li_id) = @_;
605 my $non_recv = $mgr->editor->search_acq_lineitem_detail(
606 {recv_time => undef, lineitem => $li_id}, {idlist=>1});
608 return 1 if @$non_recv;
610 my $li = $mgr->editor->retrieve_acq_lineitem($li_id);
611 $li->state('received');
612 return update_lineitem($mgr, $li);
615 sub receive_lineitem {
616 my($mgr, $li_id, $skip_complete_check) = @_;
617 my $li = $mgr->editor->retrieve_acq_lineitem($li_id) or return 0;
619 return 0 unless $li->state eq 'on-order' or $li->state eq 'cancelled'; # sic
621 $li->clear_cancel_reason; # un-cancel on receive
623 my $lid_ids = $mgr->editor->search_acq_lineitem_detail(
624 {lineitem => $li_id, recv_time => undef}, {idlist => 1});
626 for my $lid_id (@$lid_ids) {
627 receive_lineitem_detail($mgr, $lid_id, 1) or return 0;
631 $li->state('received');
633 $li = update_lineitem($mgr, $li) or return 0;
634 $mgr->post_process( sub { create_lineitem_status_events($mgr, $li_id, 'aur.received'); });
638 $skip_complete_check or (
639 $po = check_purchase_order_received($mgr, $li->purchase_order)
642 my $result = {"li" => {$li->id => {"state" => $li->state}}};
643 $result->{"po"} = describe_affected_po($mgr->editor, $po) if ref $po;
647 sub rollback_receive_lineitem {
648 my($mgr, $li_id) = @_;
649 my $li = $mgr->editor->retrieve_acq_lineitem($li_id) or return 0;
651 my $lid_ids = $mgr->editor->search_acq_lineitem_detail(
652 {lineitem => $li_id, recv_time => {'!=' => undef}}, {idlist => 1});
654 for my $lid_id (@$lid_ids) {
655 rollback_receive_lineitem_detail($mgr, $lid_id, 1) or return 0;
659 $li->state('on-order');
660 return update_lineitem($mgr, $li);
664 sub create_lineitem_status_events {
665 my($mgr, $li_id, $hook) = @_;
667 my $ses = OpenSRF::AppSession->create('open-ils.trigger');
669 my $user_reqs = $mgr->editor->search_acq_user_request([
670 {lineitem => $li_id},
671 {flesh => 1, flesh_fields => {aur => ['usr']}}
674 for my $user_req (@$user_reqs) {
675 my $req = $ses->request('open-ils.trigger.event.autocreate', $hook, $user_req, $user_req->usr->home_ou);
683 # ----------------------------------------------------------------------------
685 # ----------------------------------------------------------------------------
686 sub create_lineitem_detail {
687 my($mgr, %args) = @_;
688 my $lid = Fieldmapper::acq::lineitem_detail->new;
689 $lid->$_($args{$_}) for keys %args;
692 return $mgr->editor->create_acq_lineitem_detail($lid);
696 # flesh out any required data with default values where appropriate
697 sub complete_lineitem_detail {
699 unless($lid->barcode) {
700 my $pfx = $U->ou_ancestor_setting_value($lid->owning_lib, 'acq.tmp_barcode_prefix') || 'ACQ';
701 $lid->barcode($pfx.$lid->id);
704 unless($lid->cn_label) {
705 my $pfx = $U->ou_ancestor_setting_value($lid->owning_lib, 'acq.tmp_callnumber_prefix') || 'ACQ';
706 $lid->cn_label($pfx.$lid->id);
709 if(!$lid->location and my $loc = $U->ou_ancestor_setting_value($lid->owning_lib, 'acq.default_copy_location')) {
710 $lid->location($loc);
713 $lid->circ_modifier(get_default_circ_modifier($mgr, $lid->owning_lib))
714 unless defined $lid->circ_modifier;
716 $mgr->editor->update_acq_lineitem_detail($lid) or return 0;
720 sub get_default_circ_modifier {
722 my $code = $mgr->cache($org, 'def_circ_mod');
723 $code = $U->ou_ancestor_setting_value($org, 'acq.default_circ_modifier') unless defined $code;
724 return $mgr->cache($org, 'def_circ_mod', $code) if defined $code;
728 sub delete_lineitem_detail {
730 $lid = $mgr->editor->retrieve_acq_lineitem_detail($lid) unless ref $lid;
731 return $mgr->editor->delete_acq_lineitem_detail($lid);
735 sub receive_lineitem_detail {
736 my($mgr, $lid_id, $skip_complete_check) = @_;
737 my $e = $mgr->editor;
739 my $lid = $e->retrieve_acq_lineitem_detail([
743 acqlid => ['fund_debit']
748 return 1 if $lid->recv_time;
750 # if the LID is marked as canceled, remove the cancel reason,
751 # and reinstate fund debits where deleted by cancelation.
752 if ($lid->cancel_reason) {
753 my $cr = $e->retrieve_acq_cancel_reason($lid->cancel_reason);
755 if (!$U->is_true($cr->keep_debits)) {
756 # debits were removed during cancelation.
757 create_lineitem_detail_debit(
758 $mgr, $lid->lineitem, $lid) or return 0;
760 $lid->clear_cancel_reason;
763 $lid->receiver($e->requestor->id);
764 $lid->recv_time('now');
765 $e->update_acq_lineitem_detail($lid) or return 0;
767 if ($lid->eg_copy_id) {
768 my $copy = $e->retrieve_asset_copy($lid->eg_copy_id) or return 0;
769 # only update status if it hasn't already been updated
770 $copy->status(OILS_COPY_STATUS_IN_PROCESS) if $copy->status == OILS_COPY_STATUS_ON_ORDER;
771 $copy->edit_date('now');
772 $copy->editor($e->requestor->id);
773 $copy->creator($e->requestor->id) if $U->ou_ancestor_setting_value(
774 $e->requestor->ws_ou, 'acq.copy_creator_uses_receiver', $e);
775 $e->update_asset_copy($copy) or return 0;
780 return 1 if $skip_complete_check;
782 my $li = check_lineitem_received($mgr, $lid->lineitem) or return 0;
783 return 1 if $li == 1; # li not received
785 return check_purchase_order_received($mgr, $li->purchase_order) or return 0;
789 sub rollback_receive_lineitem_detail {
790 my($mgr, $lid_id) = @_;
791 my $e = $mgr->editor;
793 my $lid = $e->retrieve_acq_lineitem_detail([
797 acqlid => ['fund_debit']
802 return 1 unless $lid->recv_time;
804 $lid->clear_receiver;
805 $lid->clear_recv_time;
806 $e->update_acq_lineitem_detail($lid) or return 0;
808 if ($lid->eg_copy_id) {
809 my $copy = $e->retrieve_asset_copy($lid->eg_copy_id) or return 0;
810 $copy->status(OILS_COPY_STATUS_ON_ORDER);
811 $copy->edit_date('now');
812 $copy->editor($e->requestor->id);
813 $e->update_asset_copy($copy) or return 0;
820 # ----------------------------------------------------------------------------
822 # ----------------------------------------------------------------------------
823 sub set_lineitem_attr {
824 my($mgr, %args) = @_;
825 my $attr_type = $args{attr_type};
827 # first, see if it's already set. May just need to overwrite it
828 my $attr = $mgr->editor->search_acq_lineitem_attr({
829 lineitem => $args{lineitem},
830 attr_type => $args{attr_type},
831 attr_name => $args{attr_name}
835 $attr->attr_value($args{attr_value});
836 return $attr if $mgr->editor->update_acq_lineitem_attr($attr);
841 $attr = Fieldmapper::acq::lineitem_attr->new;
842 $attr->$_($args{$_}) for keys %args;
844 unless($attr->definition) {
845 my $find = "search_acq_$attr_type";
846 my $attr_def_id = $mgr->editor->$find({code => $attr->attr_name}, {idlist=>1})->[0] or return 0;
847 $attr->definition($attr_def_id);
849 return $mgr->editor->create_acq_lineitem_attr($attr);
853 # ----------------------------------------------------------------------------
855 # ----------------------------------------------------------------------------
856 sub create_lineitem_debits {
857 my ($mgr, $li, $options) = @_;
859 my $dry_run = $options->{dry_run};
861 unless($li->estimated_unit_price) {
862 $mgr->editor->event(OpenILS::Event->new('ACQ_LINEITEM_NO_PRICE', payload => $li->id));
863 $mgr->editor->rollback;
867 unless($li->provider) {
868 $mgr->editor->event(OpenILS::Event->new('ACQ_LINEITEM_NO_PROVIDER', payload => $li->id));
869 $mgr->editor->rollback;
873 my $lid_ids = $mgr->editor->search_acq_lineitem_detail(
874 {lineitem => $li->id},
878 if (@$lid_ids == 0 and !$options->{zero_copy_activate}) {
879 $mgr->editor->event(OpenILS::Event->new('ACQ_LINEITEM_NO_COPIES', payload => $li->id));
880 $mgr->editor->rollback;
884 for my $lid_id (@$lid_ids) {
886 my $lid = $mgr->editor->retrieve_acq_lineitem_detail([
889 flesh_fields => {acqlid => ['fund']}
893 create_lineitem_detail_debit($mgr, $li, $lid, $dry_run) or return 0;
902 sub create_lineitem_detail_debit {
903 my ($mgr, $li, $lid, $dry_run, $no_translate) = @_;
905 # don't create the debit if one already exists
906 return $mgr->editor->retrieve_acq_fund_debit($lid->fund_debit) if $lid->fund_debit;
908 my $li_id = ref($li) ? $li->id : $li;
910 unless(ref $li and ref $li->provider) {
911 $li = $mgr->editor->retrieve_acq_lineitem([
914 flesh_fields => {jub => ['provider']},
920 $lid->fund($mgr->editor->retrieve_acq_fund($lid->fund)) unless(ref $lid->fund);
922 $lid = $mgr->editor->retrieve_acq_lineitem_detail([
925 flesh_fields => {acqlid => ['fund']}
930 unless ($lid->fund) {
932 new OpenILS::Event("ACQ_FUND_NOT_FOUND") # close enough
937 my $amount = $li->estimated_unit_price;
938 if($li->provider->currency_type ne $lid->fund->currency_type and !$no_translate) {
940 # At Fund debit creation time, translate into the currency of the fund
941 # TODO: org setting to disable automatic currency conversion at debit create time?
943 $amount = $mgr->editor->json_query({
945 'acq.exchange_ratio',
946 $li->provider->currency_type, # source currency
947 $lid->fund->currency_type, # destination currency
948 $li->estimated_unit_price # source amount
950 })->[0]->{'acq.exchange_ratio'};
953 my $debit = create_fund_debit(
956 fund => $lid->fund->id,
957 origin_amount => $li->estimated_unit_price,
958 origin_currency_type => $li->provider->currency_type,
962 $lid->fund_debit($debit->id);
963 $lid->fund($lid->fund->id);
964 $mgr->editor->update_acq_lineitem_detail($lid) or return 0;
969 __PACKAGE__->register_method(
970 "method" => "fund_exceeds_balance_percent_api",
971 "api_name" => "open-ils.acq.fund.check_balance_percentages",
973 "desc" => q/Determine whether a given fund exceeds its defined
974 "balance stop and warning percentages"/,
976 {"desc" => "Authentication token", "type" => "string"},
977 {"desc" => "Fund ID", "type" => "number"},
978 {"desc" => "Theoretical debit amount (optional)",
981 "return" => {"desc" => q/An array of two values, for stop and warning,
982 in that order: 1 if fund exceeds that balance percentage, else 0/}
986 sub fund_exceeds_balance_percent_api {
987 my ($self, $conn, $auth, $fund_id, $debit_amount) = @_;
991 my $e = new_editor("authtoken" => $auth);
992 return $e->die_event unless $e->checkauth;
994 my $fund = $e->retrieve_acq_fund($fund_id) or return $e->die_event;
995 return $e->die_event unless $e->allowed("VIEW_FUND", $fund->org);
998 fund_exceeds_balance_percent($fund, $debit_amount, $e, "stop"),
999 fund_exceeds_balance_percent($fund, $debit_amount, $e, "warning")
1006 sub fund_exceeds_balance_percent {
1007 my ($fund, $debit_amount, $e, $which) = @_;
1009 my ($method_name, $event_name) = @{{
1011 "balance_warning_percent", "ACQ_FUND_EXCEEDS_WARN_PERCENT"
1014 "balance_stop_percent", "ACQ_FUND_EXCEEDS_STOP_PERCENT"
1018 if ($fund->$method_name) {
1020 $e->search_acq_fund_combined_balance({"fund" => $fund->id})->[0];
1022 $e->search_acq_fund_allocation_total({"fund" => $fund->id})->[0];
1024 $balance = ($balance) ? $balance->amount : 0;
1025 $allocations = ($allocations) ? $allocations->amount : 0;
1028 $allocations == 0 || # if no allocations were ever made, assume we have hit the stop percent
1029 ((($allocations - $balance + $debit_amount) / $allocations) * 100) > $fund->$method_name
1031 $logger->info("fund would hit a limit: " . $fund->id . ", $balance, $debit_amount, $allocations, $method_name");
1036 "fund" => $fund, "debit_amount" => $debit_amount
1046 # ----------------------------------------------------------------------------
1048 # ----------------------------------------------------------------------------
1049 sub create_fund_debit {
1050 my($mgr, $dry_run, %args) = @_;
1052 # Verify the fund is not being spent beyond the hard stop amount
1053 my $fund = $mgr->editor->retrieve_acq_fund($args{fund}) or return 0;
1056 fund_exceeds_balance_percent(
1057 $fund, $args{"amount"}, $mgr->editor, "stop"
1060 $dry_run and fund_exceeds_balance_percent(
1061 $fund, $args{"amount"}, $mgr->editor, "warning"
1064 my $debit = Fieldmapper::acq::fund_debit->new;
1065 $debit->debit_type('purchase');
1066 $debit->encumbrance('t');
1067 $debit->$_($args{$_}) for keys %args;
1069 $mgr->add_debit($debit->amount);
1070 return $mgr->editor->create_acq_fund_debit($debit);
1074 # ----------------------------------------------------------------------------
1076 # ----------------------------------------------------------------------------
1077 sub create_picklist {
1078 my($mgr, %args) = @_;
1079 my $picklist = Fieldmapper::acq::picklist->new;
1080 $picklist->creator($mgr->editor->requestor->id);
1081 $picklist->owner($picklist->creator);
1082 $picklist->editor($picklist->creator);
1083 $picklist->create_time('now');
1084 $picklist->edit_time('now');
1085 $picklist->org_unit($mgr->editor->requestor->ws_ou);
1086 $picklist->owner($mgr->editor->requestor->id);
1087 $picklist->$_($args{$_}) for keys %args;
1088 $picklist->clear_id;
1089 $mgr->picklist($picklist);
1090 return $mgr->editor->create_acq_picklist($picklist);
1093 sub update_picklist {
1094 my($mgr, $picklist) = @_;
1095 $picklist = $mgr->editor->retrieve_acq_picklist($picklist) unless ref $picklist;
1096 $picklist->edit_time('now');
1097 $picklist->editor($mgr->editor->requestor->id);
1098 if ($mgr->editor->update_acq_picklist($picklist)) {
1099 $picklist = $mgr->editor->retrieve_acq_picklist($mgr->editor->data);
1100 $mgr->picklist($picklist);
1107 sub delete_picklist {
1108 my($mgr, $picklist) = @_;
1109 $picklist = $mgr->editor->retrieve_acq_picklist($picklist) unless ref $picklist;
1111 # delete all 'new' lineitems
1112 my $li_ids = $mgr->editor->search_acq_lineitem(
1114 picklist => $picklist->id,
1115 "-or" => {state => "new", purchase_order => undef}
1119 for my $li_id (@$li_ids) {
1120 my $li = $mgr->editor->retrieve_acq_lineitem($li_id);
1121 return 0 unless delete_lineitem($mgr, $li);
1125 # detach all non-'new' lineitems
1126 $li_ids = $mgr->editor->search_acq_lineitem({picklist => $picklist->id, state => {'!=' => 'new'}}, {idlist => 1});
1127 for my $li_id (@$li_ids) {
1128 my $li = $mgr->editor->retrieve_acq_lineitem($li_id);
1129 $li->clear_picklist;
1130 return 0 unless update_lineitem($mgr, $li);
1134 # remove any picklist-specific object perms
1135 my $ops = $mgr->editor->search_permission_usr_object_perm_map({object_type => 'acqpl', object_id => ''.$picklist->id});
1136 for my $op (@$ops) {
1137 return 0 unless $mgr->editor->delete_usr_object_perm_map($op);
1140 return $mgr->editor->delete_acq_picklist($picklist);
1143 # ----------------------------------------------------------------------------
1145 # ----------------------------------------------------------------------------
1146 sub update_purchase_order {
1148 $po = $mgr->editor->retrieve_acq_purchase_order($po) unless ref $po;
1149 $po->editor($mgr->editor->requestor->id);
1150 $po->edit_time('now');
1151 $mgr->purchase_order($po);
1152 return $mgr->editor->retrieve_acq_purchase_order($mgr->editor->data)
1153 if $mgr->editor->update_acq_purchase_order($po);
1157 sub create_purchase_order {
1158 my($mgr, %args) = @_;
1160 # verify the chosen provider is still active
1161 my $provider = $mgr->editor->retrieve_acq_provider($args{provider}) or return 0;
1162 unless($U->is_true($provider->active)) {
1163 $logger->error("provider is not active. cannot create PO");
1164 $mgr->editor->event(OpenILS::Event->new('ACQ_PROVIDER_INACTIVE'));
1168 my $po = Fieldmapper::acq::purchase_order->new;
1169 $po->creator($mgr->editor->requestor->id);
1170 $po->editor($mgr->editor->requestor->id);
1171 $po->owner($mgr->editor->requestor->id);
1172 $po->edit_time('now');
1173 $po->create_time('now');
1174 $po->state('pending');
1175 $po->ordering_agency($mgr->editor->requestor->ws_ou);
1176 $po->$_($args{$_}) for keys %args;
1178 $mgr->purchase_order($po);
1179 return $mgr->editor->create_acq_purchase_order($po);
1182 # ----------------------------------------------------------------------------
1183 # if all of the lineitems for this PO are received,
1184 # mark the PO as received
1185 # ----------------------------------------------------------------------------
1186 sub check_purchase_order_received {
1187 my($mgr, $po_id) = @_;
1189 my $non_recv_li = $mgr->editor->search_acq_lineitem(
1190 { purchase_order => $po_id,
1191 state => {'!=' => 'received'}
1194 my $po = $mgr->editor->retrieve_acq_purchase_order($po_id);
1195 return $po if @$non_recv_li;
1197 $po->state('received');
1198 return update_purchase_order($mgr, $po);
1202 # ----------------------------------------------------------------------------
1203 # Bib, Callnumber, and Copy data
1204 # ----------------------------------------------------------------------------
1206 sub create_lineitem_assets {
1207 my($mgr, $li_id) = @_;
1210 my $li = $mgr->editor->retrieve_acq_lineitem([
1213 flesh_fields => {jub => ['purchase_order', 'attributes']}
1217 # note: at this point, the bib record this LI links to should already be created
1219 # -----------------------------------------------------------------
1220 # The lineitem is going live, promote user request holds to real holds
1221 # -----------------------------------------------------------------
1222 promote_lineitem_holds($mgr, $li) or return 0;
1224 my $li_details = $mgr->editor->search_acq_lineitem_detail({lineitem => $li_id}, {idlist=>1});
1226 # -----------------------------------------------------------------
1227 # for each lineitem_detail, create the volume if necessary, create
1228 # a copy, and link them all together.
1229 # -----------------------------------------------------------------
1231 for my $lid_id (@{$li_details}) {
1233 my $lid = $mgr->editor->retrieve_acq_lineitem_detail($lid_id) or return 0;
1234 next if $lid->eg_copy_id;
1236 # use the same callnumber label for all items within this lineitem
1237 $lid->cn_label($first_cn) if $first_cn and not $lid->cn_label;
1239 # apply defaults if necessary
1240 return 0 unless complete_lineitem_detail($mgr, $lid);
1242 $first_cn = $lid->cn_label unless $first_cn;
1244 my $org = $lid->owning_lib;
1245 my $label = $lid->cn_label;
1246 my $bibid = $li->eg_bib_id;
1248 my $volume = $mgr->cache($org, "cn.$bibid.$label");
1250 $volume = create_volume($mgr, $li, $lid) or return 0;
1251 $mgr->cache($org, "cn.$bibid.$label", $volume);
1253 create_copy($mgr, $volume, $lid, $li) or return 0;
1256 return { li => $li };
1260 my($mgr, $li, $lid) = @_;
1262 my ($volume, $evt) =
1263 OpenILS::Application::Cat::AssetCommon->find_or_create_volume(
1271 $mgr->editor->event($evt);
1279 my($mgr, $volume, $lid, $li) = @_;
1280 my $copy = Fieldmapper::asset::copy->new;
1282 $copy->loan_duration(2);
1283 $copy->fine_level(2);
1284 $copy->status(($lid->recv_time) ? OILS_COPY_STATUS_IN_PROCESS : OILS_COPY_STATUS_ON_ORDER);
1285 $copy->barcode($lid->barcode);
1286 $copy->location($lid->location);
1287 $copy->call_number($volume->id);
1288 $copy->circ_lib($volume->owning_lib);
1289 $copy->circ_modifier($lid->circ_modifier);
1291 # AKA list price. We might need a $li->list_price field since
1292 # estimated price is not necessarily the same as list price
1293 $copy->price($li->estimated_unit_price);
1295 my $evt = OpenILS::Application::Cat::AssetCommon->create_copy($mgr->editor, $volume, $copy);
1297 $mgr->editor->event($evt);
1302 $lid->eg_copy_id($copy->id);
1303 $mgr->editor->update_acq_lineitem_detail($lid) or return 0;
1311 # ----------------------------------------------------------------------------
1312 # Workflow: Build a selection list from a Z39.50 search
1313 # ----------------------------------------------------------------------------
1315 __PACKAGE__->register_method(
1316 method => 'zsearch',
1317 api_name => 'open-ils.acq.picklist.search.z3950',
1320 desc => 'Performs a z3950 federated search and creates a picklist and associated lineitems',
1322 {desc => 'Authentication token', type => 'string'},
1323 {desc => 'Search definition', type => 'object'},
1324 {desc => 'Picklist name, optional', type => 'string'},
1330 my($self, $conn, $auth, $search, $name, $options) = @_;
1331 my $e = new_editor(authtoken=>$auth);
1332 return $e->event unless $e->checkauth;
1333 return $e->event unless $e->allowed('CREATE_PICKLIST');
1335 $search->{limit} ||= 10;
1338 my $ses = OpenSRF::AppSession->create('open-ils.search');
1339 my $req = $ses->request('open-ils.search.z3950.search_class', $auth, $search);
1344 while(my $resp = $req->recv(timeout=>60)) {
1347 my $e = new_editor(requestor=>$e->requestor, xact=>1);
1348 $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1349 $picklist = zsearch_build_pl($mgr, $name);
1353 my $result = $resp->content;
1354 my $count = $result->{count} || 0;
1355 $mgr->total( (($count < $search->{limit}) ? $count : $search->{limit})+1 );
1357 for my $rec (@{$result->{records}}) {
1359 my $li = create_lineitem($mgr,
1360 picklist => $picklist->id,
1361 source_label => $result->{service},
1362 marc => $rec->{marcxml},
1363 eg_bib_id => $rec->{bibid}
1366 if($$options{respond_li}) {
1367 $li->attributes($mgr->editor->search_acq_lineitem_attr({lineitem => $li->id}))
1368 if $$options{flesh_attrs};
1369 $li->clear_marc if $$options{clear_marc};
1370 $mgr->respond(lineitem => $li);
1377 $mgr->editor->commit;
1378 return $mgr->respond_complete;
1381 sub zsearch_build_pl {
1382 my($mgr, $name) = @_;
1385 my $picklist = $mgr->editor->search_acq_picklist({
1386 owner => $mgr->editor->requestor->id,
1390 if($name eq '' and $picklist) {
1391 return 0 unless delete_picklist($mgr, $picklist);
1395 return update_picklist($mgr, $picklist) if $picklist;
1396 return create_picklist($mgr, name => $name);
1400 # ----------------------------------------------------------------------------
1401 # Workflow: Build a selection list / PO by importing a batch of MARC records
1402 # ----------------------------------------------------------------------------
1404 __PACKAGE__->register_method(
1405 method => 'upload_records',
1406 api_name => 'open-ils.acq.process_upload_records',
1408 max_chunk_count => 1
1411 sub upload_records {
1412 my($self, $conn, $auth, $key, $args) = @_;
1415 my $e = new_editor(authtoken => $auth, xact => 1);
1416 return $e->die_event unless $e->checkauth;
1417 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1419 my $cache = OpenSRF::Utils::Cache->new;
1421 my $data = $cache->get_cache("vandelay_import_spool_$key");
1422 my $filename = $data->{path};
1423 my $provider = $args->{provider};
1424 my $picklist = $args->{picklist};
1425 my $create_po = $args->{create_po};
1426 my $activate_po = $args->{activate_po};
1427 my $vandelay = $args->{vandelay};
1428 my $ordering_agency = $args->{ordering_agency} || $e->requestor->ws_ou;
1429 my $fiscal_year = $args->{fiscal_year};
1431 # if the user provides no fiscal year, find the
1432 # current fiscal year for the ordering agency.
1433 $fiscal_year ||= $U->simplereq(
1435 'open-ils.acq.org_unit.current_fiscal_year',
1443 unless(-r $filename) {
1444 $logger->error("unable to read MARC file $filename");
1446 return OpenILS::Event->new('FILE_UPLOAD_ERROR', payload => {filename => $filename});
1449 $provider = $e->retrieve_acq_provider($provider) or return $e->die_event;
1452 $picklist = $e->retrieve_acq_picklist($picklist) or return $e->die_event;
1453 if($picklist->owner != $e->requestor->id) {
1454 return $e->die_event unless
1455 $e->allowed('CREATE_PICKLIST', $picklist->org_unit, $picklist);
1457 $mgr->picklist($picklist);
1461 return $e->die_event unless
1462 $e->allowed('CREATE_PURCHASE_ORDER', $ordering_agency);
1464 $po = create_purchase_order($mgr,
1465 ordering_agency => $ordering_agency,
1466 provider => $provider->id,
1467 state => 'pending' # will be updated later if activated
1468 ) or return $mgr->editor->die_event;
1471 $logger->info("acq processing MARC file=$filename");
1473 my $batch = new MARC::Batch ('USMARC', $filename);
1481 my ($err, $xml, $r);
1486 } catch Error with {
1488 $logger->warn("Proccessing of record $count in set $key failed with error $err. Skipping this record");
1495 $xml = clean_marc($r);
1496 } catch Error with {
1498 $logger->warn("Proccessing XML of record $count in set $key failed with error $err. Skipping this record");
1501 next if $err or not $xml;
1504 source_label => $provider->code,
1505 provider => $provider->id,
1509 $args{picklist} = $picklist->id if $picklist;
1511 $args{purchase_order} = $po->id;
1512 $args{state} = 'pending-order';
1515 my $li = create_lineitem($mgr, %args) or return $mgr->editor->die_event;
1517 $li->provider($provider); # flesh it, we'll need it later
1519 import_lineitem_details($mgr, $ordering_agency, $li, $fiscal_year)
1520 or return $mgr->editor->die_event;
1523 push(@li_list, $li->id);
1528 $evt = extract_po_name($mgr, $po, \@li_list);
1529 return $evt if $evt;
1534 $cache->delete_cache('vandelay_import_spool_' . $key);
1536 if ($po and $activate_po) {
1537 my $die_event = activate_purchase_order_impl($mgr, $po->id, $vandelay);
1538 return $die_event if $die_event;
1540 } elsif ($vandelay) {
1541 $vandelay->{new_rec_perm} = 'IMPORT_ACQ_LINEITEM_BIB_RECORD_UPLOAD';
1542 create_lineitem_list_assets($mgr, \@li_list, $vandelay,
1543 !$vandelay->{create_assets}) or return $e->die_event;
1546 return $mgr->respond_complete;
1549 # see if the PO name is encoded in the newly imported records
1550 sub extract_po_name {
1551 my ($mgr, $po, $li_ids) = @_;
1552 my $e = $mgr->editor;
1554 # find the first instance of the name
1555 my $attr = $e->search_acq_lineitem_attr([
1556 { lineitem => $li_ids,
1557 attr_type => 'lineitem_provider_attr_definition',
1558 attr_name => 'purchase_order'
1560 order_by => {aqlia => 'id'},
1563 ])->[0] or return undef;
1565 my $name = $attr->attr_value;
1567 # see if another PO already has the name, provider, and org
1568 my $existing = $e->search_acq_purchase_order(
1570 ordering_agency => $po->ordering_agency,
1571 provider => $po->provider
1576 # if a PO exists with the same name (and provider/org)
1577 # tack the po ID into the name to differentiate
1578 $name = sprintf("$name (%s)", $po->id) if $existing;
1580 $logger->info("Extracted PO name: $name");
1583 update_purchase_order($mgr, $po) or return $e->die_event;
1587 sub import_lineitem_details {
1588 my($mgr, $ordering_agency, $li, $fiscal_year) = @_;
1590 my $holdings = $mgr->editor->json_query({from => ['acq.extract_provider_holding_data', $li->id]});
1591 return 1 unless @$holdings;
1592 my $org_path = $U->get_org_ancestors($ordering_agency);
1593 $org_path = [ reverse (@$org_path) ];
1599 # create a lineitem detail for each copy in the data
1601 my $compiled = extract_lineitem_detail_data($mgr, $org_path, $holdings, $idx, $fiscal_year);
1602 last unless defined $compiled;
1603 return 0 unless $compiled;
1605 # this takes the price of the last copy and uses it as the lineitem price
1606 # need to determine if a given record would include different prices for the same item
1607 $price = $$compiled{estimated_price};
1609 last unless $$compiled{quantity};
1611 for(1..$$compiled{quantity}) {
1612 my $lid = create_lineitem_detail(
1614 lineitem => $li->id,
1615 owning_lib => $$compiled{owning_lib},
1616 cn_label => $$compiled{call_number},
1617 fund => $$compiled{fund},
1618 circ_modifier => $$compiled{circ_modifier},
1619 note => $$compiled{note},
1620 location => $$compiled{copy_location},
1621 collection_code => $$compiled{collection_code},
1622 barcode => $$compiled{barcode}
1630 $li->estimated_unit_price($price);
1631 update_lineitem($mgr, $li) or return 0;
1635 # return hash on success, 0 on error, undef on no more holdings
1636 sub extract_lineitem_detail_data {
1637 my($mgr, $org_path, $holdings, $index, $fiscal_year) = @_;
1639 my @data_list = grep { $_->{holding} eq $index } @$holdings;
1640 return undef unless @data_list;
1642 my %compiled = map { $_->{attr} => $_->{data} } @data_list;
1643 my $base_org = $$org_path[0];
1647 $logger->error("Item import extraction error: $msg");
1648 $logger->error('Holdings Data: ' . OpenSRF::Utils::JSON->perl2JSON(\%compiled));
1649 $mgr->editor->rollback;
1650 $mgr->editor->event(OpenILS::Event->new('ACQ_IMPORT_ERROR', payload => $msg));
1654 # ---------------------------------------------------------------------
1656 if(my $code = $compiled{fund_code}) {
1658 my $fund = $mgr->cache($base_org, "fund.$code");
1660 # search up the org tree for the most appropriate fund
1661 for my $org (@$org_path) {
1662 $fund = $mgr->editor->search_acq_fund(
1663 {org => $org, code => $code, year => $fiscal_year}, {idlist => 1})->[0];
1667 return $killme->("no fund with code $code at orgs [@$org_path]") unless $fund;
1668 $compiled{fund} = $fund;
1669 $mgr->cache($base_org, "fund.$code", $fund);
1673 # ---------------------------------------------------------------------
1675 if(my $sn = $compiled{owning_lib}) {
1676 my $org_id = $mgr->cache($base_org, "orgsn.$sn") ||
1677 $mgr->editor->search_actor_org_unit({shortname => $sn}, {idlist => 1})->[0];
1678 return $killme->("invalid owning_lib defined: $sn") unless $org_id;
1679 $compiled{owning_lib} = $org_id;
1680 $mgr->cache($$org_path[0], "orgsn.$sn", $org_id);
1684 # ---------------------------------------------------------------------
1686 my $code = $compiled{circ_modifier};
1690 # verify this is a valid circ modifier
1691 return $killme->("invlalid circ_modifier $code") unless
1692 defined $mgr->cache($base_org, "mod.$code") or
1693 $mgr->editor->retrieve_config_circ_modifier($code);
1695 # if valid, cache for future tests
1696 $mgr->cache($base_org, "mod.$code", $code);
1699 $compiled{circ_modifier} = get_default_circ_modifier($mgr, $base_org);
1703 # ---------------------------------------------------------------------
1705 if( my $name = $compiled{copy_location}) {
1707 my $cp_base_org = $base_org;
1709 if ($compiled{owning_lib}) {
1710 # start looking for copy locations at the copy
1711 # owning lib instaed of the upload context org
1712 $cp_base_org = $compiled{owning_lib};
1715 my $loc = $mgr->cache($cp_base_org, "copy_loc.$name");
1717 my $org = $cp_base_org;
1719 $loc = $mgr->editor->search_asset_copy_location(
1720 {owning_lib => $org, name => $name, deleted => 'f'}, {idlist => 1})->[0];
1722 $org = $mgr->editor->retrieve_actor_org_unit($org)->parent_ou;
1725 return $killme->("Invalid copy location $name") unless $loc;
1726 $compiled{copy_location} = $loc;
1727 $mgr->cache($cp_base_org, "copy_loc.$name", $loc);
1735 # ----------------------------------------------------------------------------
1736 # Workflow: Given an existing purchase order, import/create the bibs,
1737 # callnumber and copy objects
1738 # ----------------------------------------------------------------------------
1740 __PACKAGE__->register_method(
1741 method => 'create_po_assets',
1742 api_name => 'open-ils.acq.purchase_order.assets.create',
1744 desc => q/Creates assets for each lineitem in the purchase order/,
1746 {desc => 'Authentication token', type => 'string'},
1747 {desc => 'The purchase order id', type => 'number'},
1749 return => {desc => 'Streams a total versus completed counts object, event on error'}
1751 max_chunk_count => 1
1754 sub create_po_assets {
1755 my($self, $conn, $auth, $po_id, $args) = @_;
1758 my $e = new_editor(authtoken=>$auth, xact=>1);
1759 return $e->die_event unless $e->checkauth;
1760 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1762 my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->die_event;
1764 my $li_ids = $e->search_acq_lineitem({purchase_order => $po_id}, {idlist => 1});
1766 # it's ugly, but it's fast. Get the total count of lineitem detail objects to process
1767 my $lid_total = $e->json_query({
1768 select => { acqlid => [{aggregate => 1, transform => 'count', column => 'id'}] },
1774 join => {acqpo => {fkey => 'purchase_order', field => 'id'}}
1778 where => {'+acqpo' => {id => $po_id}}
1781 # maximum number of Vandelay bib actions is twice
1782 # the number line items (queue bib, then create it)
1783 $mgr->total(scalar(@$li_ids) * 2 + $lid_total);
1785 create_lineitem_list_assets($mgr, $li_ids, $args->{vandelay})
1786 or return $e->die_event;
1789 update_purchase_order($mgr, $po) or return $e->die_event;
1792 return $mgr->respond_complete;
1797 __PACKAGE__->register_method(
1798 method => 'create_purchase_order_api',
1799 api_name => 'open-ils.acq.purchase_order.create',
1801 desc => 'Creates a new purchase order',
1803 {desc => 'Authentication token', type => 'string'},
1804 {desc => 'purchase_order to create', type => 'object'}
1806 return => {desc => 'The purchase order id, Event on failure'}
1808 max_chunk_count => 1
1811 sub create_purchase_order_api {
1812 my($self, $conn, $auth, $po, $args) = @_;
1815 my $e = new_editor(xact=>1, authtoken=>$auth);
1816 return $e->die_event unless $e->checkauth;
1817 return $e->die_event unless $e->allowed('CREATE_PURCHASE_ORDER', $po->ordering_agency);
1818 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1821 my %pargs = (ordering_agency => $e->requestor->ws_ou); # default
1822 $pargs{provider} = $po->provider if $po->provider;
1823 $pargs{ordering_agency} = $po->ordering_agency if $po->ordering_agency;
1824 $pargs{prepayment_required} = $po->prepayment_required if $po->prepayment_required;
1825 $pargs{name} = $po->name if $po->name;
1826 my $vandelay = $args->{vandelay};
1828 $po = create_purchase_order($mgr, %pargs) or return $e->die_event;
1830 my $li_ids = $$args{lineitems};
1834 for my $li_id (@$li_ids) {
1836 my $li = $e->retrieve_acq_lineitem([
1838 {flesh => 1, flesh_fields => {jub => ['attributes']}}
1839 ]) or return $e->die_event;
1841 return $e->die_event(
1843 "BAD_PARAMS", payload => $li,
1844 note => "acq.lineitem #" . $li->id .
1845 ": purchase_order #" . $li->purchase_order
1847 ) if $li->purchase_order;
1849 $li->provider($po->provider);
1850 $li->purchase_order($po->id);
1851 $li->state('pending-order');
1852 update_lineitem($mgr, $li) or return $e->die_event;
1857 # see if we have a PO name encoded in any of our lineitems
1858 my $evt = extract_po_name($mgr, $po, $li_ids);
1859 return $evt if $evt;
1861 # commit before starting the asset creation
1867 create_lineitem_list_assets(
1868 $mgr, $li_ids, $vandelay, !$$args{create_assets})
1869 or return $e->die_event;
1873 apply_default_copies($mgr, $po) or return $e->die_event;
1877 return $mgr->respond_complete;
1880 # !transaction must be managed by the caller
1881 # creates the default number of copies for each lineitem on the PO.
1882 # when a LI already has copies attached, no default copies are added.
1883 # without li_id, all lineitems are checked/applied
1884 # returns 1 on success, 0 on error
1885 sub apply_default_copies {
1886 my ($mgr, $po, $li_id) = @_;
1888 my $e = $mgr->editor;
1890 my $provider = ref($po->provider) ? $po->provider :
1891 $e->retrieve_acq_provider($po->provider);
1893 my $copy_count = $provider->default_copy_count || return 1;
1895 $logger->info("Applying $copy_count default copies for PO ".$po->id);
1897 my $li_ids = $li_id ? [$li_id] :
1898 $e->search_acq_lineitem({
1899 purchase_order => $po->id,
1900 cancel_reason => undef
1905 for my $li_id (@$li_ids) {
1907 my $lid_ids = $e->search_acq_lineitem_detail(
1908 {lineitem => $li_id}, {idlist => 1});
1910 # do not apply default copies when copies already exist
1913 for (1 .. $copy_count) {
1914 create_lineitem_detail($mgr,
1916 owning_lib => $e->requestor->ws_ou
1926 __PACKAGE__->register_method(
1927 method => 'update_lineitem_fund_batch',
1928 api_name => 'open-ils.acq.lineitem.fund.update.batch',
1931 desc => q/Given a set of lineitem IDS, updates the fund for all attached lineitem details/
1935 sub update_lineitem_fund_batch {
1936 my($self, $conn, $auth, $li_ids, $fund_id) = @_;
1937 my $e = new_editor(xact=>1, authtoken=>$auth);
1938 return $e->die_event unless $e->checkauth;
1939 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1940 for my $li_id (@$li_ids) {
1941 my ($li, $evt) = fetch_and_check_li($e, $li_id, 'write');
1942 return $evt if $evt;
1943 my $li_details = $e->search_acq_lineitem_detail({lineitem => $li_id});
1944 $_->fund($fund_id) and $_->ischanged(1) for @$li_details;
1945 $evt = lineitem_detail_CUD_batch($mgr, $li_details);
1946 return $evt if $evt;
1951 return $mgr->respond_complete;
1956 __PACKAGE__->register_method(
1957 method => 'lineitem_detail_CUD_batch_api',
1958 api_name => 'open-ils.acq.lineitem_detail.cud.batch',
1961 desc => q/Creates a new purchase order line item detail. / .
1962 q/Additionally creates the associated fund_debit/,
1964 {desc => 'Authentication token', type => 'string'},
1965 {desc => 'List of lineitem_details to create', type => 'array'},
1966 {desc => 'Create Debits. Used for creating post-po-asset-creation debits', type => 'bool'},
1968 return => {desc => 'Streaming response of current position in the array'}
1972 __PACKAGE__->register_method(
1973 method => 'lineitem_detail_CUD_batch_api',
1974 api_name => 'open-ils.acq.lineitem_detail.cud.batch.dry_run',
1978 Dry run version of open-ils.acq.lineitem_detail.cud.batch.
1979 In dry_run mode, updated fund_debit's the exceed the warning
1980 percent return an event.
1986 sub lineitem_detail_CUD_batch_api {
1987 my($self, $conn, $auth, $li_details, $create_debits) = @_;
1988 my $e = new_editor(xact=>1, authtoken=>$auth);
1989 return $e->die_event unless $e->checkauth;
1990 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1991 my $dry_run = ($self->api_name =~ /dry_run/o);
1992 my $evt = lineitem_detail_CUD_batch($mgr, $li_details, $create_debits, $dry_run);
1993 return $evt if $evt;
1995 return $mgr->respond_complete;
1999 sub lineitem_detail_CUD_batch {
2000 my($mgr, $li_details, $create_debits, $dry_run) = @_;
2002 $mgr->total(scalar(@$li_details));
2003 my $e = $mgr->editor;
2007 my $fund_cache = {};
2010 for my $lid (@$li_details) {
2012 unless($li = $li_cache{$lid->lineitem}) {
2013 ($li, $evt) = fetch_and_check_li($e, $lid->lineitem, 'write');
2014 return $evt if $evt;
2018 $lid = create_lineitem_detail($mgr, %{$lid->to_bare_hash}) or return $e->die_event;
2019 if($create_debits) {
2020 $li->provider($e->retrieve_acq_provider($li->provider)) or return $e->die_event;
2021 $lid->fund($e->retrieve_acq_fund($lid->fund)) or return $e->die_event;
2022 create_lineitem_detail_debit($mgr, $li, $lid, 0, 1) or return $e->die_event;
2025 } elsif($lid->ischanged) {
2026 return $evt if $evt = handle_changed_lid($e, $lid, $dry_run, $fund_cache);
2028 } elsif($lid->isdeleted) {
2029 delete_lineitem_detail($mgr, $lid) or return $e->die_event;
2032 $mgr->respond(li => $li);
2033 $li_cache{$lid->lineitem} = $li;
2039 sub handle_changed_lid {
2040 my($e, $lid, $dry_run, $fund_cache) = @_;
2042 my $orig_lid = $e->retrieve_acq_lineitem_detail($lid->id) or return $e->die_event;
2044 # updating the fund, so update the debit
2045 if($orig_lid->fund_debit and $orig_lid->fund != $lid->fund) {
2047 my $debit = $e->retrieve_acq_fund_debit($orig_lid->fund_debit);
2048 my $new_fund = $$fund_cache{$lid->fund} =
2049 $$fund_cache{$lid->fund} || $e->retrieve_acq_fund($lid->fund);
2051 # check the thresholds
2052 return $e->die_event if
2053 fund_exceeds_balance_percent($new_fund, $debit->amount, $e, "stop");
2054 return $e->die_event if $dry_run and
2055 fund_exceeds_balance_percent($new_fund, $debit->amount, $e, "warning");
2057 $debit->fund($new_fund->id);
2058 $e->update_acq_fund_debit($debit) or return $e->die_event;
2061 $e->update_acq_lineitem_detail($lid) or return $e->die_event;
2066 __PACKAGE__->register_method(
2067 method => 'receive_po_api',
2068 api_name => 'open-ils.acq.purchase_order.receive'
2071 sub receive_po_api {
2072 my($self, $conn, $auth, $po_id) = @_;
2073 my $e = new_editor(xact => 1, authtoken => $auth);
2074 return $e->die_event unless $e->checkauth;
2075 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
2077 my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->die_event;
2078 return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency);
2080 my $li_ids = $e->search_acq_lineitem({purchase_order => $po_id}, {idlist => 1});
2082 for my $li_id (@$li_ids) {
2083 receive_lineitem($mgr, $li_id) or return $e->die_event;
2087 $po->state('received');
2088 update_purchase_order($mgr, $po) or return $e->die_event;
2091 return $mgr->respond_complete;
2095 # At the moment there's a lack of parallelism between the receive and unreceive
2096 # API methods for POs and the API methods for LIs and LIDs. The methods for
2097 # POs stream back objects as they act, whereas the methods for LIs and LIDs
2098 # atomically return an object that describes only what changed (in LIs and LIDs
2099 # themselves or in the objects to which to LIs and LIDs belong).
2101 # The methods for LIs and LIDs work the way they do to faciliate the UI's
2102 # maintaining correct information about the state of these things when a user
2103 # wants to receive or unreceive these objects without refreshing their whole
2104 # display. The UI feature for receiving and un-receiving a whole PO just
2105 # refreshes the whole display, so this absence of parallelism in the UI is also
2106 # relected in this module.
2108 # This could be neatened in the future by making POs receive and unreceive in
2109 # the same way the LIs and LIDs do.
2111 __PACKAGE__->register_method(
2112 method => 'receive_lineitem_detail_api',
2113 api_name => 'open-ils.acq.lineitem_detail.receive',
2115 desc => 'Mark a lineitem_detail as received',
2117 {desc => 'Authentication token', type => 'string'},
2118 {desc => 'lineitem detail ID', type => 'number'}
2121 "on success, object describing changes to LID and possibly " .
2122 "to LI and PO; on error, Event"
2127 sub receive_lineitem_detail_api {
2128 my($self, $conn, $auth, $lid_id) = @_;
2130 my $e = new_editor(xact=>1, authtoken=>$auth);
2131 return $e->die_event unless $e->checkauth;
2132 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
2135 "flesh" => 2, "flesh_fields" => {
2136 "acqlid" => ["lineitem"], "jub" => ["purchase_order"]
2140 my $lid = $e->retrieve_acq_lineitem_detail([$lid_id, $fleshing]);
2142 return $e->die_event unless $e->allowed(
2143 'RECEIVE_PURCHASE_ORDER', $lid->lineitem->purchase_order->ordering_agency);
2146 my $recvd = receive_lineitem_detail($mgr, $lid_id) or return $e->die_event;
2148 # .. and re-retrieve
2149 $lid = $e->retrieve_acq_lineitem_detail([$lid_id, $fleshing]);
2151 # Now build result data structure.
2152 my $result = {"lid" => {$lid->id => {"recv_time" => $lid->recv_time}}};
2155 if ($recvd->class_name =~ /::purchase_order/) {
2156 $result->{"po"} = describe_affected_po($e, $recvd);
2158 $lid->lineitem->id => {"state" => $lid->lineitem->state}
2160 } elsif ($recvd->class_name =~ /::lineitem/) {
2161 $result->{"li"} = {$recvd->id => {"state" => $recvd->state}};
2165 describe_affected_po($e, $lid->lineitem->purchase_order);
2171 __PACKAGE__->register_method(
2172 method => 'receive_lineitem_api',
2173 api_name => 'open-ils.acq.lineitem.receive',
2175 desc => 'Mark a lineitem as received',
2177 {desc => 'Authentication token', type => 'string'},
2178 {desc => 'lineitem ID', type => 'number'}
2181 "on success, object describing changes to LI and possibly PO; " .
2187 sub receive_lineitem_api {
2188 my($self, $conn, $auth, $li_id) = @_;
2190 my $e = new_editor(xact=>1, authtoken=>$auth);
2191 return $e->die_event unless $e->checkauth;
2192 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
2194 my $li = $e->retrieve_acq_lineitem([
2198 jub => ['purchase_order']
2201 ]) or return $e->die_event;
2203 return $e->die_event unless $e->allowed(
2204 'RECEIVE_PURCHASE_ORDER', $li->purchase_order->ordering_agency);
2206 my $res = receive_lineitem($mgr, $li_id) or return $e->die_event;
2208 $conn->respond_complete($res);
2209 $mgr->run_post_response_hooks
2213 __PACKAGE__->register_method(
2214 method => 'receive_lineitem_batch_api',
2215 api_name => 'open-ils.acq.lineitem.receive.batch',
2218 desc => 'Mark lineitems as received',
2220 {desc => 'Authentication token', type => 'string'},
2221 {desc => 'lineitem ID list', type => 'array'}
2224 q/On success, stream of objects describing changes to LIs and
2225 possibly PO; onerror, Event. Any event, even after lots of other
2226 objects, should mean general failure of whole batch operation./
2231 sub receive_lineitem_batch_api {
2232 my ($self, $conn, $auth, $li_idlist) = @_;
2234 return unless ref $li_idlist eq 'ARRAY' and @$li_idlist;
2236 my $e = new_editor(xact => 1, authtoken => $auth);
2237 return $e->die_event unless $e->checkauth;
2239 my $mgr = new OpenILS::Application::Acq::BatchManager(
2240 editor => $e, conn => $conn
2243 for my $li_id (map { int $_ } @$li_idlist) {
2244 my $li = $e->retrieve_acq_lineitem([
2247 flesh_fields => { jub => ['purchase_order'] }
2249 ]) or return $e->die_event;
2251 return $e->die_event unless $e->allowed(
2252 'RECEIVE_PURCHASE_ORDER', $li->purchase_order->ordering_agency
2255 receive_lineitem($mgr, $li_id) or return $e->die_event;
2259 $e->commit or return $e->die_event;
2260 $mgr->respond_complete;
2261 $mgr->run_post_response_hooks;
2264 __PACKAGE__->register_method(
2265 method => 'rollback_receive_po_api',
2266 api_name => 'open-ils.acq.purchase_order.receive.rollback'
2269 sub rollback_receive_po_api {
2270 my($self, $conn, $auth, $po_id) = @_;
2271 my $e = new_editor(xact => 1, authtoken => $auth);
2272 return $e->die_event unless $e->checkauth;
2273 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
2275 my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->die_event;
2276 return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency);
2278 my $li_ids = $e->search_acq_lineitem({purchase_order => $po_id}, {idlist => 1});
2280 for my $li_id (@$li_ids) {
2281 rollback_receive_lineitem($mgr, $li_id) or return $e->die_event;
2285 $po->state('on-order');
2286 update_purchase_order($mgr, $po) or return $e->die_event;
2289 return $mgr->respond_complete;
2293 __PACKAGE__->register_method(
2294 method => 'rollback_receive_lineitem_detail_api',
2295 api_name => 'open-ils.acq.lineitem_detail.receive.rollback',
2297 desc => 'Mark a lineitem_detail as Un-received',
2299 {desc => 'Authentication token', type => 'string'},
2300 {desc => 'lineitem detail ID', type => 'number'}
2303 "on success, object describing changes to LID and possibly " .
2304 "to LI and PO; on error, Event"
2309 sub rollback_receive_lineitem_detail_api {
2310 my($self, $conn, $auth, $lid_id) = @_;
2312 my $e = new_editor(xact=>1, authtoken=>$auth);
2313 return $e->die_event unless $e->checkauth;
2314 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
2316 my $lid = $e->retrieve_acq_lineitem_detail([
2320 acqlid => ['lineitem'],
2321 jub => ['purchase_order']
2325 my $li = $lid->lineitem;
2326 my $po = $li->purchase_order;
2328 return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency);
2332 my $recvd = rollback_receive_lineitem_detail($mgr, $lid_id)
2333 or return $e->die_event;
2336 $result->{"lid"} = {$recvd->id => {"recv_time" => $recvd->recv_time}};
2338 $result->{"lid"} = {$lid->id => {"recv_time" => $lid->recv_time}};
2341 if ($li->state eq "received") {
2342 $li->state("on-order");
2343 $li = update_lineitem($mgr, $li) or return $e->die_event;
2344 $result->{"li"} = {$li->id => {"state" => $li->state}};
2347 if ($po->state eq "received") {
2348 $po->state("on-order");
2349 $po = update_purchase_order($mgr, $po) or return $e->die_event;
2351 $result->{"po"} = describe_affected_po($e, $po);
2353 $e->commit and return $result or return $e->die_event;
2356 __PACKAGE__->register_method(
2357 method => 'rollback_receive_lineitem_api',
2358 api_name => 'open-ils.acq.lineitem.receive.rollback',
2360 desc => 'Mark a lineitem as Un-received',
2362 {desc => 'Authentication token', type => 'string'},
2363 {desc => 'lineitem ID', type => 'number'}
2366 "on success, object describing changes to LI and possibly PO; " .
2372 sub rollback_receive_lineitem_api {
2373 my($self, $conn, $auth, $li_id) = @_;
2375 my $e = new_editor(xact=>1, authtoken=>$auth);
2376 return $e->die_event unless $e->checkauth;
2377 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
2379 my $li = $e->retrieve_acq_lineitem([
2381 "flesh" => 1, "flesh_fields" => {"jub" => ["purchase_order"]}
2384 my $po = $li->purchase_order;
2386 return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency);
2388 $li = rollback_receive_lineitem($mgr, $li_id) or return $e->die_event;
2390 my $result = {"li" => {$li->id => {"state" => $li->state}}};
2391 if ($po->state eq "received") {
2392 $po->state("on-order");
2393 $po = update_purchase_order($mgr, $po) or return $e->die_event;
2395 $result->{"po"} = describe_affected_po($e, $po);
2397 $e->commit and return $result or return $e->die_event;
2400 __PACKAGE__->register_method(
2401 method => 'rollback_receive_lineitem_batch_api',
2402 api_name => 'open-ils.acq.lineitem.receive.rollback.batch',
2405 desc => 'Mark a list of lineitems as Un-received',
2407 {desc => 'Authentication token', type => 'string'},
2408 {desc => 'lineitem ID list', type => 'array'}
2411 q/on success, a stream of objects describing changes to LI and
2412 possibly PO; on error, Event. Any event means all previously
2413 returned objects indicate changes that didn't really happen./
2418 sub rollback_receive_lineitem_batch_api {
2419 my ($self, $conn, $auth, $li_idlist) = @_;
2421 return unless ref $li_idlist eq 'ARRAY' and @$li_idlist;
2423 my $e = new_editor(xact => 1, authtoken => $auth);
2424 return $e->die_event unless $e->checkauth;
2426 my $mgr = new OpenILS::Application::Acq::BatchManager(
2427 editor => $e, conn => $conn
2430 for my $li_id (map { int $_ } @$li_idlist) {
2431 my $li = $e->retrieve_acq_lineitem([
2434 "flesh_fields" => {"jub" => ["purchase_order"]}
2438 my $po = $li->purchase_order;
2440 return $e->die_event unless
2441 $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency);
2443 $li = rollback_receive_lineitem($mgr, $li_id) or return $e->die_event;
2445 my $result = {"li" => {$li->id => {"state" => $li->state}}};
2446 if ($po->state eq "received") { # should happen first time, not after
2447 $po->state("on-order");
2448 $po = update_purchase_order($mgr, $po) or return $e->die_event;
2450 $result->{"po"} = describe_affected_po($e, $po);
2452 $mgr->respond(%$result);
2455 $e->commit or return $e->die_event;
2456 $mgr->respond_complete;
2457 $mgr->run_post_response_hooks;
2461 __PACKAGE__->register_method(
2462 method => 'set_lineitem_price_api',
2463 api_name => 'open-ils.acq.lineitem.price.set',
2465 desc => 'Set lineitem price. If debits already exist, update them as well',
2467 {desc => 'Authentication token', type => 'string'},
2468 {desc => 'lineitem ID', type => 'number'}
2470 return => {desc => 'status blob, Event on error'}
2474 sub set_lineitem_price_api {
2475 my($self, $conn, $auth, $li_id, $price) = @_;
2477 my $e = new_editor(xact=>1, authtoken=>$auth);
2478 return $e->die_event unless $e->checkauth;
2479 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
2481 my ($li, $evt) = fetch_and_check_li($e, $li_id, 'write');
2482 return $evt if $evt;
2484 $li->estimated_unit_price($price);
2485 update_lineitem($mgr, $li) or return $e->die_event;
2487 my $lid_ids = $e->search_acq_lineitem_detail(
2488 {lineitem => $li_id, fund_debit => {'!=' => undef}},
2492 for my $lid_id (@$lid_ids) {
2494 my $lid = $e->retrieve_acq_lineitem_detail([
2496 flesh => 1, flesh_fields => {acqlid => ['fund', 'fund_debit']}}
2499 $lid->fund_debit->amount($price);
2500 $e->update_acq_fund_debit($lid->fund_debit) or return $e->die_event;
2506 return $mgr->respond_complete;
2510 __PACKAGE__->register_method(
2511 method => 'clone_picklist_api',
2512 api_name => 'open-ils.acq.picklist.clone',
2514 desc => 'Clones a picklist, including lineitem and lineitem details',
2516 {desc => 'Authentication token', type => 'string'},
2517 {desc => 'Picklist ID', type => 'number'},
2518 {desc => 'New Picklist Name', type => 'string'}
2520 return => {desc => 'status blob, Event on error'}
2524 sub clone_picklist_api {
2525 my($self, $conn, $auth, $pl_id, $name) = @_;
2527 my $e = new_editor(xact=>1, authtoken=>$auth);
2528 return $e->die_event unless $e->checkauth;
2529 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
2531 my $old_pl = $e->retrieve_acq_picklist($pl_id);
2532 my $new_pl = create_picklist($mgr, %{$old_pl->to_bare_hash}, name => $name) or return $e->die_event;
2534 my $li_ids = $e->search_acq_lineitem({picklist => $pl_id}, {idlist => 1});
2536 # get the current user
2537 my $cloner = $mgr->editor->requestor->id;
2539 for my $li_id (@$li_ids) {
2541 # copy the lineitems' MARC
2542 my $marc = ($e->retrieve_acq_lineitem($li_id))->marc;
2544 # create a skeletal clone of the item
2545 my $li = Fieldmapper::acq::lineitem->new;
2546 $li->creator($cloner);
2547 $li->selector($cloner);
2548 $li->editor($cloner);
2551 my $new_li = create_lineitem($mgr, %{$li->to_bare_hash}, picklist => $new_pl->id) or return $e->die_event;
2557 return $mgr->respond_complete;
2561 __PACKAGE__->register_method(
2562 method => 'merge_picklist_api',
2563 api_name => 'open-ils.acq.picklist.merge',
2565 desc => 'Merges 2 or more picklists into a single list',
2567 {desc => 'Authentication token', type => 'string'},
2568 {desc => 'Lead Picklist ID', type => 'number'},
2569 {desc => 'List of subordinate picklist IDs', type => 'array'}
2571 return => {desc => 'status blob, Event on error'}
2575 sub merge_picklist_api {
2576 my($self, $conn, $auth, $lead_pl, $pl_list) = @_;
2578 my $e = new_editor(xact=>1, authtoken=>$auth);
2579 return $e->die_event unless $e->checkauth;
2580 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
2582 # XXX perms on each picklist modified
2584 $lead_pl = $e->retrieve_acq_picklist($lead_pl) or return $e->die_event;
2585 # point all of the lineitems at the lead picklist
2586 my $li_ids = $e->search_acq_lineitem({picklist => $pl_list}, {idlist => 1});
2588 for my $li_id (@$li_ids) {
2589 my $li = $e->retrieve_acq_lineitem($li_id);
2590 $li->picklist($lead_pl);
2591 update_lineitem($mgr, $li) or return $e->die_event;
2595 # now delete the subordinate lists
2596 for my $pl_id (@$pl_list) {
2597 my $pl = $e->retrieve_acq_picklist($pl_id);
2598 $e->delete_acq_picklist($pl) or return $e->die_event;
2601 update_picklist($mgr, $lead_pl) or return $e->die_event;
2604 return $mgr->respond_complete;
2608 __PACKAGE__->register_method(
2609 method => 'delete_picklist_api',
2610 api_name => 'open-ils.acq.picklist.delete',
2612 desc => q/Deletes a picklist. It also deletes any lineitems in the "new" state. / .
2613 q/Other attached lineitems are detached/,
2615 {desc => 'Authentication token', type => 'string'},
2616 {desc => 'Picklist ID to delete', type => 'number'}
2618 return => {desc => '1 on success, Event on error'}
2622 sub delete_picklist_api {
2623 my($self, $conn, $auth, $picklist_id) = @_;
2624 my $e = new_editor(xact=>1, authtoken=>$auth);
2625 return $e->die_event unless $e->checkauth;
2626 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
2627 my $pl = $e->retrieve_acq_picklist($picklist_id) or return $e->die_event;
2628 delete_picklist($mgr, $pl) or return $e->die_event;
2630 return $mgr->respond_complete;
2635 __PACKAGE__->register_method(
2636 method => 'activate_purchase_order',
2637 api_name => 'open-ils.acq.purchase_order.activate.dry_run'
2640 __PACKAGE__->register_method(
2641 method => 'activate_purchase_order',
2642 api_name => 'open-ils.acq.purchase_order.activate',
2644 desc => q/Activates a purchase order. This updates the status of the PO / .
2645 q/and Lineitems to 'on-order'. Activated PO's are ready for EDI delivery if appropriate./,
2647 {desc => 'Authentication token', type => 'string'},
2648 {desc => 'Purchase ID', type => 'number'}
2650 return => {desc => '1 on success, Event on error'}
2654 sub activate_purchase_order {
2655 my($self, $conn, $auth, $po_id, $vandelay, $options) = @_;
2657 $$options{dry_run} = ($self->api_name =~ /\.dry_run/) ? 1 : 0;
2659 my $e = new_editor(authtoken=>$auth);
2660 return $e->die_event unless $e->checkauth;
2661 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
2662 my $die_event = activate_purchase_order_impl($mgr, $po_id, $vandelay, $options);
2663 return $e->die_event if $die_event;
2664 $conn->respond_complete(1);
2665 $mgr->run_post_response_hooks unless $$options{dry_run};
2669 # xacts managed within
2670 sub activate_purchase_order_impl {
2671 my ($mgr, $po_id, $vandelay, $options) = @_;
2673 my $dry_run = $$options{dry_run};
2674 my $no_assets = $$options{no_assets};
2676 # read-only until lineitem asset creation
2677 my $e = $mgr->editor;
2680 my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->die_event;
2681 return $e->die_event unless $e->allowed('CREATE_PURCHASE_ORDER', $po->ordering_agency);
2683 return $e->die_event(OpenILS::Event->new('PO_ALREADY_ACTIVATED'))
2684 if $po->order_date; # PO cannot be re-activated
2686 my $provider = $e->retrieve_acq_provider($po->provider);
2688 # find lineitems and create assets for all
2691 purchase_order => $po_id,
2692 state => [qw/pending-order new order-ready/]
2695 my $li_ids = $e->search_acq_lineitem($query, {idlist => 1});
2697 my $vl_resp; # imported li's and the managing queue
2698 unless ($dry_run or $no_assets) {
2699 $e->rollback; # read-only thus far
2701 # list_assets manages its own transactions
2702 $vl_resp = create_lineitem_list_assets($mgr, $li_ids, $vandelay)
2703 or return OpenILS::Event->new('ACQ_LI_IMPORT_FAILED');
2707 # create fund debits for lineitems
2709 for my $li_id (@$li_ids) {
2710 my $li = $e->retrieve_acq_lineitem($li_id);
2712 unless ($li->eg_bib_id or $dry_run or $no_assets) {
2713 # we encountered a lineitem that was not successfully imported.
2714 # we cannot continue. rollback and report.
2716 return OpenILS::Event->new('ACQ_LI_IMPORT_FAILED', {queue => $vl_resp->{queue}});
2719 $li->state('on-order');
2720 $li->claim_policy($provider->default_claim_policy)
2721 if $provider->default_claim_policy and !$li->claim_policy;
2722 create_lineitem_debits($mgr, $li, $options) or return $e->die_event;
2723 update_lineitem($mgr, $li) or return $e->die_event;
2724 $mgr->post_process( sub { create_lineitem_status_events($mgr, $li->id, 'aur.ordered'); });
2728 # create po-item debits
2730 for my $po_item (@{$e->search_acq_po_item({purchase_order => $po_id})}) {
2732 my $debit = create_fund_debit(
2735 debit_type => 'direct_charge', # to match invoicing
2736 origin_amount => $po_item->estimated_cost,
2737 origin_currency_type => $e->retrieve_acq_fund($po_item->fund)->currency_type,
2738 amount => $po_item->estimated_cost,
2739 fund => $po_item->fund
2740 ) or return $e->die_event;
2741 $po_item->fund_debit($debit->id);
2742 $e->update_acq_po_item($po_item) or return $e->die_event;
2746 # mark PO as ordered
2748 $po->state('on-order');
2749 $po->order_date('now');
2750 update_purchase_order($mgr, $po) or return $e->die_event;
2753 $dry_run and $e->rollback or $e->commit;
2755 # tell the world we activated a PO
2756 $U->create_events_for_hook('acqpo.activated', $po, $po->ordering_agency) unless $dry_run;
2762 __PACKAGE__->register_method(
2763 method => 'split_purchase_order_by_lineitems',
2764 api_name => 'open-ils.acq.purchase_order.split_by_lineitems',
2766 desc => q/Splits a PO into many POs, 1 per lineitem. Only works for / .
2767 q/POs a) with more than one lineitems, and b) in the "pending" state./,
2769 {desc => 'Authentication token', type => 'string'},
2770 {desc => 'Purchase order ID', type => 'number'}
2772 return => {desc => 'list of new PO IDs on success, Event on error'}
2776 sub split_purchase_order_by_lineitems {
2777 my ($self, $conn, $auth, $po_id) = @_;
2779 my $e = new_editor("xact" => 1, "authtoken" => $auth);
2780 return $e->die_event unless $e->checkauth;
2782 my $po = $e->retrieve_acq_purchase_order([
2785 "flesh_fields" => {"acqpo" => [qw/lineitems notes/]}
2787 ]) or return $e->die_event;
2789 return $e->die_event
2790 unless $e->allowed("CREATE_PURCHASE_ORDER", $po->ordering_agency);
2792 unless ($po->state eq "pending") {
2794 return new OpenILS::Event("ACQ_PURCHASE_ORDER_TOO_LATE");
2797 unless (@{$po->lineitems} > 1) {
2799 return new OpenILS::Event("ACQ_PURCHASE_ORDER_TOO_SHORT");
2802 # To split an existing PO into many, it seems unwise to just delete the
2803 # original PO, so we'll instead detach all of the original POs' lineitems
2804 # but the first, then create new POs for each of the remaining LIs, and
2805 # then attach the LIs to their new POs.
2807 my @po_ids = ($po->id);
2808 my @moving_li = @{$po->lineitems};
2809 shift @moving_li; # discard first LI
2811 foreach my $li (@moving_li) {
2812 my $new_po = $po->clone;
2814 $new_po->clear_name;
2815 $new_po->creator($e->requestor->id);
2816 $new_po->editor($e->requestor->id);
2817 $new_po->owner($e->requestor->id);
2818 $new_po->edit_time("now");
2819 $new_po->create_time("now");
2821 $new_po = $e->create_acq_purchase_order($new_po);
2823 # Clone any notes attached to the old PO and attach to the new one.
2824 foreach my $note (@{$po->notes}) {
2825 my $new_note = $note->clone;
2826 $new_note->clear_id;
2827 $new_note->edit_time("now");
2828 $new_note->purchase_order($new_po->id);
2829 $e->create_acq_po_note($new_note);
2832 $li->edit_time("now");
2833 $li->purchase_order($new_po->id);
2834 $e->update_acq_lineitem($li);
2836 push @po_ids, $new_po->id;
2839 $po->edit_time("now");
2840 $e->update_acq_purchase_order($po);
2842 return \@po_ids if $e->commit;
2843 return $e->die_event;
2847 sub not_cancelable {
2849 (ref $o eq "HASH" and $o->{"textcode"} eq "ACQ_NOT_CANCELABLE");
2852 __PACKAGE__->register_method(
2853 method => "cancel_purchase_order_api",
2854 api_name => "open-ils.acq.purchase_order.cancel",
2856 desc => q/Cancels an on-order purchase order/,
2858 {desc => "Authentication token", type => "string"},
2859 {desc => "PO ID to cancel", type => "number"},
2860 {desc => "Cancel reason ID", type => "number"}
2862 return => {desc => q/Object describing changed POs, LIs and LIDs
2863 on success; Event on error./}
2867 sub cancel_purchase_order_api {
2868 my ($self, $conn, $auth, $po_id, $cancel_reason) = @_;
2870 my $e = new_editor("xact" => 1, "authtoken" => $auth);
2871 return $e->die_event unless $e->checkauth;
2872 my $mgr = new OpenILS::Application::Acq::BatchManager(
2873 "editor" => $e, "conn" => $conn
2876 $cancel_reason = $mgr->editor->retrieve_acq_cancel_reason($cancel_reason) or
2877 return new OpenILS::Event(
2878 "BAD_PARAMS", "note" => "Provide cancel reason ID"
2881 my $result = cancel_purchase_order($mgr, $po_id, $cancel_reason) or
2882 return $e->die_event;
2883 if (not_cancelable($result)) { # event not from CStoreEditor
2886 } elsif ($result == -1) {
2888 return new OpenILS::Event("ACQ_ALREADY_CANCELED");
2891 $e->commit or return $e->die_event;
2893 # XXX create purchase order status events?
2895 if ($mgr->{post_commit}) {
2896 foreach my $func (@{$mgr->{post_commit}}) {
2904 sub cancel_purchase_order {
2905 my ($mgr, $po_id, $cancel_reason) = @_;
2907 my $po = $mgr->editor->retrieve_acq_purchase_order($po_id) or return 0;
2909 # XXX is "cancelled" a typo? It's not correct US spelling, anyway.
2910 # Depending on context, this may not warrant an event.
2911 return -1 if $po->state eq "cancelled";
2913 # But this always does.
2914 return new OpenILS::Event(
2915 "ACQ_NOT_CANCELABLE", "note" => "purchase_order $po_id"
2916 ) unless ($po->state eq "on-order" or $po->state eq "pending");
2919 $mgr->editor->allowed("CREATE_PURCHASE_ORDER", $po->ordering_agency);
2921 $po->state("cancelled");
2922 $po->cancel_reason($cancel_reason->id);
2924 my $li_ids = $mgr->editor->search_acq_lineitem(
2925 {"purchase_order" => $po_id}, {"idlist" => 1}
2928 my $result = {"li" => {}, "lid" => {}};
2929 foreach my $li_id (@$li_ids) {
2930 my $li_result = cancel_lineitem($mgr, $li_id, $cancel_reason)
2933 next if $li_result == -1; # already canceled:skip.
2934 return $li_result if not_cancelable($li_result); # not cancelable:stop.
2936 # Merge in each LI result (there's only going to be
2937 # one per call to cancel_lineitem).
2938 my ($k, $v) = each %{$li_result->{"li"}};
2939 $result->{"li"}->{$k} = $v;
2941 # Merge in each LID result (there may be many per call to
2943 while (($k, $v) = each %{$li_result->{"lid"}}) {
2944 $result->{"lid"}->{$k} = $v;
2948 my $po_item_ids = $mgr->editor
2949 ->search_acq_po_item({purchase_order => $po_id}, {idlist => 1});
2951 for my $po_item_id (@$po_item_ids) {
2953 my $po_item = $mgr->editor->retrieve_acq_po_item([
2956 flesh_fields => {acqpoi => ['purchase_order', 'fund_debit']}
2958 ]) or return -1; # results in rollback
2960 # returns undef on success
2961 my $result = clear_po_item($mgr->editor, $po_item);
2963 return $result if not_cancelable($result);
2964 return -1 if $result; # other failure events, results in rollback
2968 # TODO who/what/where/how do we indicate this change for electronic orders?
2969 # TODO return changes to encumbered/spent
2970 # TODO maybe cascade up from smaller object to container object if last
2971 # smaller object in the container has been canceled?
2973 update_purchase_order($mgr, $po) or return 0;
2975 $po_id => {"state" => $po->state, "cancel_reason" => $cancel_reason}
2981 __PACKAGE__->register_method(
2982 method => "cancel_lineitem_api",
2983 api_name => "open-ils.acq.lineitem.cancel",
2985 desc => q/Cancels an on-order lineitem/,
2987 {desc => "Authentication token", type => "string"},
2988 {desc => "Lineitem ID to cancel", type => "number"},
2989 {desc => "Cancel reason ID", type => "number"}
2991 return => {desc => q/Object describing changed LIs and LIDs on success;
2996 __PACKAGE__->register_method(
2997 method => "cancel_lineitem_api",
2998 api_name => "open-ils.acq.lineitem.cancel.batch",
3000 desc => q/Batched version of open-ils.acq.lineitem.cancel/,
3001 return => {desc => q/Object describing changed LIs and LIDs on success;
3006 sub cancel_lineitem_api {
3007 my ($self, $conn, $auth, $li_id, $cancel_reason) = @_;
3009 my $batched = $self->api_name =~ /\.batch/;
3011 my $e = new_editor("xact" => 1, "authtoken" => $auth);
3012 return $e->die_event unless $e->checkauth;
3013 my $mgr = new OpenILS::Application::Acq::BatchManager(
3014 "editor" => $e, "conn" => $conn
3017 $cancel_reason = $mgr->editor->retrieve_acq_cancel_reason($cancel_reason) or
3018 return new OpenILS::Event(
3019 "BAD_PARAMS", "note" => "Provide cancel reason ID"
3022 my ($result, $maybe_event);
3025 $result = {"li" => {}, "lid" => {}};
3026 foreach my $one_li_id (@$li_id) {
3027 my $one = cancel_lineitem($mgr, $one_li_id, $cancel_reason) or
3028 return $e->die_event;
3029 if (not_cancelable($one)) {
3030 $maybe_event = $one;
3031 } elsif ($result == -1) {
3032 $maybe_event = new OpenILS::Event("ACQ_ALREADY_CANCELED");
3036 while (($k, $v) = each %{$one->{"li"}}) {
3037 $result->{"li"}->{$k} = $v;
3040 if ($one->{"lid"}) {
3041 while (($k, $v) = each %{$one->{"lid"}}) {
3042 $result->{"lid"}->{$k} = $v;
3048 $result = cancel_lineitem($mgr, $li_id, $cancel_reason) or
3049 return $e->die_event;
3051 if (not_cancelable($result)) {
3054 } elsif ($result == -1) {
3056 return new OpenILS::Event("ACQ_ALREADY_CANCELED");
3060 if ($batched and not scalar keys %{$result->{"li"}}) {
3062 return $maybe_event;
3064 $e->commit or return $e->die_event;
3065 # create_lineitem_status_events should handle array li_id ok
3066 create_lineitem_status_events($mgr, $li_id, "aur.cancelled");
3068 if ($mgr->{post_commit}) {
3069 foreach my $func (@{$mgr->{post_commit}}) {
3078 sub cancel_lineitem {
3079 my ($mgr, $li_id, $cancel_reason) = @_;
3081 my $li = $mgr->editor->retrieve_acq_lineitem([
3082 $li_id, {flesh => 1,
3083 flesh_fields => {jub => ['purchase_order','cancel_reason']}}
3086 return 0 unless $mgr->editor->allowed(
3087 "CREATE_PURCHASE_ORDER", $li->purchase_order->ordering_agency
3090 # Depending on context, this may not warrant an event.
3091 return -1 if $li->state eq "cancelled"
3092 and $li->cancel_reason->keep_debits eq 'f';
3094 # But this always does. Note that this used to be looser, but you can
3095 # no longer cancel lineitems that lack a PO or that are in "pending-order"
3096 # state (you could in the past).
3097 return new OpenILS::Event(
3098 "ACQ_NOT_CANCELABLE", "note" => "lineitem $li_id"
3099 ) unless $li->purchase_order and
3100 ($li->state eq "on-order" or $li->state eq "cancelled");
3102 $li->state("cancelled");
3103 $li->cancel_reason($cancel_reason->id);
3105 my $lids = $mgr->editor->search_acq_lineitem_detail([{
3106 "lineitem" => $li_id
3109 flesh_fields => { acqlid => ['eg_copy_id'] }
3112 my $result = {"lid" => {}};
3114 foreach my $lid (@$lids) {
3115 my $lid_result = cancel_lineitem_detail($mgr, $lid->id, $cancel_reason)
3118 # gathering any real copies for deletion
3119 if ($lid->eg_copy_id) {
3120 $lid->eg_copy_id->isdeleted('t');
3121 push @$copies, $lid->eg_copy_id;
3124 next if $lid_result == -1; # already canceled: just skip it.
3125 return $lid_result if not_cancelable($lid_result); # not cxlable: stop.
3127 # Merge in each LID result (there's only going to be one per call to
3128 # cancel_lineitem_detail).
3129 my ($k, $v) = each %{$lid_result->{"lid"}};
3130 $result->{"lid"}->{$k} = $v;
3133 # Attempt to delete the gathered copies (this will also handle volume deletion and bib deletion)
3134 # Delete empty bibs according org unit setting
3135 my $force_delete_empty_bib = $U->ou_ancestor_setting_value(
3136 $mgr->editor->requestor->ws_ou, 'cat.bib.delete_on_no_copy_via_acq_lineitem_cancel', $mgr->editor);
3137 if (scalar(@$copies)>0) {
3139 my $delete_stats = undef;
3140 my $retarget_holds = [];
3141 my $cat_evt = OpenILS::Application::Cat::AssetCommon->update_fleshed_copies(
3142 $mgr->editor, $override, undef, $copies, $delete_stats, $retarget_holds,$force_delete_empty_bib);
3145 $logger->info("fleshed copy update failed with event: ".OpenSRF::Utils::JSON->perl2JSON($cat_evt));
3146 return new OpenILS::Event(
3147 "ACQ_NOT_CANCELABLE", "note" => "lineitem $li_id", "payload" => $cat_evt
3151 # We can't do the following and stay within the same transaction, but that's okay, the hold targeter will pick these up later.
3152 #my $ses = OpenSRF::AppSession->create('open-ils.circ');
3153 #$ses->request('open-ils.circ.hold.reset.batch', $auth, $retarget_holds);
3156 # if we have a bib, check to see whether it has been deleted. if so, cancel any active holds targeting that bib
3157 if ($li->eg_bib_id) {
3158 my $bib = $mgr->editor->retrieve_biblio_record_entry($li->eg_bib_id) or return new OpenILS::Event(
3159 "ACQ_NOT_CANCELABLE", "note" => "Could not retrieve bib " . $li->eg_bib_id . " for lineitem $li_id"
3161 if ($U->is_true($bib->deleted)) {
3162 my $holds = $mgr->editor->search_action_hold_request(
3163 { cancel_time => undef,
3164 fulfillment_time => undef,
3165 target => $li->eg_bib_id
3169 my %cached_usr_home_ou = ();
3171 for my $hold (@$holds) {
3173 $logger->info("Cancelling hold ".$hold->id.
3174 " due to acq lineitem cancellation.");
3176 $hold->cancel_time('now');
3177 $hold->cancel_cause(5); # 'Staff forced'--we may want a new hold cancel cause reason for this
3178 $hold->cancel_note('Corresponding Acquistion Lineitem/Purchase Order was cancelled.');
3179 unless($mgr->editor->update_action_hold_request($hold)) {
3180 my $evt = $mgr->editor->event;
3181 $logger->error("Error updating hold ". $evt->textcode .":". $evt->desc .":". $evt->stacktrace);
3182 return new OpenILS::Event(
3183 "ACQ_NOT_CANCELABLE", "note" => "Could not cancel hold " . $hold->id . " for lineitem $li_id", "payload" => $evt
3186 if (! defined $mgr->{post_commit}) { # we need a mechanism for creating trigger events, but only if the transaction gets committed
3187 $mgr->{post_commit} = [];
3189 push @{ $mgr->{post_commit} }, sub {
3190 my $home_ou = $cached_usr_home_ou{$hold->usr};
3192 my $user = $mgr->editor->retrieve_actor_user($hold->usr); # FIXME: how do we want to handle failures here?
3193 $home_ou = $user->home_ou;
3194 $cached_usr_home_ou{$hold->usr} = $home_ou;
3196 $U->create_events_for_hook('hold_request.cancel.cancelled_order', $hold, $home_ou);
3202 update_lineitem($mgr, $li) or return 0;
3205 "state" => $li->state,
3206 "cancel_reason" => $cancel_reason
3213 __PACKAGE__->register_method(
3214 method => "cancel_lineitem_detail_api",
3215 api_name => "open-ils.acq.lineitem_detail.cancel",
3217 desc => q/Cancels an on-order lineitem detail/,
3219 {desc => "Authentication token", type => "string"},
3220 {desc => "Lineitem detail ID to cancel", type => "number"},
3221 {desc => "Cancel reason ID", type => "number"}
3223 return => {desc => q/Object describing changed LIDs on success;
3228 sub cancel_lineitem_detail_api {
3229 my ($self, $conn, $auth, $lid_id, $cancel_reason) = @_;
3231 my $e = new_editor("xact" => 1, "authtoken" => $auth);
3232 return $e->die_event unless $e->checkauth;
3233 my $mgr = new OpenILS::Application::Acq::BatchManager(
3234 "editor" => $e, "conn" => $conn
3237 $cancel_reason = $mgr->editor->retrieve_acq_cancel_reason($cancel_reason) or
3238 return new OpenILS::Event(
3239 "BAD_PARAMS", "note" => "Provide cancel reason ID"
3242 my $result = cancel_lineitem_detail($mgr, $lid_id, $cancel_reason) or
3243 return $e->die_event;
3245 if (not_cancelable($result)) {
3248 } elsif ($result == -1) {
3250 return new OpenILS::Event("ACQ_ALREADY_CANCELED");
3253 $e->commit or return $e->die_event;
3255 # XXX create lineitem detail status events?
3259 sub cancel_lineitem_detail {
3260 my ($mgr, $lid_id, $cancel_reason) = @_;
3261 my $lid = $mgr->editor->retrieve_acq_lineitem_detail([
3265 "acqlid" => ["lineitem","cancel_reason"],
3266 "jub" => ["purchase_order"]
3271 # It's OK to cancel an already-canceled copy if the copy was
3272 # previously "delayed" -- keep_debits == true
3273 # Depending on context, this may not warrant an event.
3274 return -1 if $lid->cancel_reason
3275 and $lid->cancel_reason->keep_debits eq 'f';
3277 # But this always does.
3278 return new OpenILS::Event(
3279 "ACQ_NOT_CANCELABLE", "note" => "lineitem_detail $lid_id"
3281 (! $lid->lineitem->purchase_order) or
3283 (not $lid->recv_time) and
3285 $lid->lineitem->purchase_order and (
3286 $lid->lineitem->state eq "on-order" or
3287 $lid->lineitem->state eq "pending-order" or
3288 $lid->lineitem->state eq "cancelled"
3293 return 0 unless $mgr->editor->allowed(
3294 "CREATE_PURCHASE_ORDER",
3295 $lid->lineitem->purchase_order->ordering_agency
3296 ) or (! $lid->lineitem->purchase_order);
3298 $lid->cancel_reason($cancel_reason->id);
3300 unless($U->is_true($cancel_reason->keep_debits)) {
3301 my $debit_id = $lid->fund_debit;
3302 $lid->clear_fund_debit;
3305 # item is cancelled. Remove the fund debit.
3306 my $debit = $mgr->editor->retrieve_acq_fund_debit($debit_id);
3307 if (!$U->is_true($debit->encumbrance)) {
3308 $mgr->editor->rollback;
3309 return OpenILS::Event->new('ACQ_NOT_CANCELABLE',
3310 note => "Debit is marked as paid: $debit_id");
3312 $mgr->editor->delete_acq_fund_debit($debit) or return $mgr->editor->die_event;
3316 # XXX LIDs don't have either an editor or a edit_time field. Should we
3317 # update these on the LI when we alter an LID?
3318 $mgr->editor->update_acq_lineitem_detail($lid) or return 0;
3320 return {"lid" => {$lid_id => {"cancel_reason" => $cancel_reason}}};
3323 __PACKAGE__->register_method(
3324 method => "delete_po_item_api",
3325 api_name => "open-ils.acq.po_item.delete",
3327 desc => q/Deletes a po_item and removes its debit/,
3329 {desc => "Authentication token", type => "string"},
3330 {desc => "po_item ID to delete", type => "number"},
3332 return => {desc => q/1 on success, Event on error/}
3336 sub delete_po_item_api {
3337 my($self, $client, $auth, $po_item_id) = @_;
3338 my $e = new_editor(authtoken => $auth, xact => 1);
3339 return $e->die_event unless $e->checkauth;
3341 my $po_item = $e->retrieve_acq_po_item([
3344 flesh_fields => {acqpoi => ['purchase_order', 'fund_debit']}
3346 ]) or return $e->die_event;
3348 return $e->die_event unless
3349 $e->allowed('CREATE_PURCHASE_ORDER',
3350 $po_item->purchase_order->ordering_agency);
3352 # remove debit, delete item
3353 my $result = clear_po_item($e, $po_item, 1);
3365 # 1. Removes linked fund debit from a PO item if present and still encumbered.
3366 # 2. Optionally also deletes the po_item object
3367 # po_item is fleshed with purchase_order and fund_debit
3369 my ($e, $po_item, $delete_item) = @_;
3371 if ($po_item->fund_debit) {
3373 if (!$U->is_true($po_item->fund_debit->encumbrance)) {
3374 # debit has been paid. We cannot delete it.
3375 return OpenILS::Event->new('ACQ_NOT_CANCELABLE',
3376 note => "Debit is marked as paid: ".$po_item->fund_debit->id);
3379 # fund_debit is OK to delete.
3380 $e->delete_acq_fund_debit($po_item->fund_debit)
3381 or return $e->die_event;
3385 $e->delete_acq_po_item($po_item) or return $e->die_event;
3387 # remove our link to the now-deleted fund_debit.
3388 $po_item->clear_fund_debit;
3389 $e->update_acq_po_item($po_item) or return $e->die_event;
3396 __PACKAGE__->register_method(
3397 method => 'user_requests',
3398 api_name => 'open-ils.acq.user_request.retrieve.by_user_id',
3401 desc => 'Retrieve fleshed user requests and related data for a given user.',
3403 { desc => 'Authentication token', type => 'string' },
3404 { desc => 'User ID of the owner, or array of IDs', },
3405 { desc => 'Options hash (optional) with any of the keys: order_by, limit, offset, state (of the lineitem)',
3410 desc => 'Fleshed user requests and related data',
3416 __PACKAGE__->register_method(
3417 method => 'user_requests',
3418 api_name => 'open-ils.acq.user_request.retrieve.by_home_ou',
3421 desc => 'Retrieve fleshed user requests and related data for a given org unit or units.',
3423 { desc => 'Authentication token', type => 'string' },
3424 { desc => 'Org unit ID, or array of IDs', },
3425 { desc => 'Options hash (optional) with any of the keys: order_by, limit, offset, state (of the lineitem)',
3430 desc => 'Fleshed user requests and related data',
3437 my($self, $conn, $auth, $search_value, $options) = @_;
3438 my $e = new_editor(authtoken => $auth);
3439 return $e->event unless $e->checkauth;
3440 my $rid = $e->requestor->id;
3444 "select"=>{"aur"=>["id"],"au"=>["home_ou", {column => 'id', alias => 'usr_id'} ]},
3445 "from"=>{ "aur" => { "au" => {}, "jub" => { "type" => "left" } } },
3449 {"id"=>undef}, # this with the left-join pulls in requests without lineitems
3450 {"state"=>["new","on-order","pending-order"]} # FIXME - probably needs softcoding
3454 "order_by"=>[{"class"=>"aur", "field"=>"request_date", "direction"=>"desc"}]
3457 foreach (qw/ order_by limit offset /) {
3458 $query->{$_} = $options->{$_} if defined $options->{$_};
3460 if (defined $options->{'state'}) {
3461 $query->{'where'}->{'+jub'}->{'-or'}->[1]->{'state'} = $options->{'state'};
3464 if ($self->api_name =~ /by_user_id/) {
3465 $query->{'where'}->{'usr'} = $search_value;
3467 $query->{'where'}->{'+au'} = { 'home_ou' => $search_value };
3470 my $pertinent_ids = $e->json_query($query);
3473 for my $id_blob (@$pertinent_ids) {
3474 if ($rid != $id_blob->{usr_id}) {
3475 if (!defined $perm_test{ $id_blob->{home_ou} }) {
3476 $perm_test{ $id_blob->{home_ou} } = $e->allowed( ['user_request.view'], $id_blob->{home_ou} );
3478 if (!$perm_test{ $id_blob->{home_ou} }) {
3482 my $aur_obj = $e->retrieve_acq_user_request([
3484 {flesh => 1, flesh_fields => { "aur" => [ 'lineitem' ] } }
3486 if (! $aur_obj) { next; }
3488 if ($aur_obj->lineitem()) {
3489 $aur_obj->lineitem()->clear_marc();
3491 $conn->respond($aur_obj);
3497 __PACKAGE__->register_method (
3498 method => 'update_user_request',
3499 api_name => 'open-ils.acq.user_request.cancel.batch',
3502 desc => 'If given a cancel reason, will update the request with that reason, otherwise, this will delete the request altogether. The ' .
3503 'intention is for staff interfaces or processes to provide cancel reasons, and for patron interfaces to just delete the requests.' ,
3505 { desc => 'Authentication token', type => 'string' },
3506 { desc => 'ID or array of IDs for the user requests to cancel' },
3507 { desc => 'Cancel Reason ID (optional)', type => 'string' }
3510 desc => 'progress object, event on error',
3514 __PACKAGE__->register_method (
3515 method => 'update_user_request',
3516 api_name => 'open-ils.acq.user_request.set_no_hold.batch',
3519 desc => 'Remove the hold from a user request or set of requests',
3521 { desc => 'Authentication token', type => 'string' },
3522 { desc => 'ID or array of IDs for the user requests to modify' }
3525 desc => 'progress object, event on error',
3530 sub update_user_request {
3531 my($self, $conn, $auth, $aur_ids, $cancel_reason) = @_;
3532 my $e = new_editor(xact => 1, authtoken => $auth);
3533 return $e->die_event unless $e->checkauth;
3534 my $rid = $e->requestor->id;
3538 for my $id (@$aur_ids) {
3540 my $aur_obj = $e->retrieve_acq_user_request([
3543 flesh_fields => { "aur" => ['lineitem', 'usr'] }
3545 ]) or return $e->die_event;
3547 my $context_org = $aur_obj->usr()->home_ou();
3548 $aur_obj->usr( $aur_obj->usr()->id() );
3550 if ($rid != $aur_obj->usr) {
3551 if (!defined $perm_test{ $context_org }) {
3552 $perm_test{ $context_org } = $e->allowed( ['user_request.update'], $context_org );
3554 if (!$perm_test{ $context_org }) {
3559 if($self->api_name =~ /set_no_hold/) {
3560 if ($U->is_true($aur_obj->hold)) {
3562 $e->update_acq_user_request($aur_obj) or return $e->die_event;
3566 if($self->api_name =~ /cancel/) {
3567 if ( $cancel_reason ) {
3568 $aur_obj->cancel_reason( $cancel_reason );
3569 $e->update_acq_user_request($aur_obj) or return $e->die_event;
3570 create_user_request_events( $e, [ $aur_obj ], 'aur.rejected' );
3572 $e->delete_acq_user_request($aur_obj);
3576 $conn->respond({maximum => scalar(@$aur_ids), progress => $x++});
3580 return {complete => 1};
3583 __PACKAGE__->register_method (
3584 method => 'new_user_request',
3585 api_name => 'open-ils.acq.user_request.create',
3587 desc => 'Create a new user request object in the DB',
3589 { desc => 'Authentication token', type => 'string' },
3590 { desc => 'User request data hash. Hash keys match the fields for the "aur" object', type => 'object' }
3593 desc => 'The created user request object, or event on error'
3598 sub new_user_request {
3599 my($self, $conn, $auth, $form_data) = @_;
3600 my $e = new_editor(xact => 1, authtoken => $auth);
3601 return $e->die_event unless $e->checkauth;
3602 my $rid = $e->requestor->id;
3603 my $target_user_fleshed;
3604 if (! defined $$form_data{'usr'}) {
3605 $$form_data{'usr'} = $rid;
3607 if ($$form_data{'usr'} != $rid) {
3608 # See if the requestor can place the request on behalf of a different user.
3609 $target_user_fleshed = $e->retrieve_actor_user($$form_data{'usr'}) or return $e->die_event;
3610 $e->allowed('user_request.create', $target_user_fleshed->home_ou) or return $e->die_event;
3612 $target_user_fleshed = $e->requestor;
3613 $e->allowed('CREATE_PURCHASE_REQUEST') or return $e->die_event;
3615 if (! defined $$form_data{'pickup_lib'}) {
3616 if ($target_user_fleshed->ws_ou) {
3617 $$form_data{'pickup_lib'} = $target_user_fleshed->ws_ou;
3619 $$form_data{'pickup_lib'} = $target_user_fleshed->home_ou;
3622 if (! defined $$form_data{'request_type'}) {
3623 $$form_data{'request_type'} = 1; # Books
3625 my $aur_obj = new Fieldmapper::acq::user_request;
3627 $aur_obj->usr( $$form_data{'usr'} );
3628 $aur_obj->request_date( 'now' );
3629 for my $field ( keys %$form_data ) {
3630 if (defined $$form_data{$field} and $field !~ /^(id|lineitem|eg_bib|request_date|cancel_reason)$/) {
3631 $aur_obj->$field( $$form_data{$field} );
3635 $aur_obj = $e->create_acq_user_request($aur_obj) or return $e->die_event;
3637 $e->commit and create_user_request_events( $e, [ $aur_obj ], 'aur.created' );
3642 sub create_user_request_events {
3643 my($e, $user_reqs, $hook) = @_;
3645 my $ses = OpenSRF::AppSession->create('open-ils.trigger');
3648 my %cached_usr_home_ou = ();
3649 for my $user_req (@$user_reqs) {
3650 my $home_ou = $cached_usr_home_ou{$user_req->usr};
3652 my $user = $e->retrieve_actor_user($user_req->usr) or return $e->die_event;
3653 $home_ou = $user->home_ou;
3654 $cached_usr_home_ou{$user_req->usr} = $home_ou;
3656 my $req = $ses->request('open-ils.trigger.event.autocreate', $hook, $user_req, $home_ou);
3665 __PACKAGE__->register_method(
3666 method => "po_note_CUD_batch",
3667 api_name => "open-ils.acq.po_note.cud.batch",
3670 desc => q/Manage purchase order notes/,
3672 {desc => "Authentication token", type => "string"},
3673 {desc => "List of po_notes to manage", type => "array"},
3675 return => {desc => "Stream of successfully managed objects"}
3679 sub po_note_CUD_batch {
3680 my ($self, $conn, $auth, $notes) = @_;
3682 my $e = new_editor("xact"=> 1, "authtoken" => $auth);
3683 return $e->die_event unless $e->checkauth;
3686 my $total = @$notes;
3689 foreach my $note (@$notes) {
3691 $note->editor($e->requestor->id);
3692 $note->edit_time("now");
3695 $note->creator($e->requestor->id);
3696 $note = $e->create_acq_po_note($note) or return $e->die_event;
3697 } elsif ($note->isdeleted) {
3698 $e->delete_acq_po_note($note) or return $e->die_event;
3699 } elsif ($note->ischanged) {
3700 $e->update_acq_po_note($note) or return $e->die_event;
3703 unless ($note->isdeleted) {
3704 $note = $e->retrieve_acq_po_note($note->id) or
3705 return $e->die_event;
3709 {"maximum" => $total, "progress" => ++$count, "note" => $note}
3713 $e->commit and $conn->respond_complete or return $e->die_event;
3717 # retrieves a lineitem, fleshes its PO and PL, checks perms
3718 # returns ($li, $evt, $org)
3719 sub fetch_and_check_li {
3722 my $perm_mode = shift || 'read';
3724 my $li = $e->retrieve_acq_lineitem([
3727 flesh_fields => {jub => ['purchase_order', 'picklist']}
3729 ]) or return (undef, $e->die_event);
3732 if(my $po = $li->purchase_order) {
3733 $org = $po->ordering_agency;
3734 my $perms = ($perm_mode eq 'read') ? 'VIEW_PURCHASE_ORDER' : 'CREATE_PURCHASE_ORDER';
3735 return ($li, $e->die_event) unless $e->allowed($perms, $org);
3737 } elsif(my $pl = $li->picklist) {
3738 $org = $pl->org_unit;
3739 my $perms = ($perm_mode eq 'read') ? 'VIEW_PICKLIST' : 'CREATE_PICKLIST';
3740 return ($li, $e->die_event) unless $e->allowed($perms, $org);
3743 return ($li, undef, $org);
3747 __PACKAGE__->register_method(
3748 method => "clone_distrib_form",
3749 api_name => "open-ils.acq.distribution_formula.clone",
3752 desc => q/Clone a distribution formula/,
3754 {desc => "Authentication token", type => "string"},
3755 {desc => "Original formula ID", type => 'integer'},
3756 {desc => "Name of new formula", type => 'string'},
3758 return => {desc => "ID of newly created formula"}
3762 sub clone_distrib_form {
3763 my($self, $client, $auth, $form_id, $new_name) = @_;
3765 my $e = new_editor("xact"=> 1, "authtoken" => $auth);
3766 return $e->die_event unless $e->checkauth;
3768 my $old_form = $e->retrieve_acq_distribution_formula($form_id) or return $e->die_event;
3769 return $e->die_event unless $e->allowed('ADMIN_ACQ_DISTRIB_FORMULA', $old_form->owner);
3771 my $new_form = Fieldmapper::acq::distribution_formula->new;
3773 $new_form->owner($old_form->owner);
3774 $new_form->name($new_name);
3775 $e->create_acq_distribution_formula($new_form) or return $e->die_event;
3777 my $entries = $e->search_acq_distribution_formula_entry({formula => $form_id});
3778 for my $entry (@$entries) {
3779 my $new_entry = Fieldmapper::acq::distribution_formula_entry->new;
3780 $new_entry->$_($entry->$_()) for $entry->real_fields;
3781 $new_entry->formula($new_form->id);
3782 $new_entry->clear_id;
3783 $e->create_acq_distribution_formula_entry($new_entry) or return $e->die_event;
3787 return $new_form->id;
3790 __PACKAGE__->register_method(
3791 method => 'add_li_to_po',
3792 api_name => 'open-ils.acq.purchase_order.add_lineitem',
3794 desc => q/Adds a lineitem to an existing purchase order/,
3796 {desc => 'Authentication token', type => 'string'},
3797 {desc => 'The purchase order id', type => 'number'},
3798 {desc => 'The lineitem ID (or an array of them)', type => 'mixed'},
3800 return => {desc => 'Streams a total versus completed counts object, event on error'}
3805 my($self, $conn, $auth, $po_id, $li_id) = @_;
3807 my $e = new_editor(authtoken => $auth, xact => 1);
3808 return $e->die_event unless $e->checkauth;
3810 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
3812 my $po = $e->retrieve_acq_purchase_order($po_id)
3813 or return $e->die_event;
3815 return $e->die_event unless
3816 $e->allowed('CREATE_PURCHASE_ORDER', $po->ordering_agency);
3818 unless ($po->state =~ /new|pending/) {
3820 return {success => 0, po => $po, error => 'bad-po-state'};
3825 if (ref $li_id eq "ARRAY") {
3826 $li_id = [ map { int($_) } @$li_id ];
3827 return $e->die_event(new OpenILS::Event("BAD_PARAMS")) unless @$li_id;
3829 $lis = $e->search_acq_lineitem({id => $li_id})
3830 or return $e->die_event;
3832 my $li = $e->retrieve_acq_lineitem(int($li_id))
3833 or return $e->die_event;
3837 foreach my $li (@$lis) {
3838 if ($li->state !~ /new|order-ready|pending-order/ or
3839 $li->purchase_order) {
3841 return {success => 0, li => $li, error => 'bad-li-state'};
3844 $li->provider($po->provider);
3845 $li->purchase_order($po_id);
3846 $li->state('pending-order');
3847 apply_default_copies($mgr, $po, $li->id) or return $e->die_event;
3848 update_lineitem($mgr, $li) or return $e->die_event;
3852 return {success => 1};
3855 __PACKAGE__->register_method(
3856 method => 'po_lineitems_no_copies',
3857 api_name => 'open-ils.acq.purchase_order.no_copy_lineitems.id_list',
3861 desc => q/Returns the set of lineitem IDs for a given PO that have no copies attached/,
3863 {desc => 'Authentication token', type => 'string'},
3864 {desc => 'The purchase order id', type => 'number'},
3866 return => {desc => 'Stream of lineitem IDs on success, event on error'}
3870 sub po_lineitems_no_copies {
3871 my ($self, $conn, $auth, $po_id) = @_;
3873 my $e = new_editor(authtoken => $auth);
3874 return $e->event unless $e->checkauth;
3876 # first check the view perms for LI's attached to this PO
3877 my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->event;
3878 return $e->event unless $e->allowed('VIEW_PURCHASE_ORDER', $po->ordering_agency);
3880 my $ids = $e->json_query({
3881 select => {jub => ['id']},
3882 from => {jub => {acqlid => {type => 'left'}}},
3884 '+jub' => {purchase_order => $po_id},
3885 '+acqlid' => {lineitem => undef}
3889 $conn->respond($_->{id}) for @$ids;
3893 __PACKAGE__->register_method(
3894 method => 'set_li_order_ident',
3895 api_name => 'open-ils.acq.lineitem.order_identifier.set',
3898 Given an existing lineitem_attr (typically a marc_attr), this will
3899 create a matching local_attr to store the name and value and mark
3900 the attr as the order_ident. Any existing local_attr marked as
3901 order_ident is removed.
3904 {desc => 'Authentication token', type => 'string'},
3905 {desc => q/Args object:
3906 source_attr_id : ID of the existing lineitem_attr to use as
3908 lineitem_id : lineitem id
3909 attr_name : name ('isbn', etc.) of a new marc_attr to add to
3910 the lineitem to use for the order ident
3911 attr_value : value for the new marc_attr
3912 no_apply_bre : if set, newly added attrs will not be applied
3913 to the lineitems' linked bib record/,
3916 return => {desc => q/Returns the attribute
3917 responsible for tracking the order identifier/}
3921 sub set_li_order_ident {
3922 my ($self, $conn, $auth, $args) = @_;
3926 my $source_attr_id = $args->{source_attr_id};
3928 my $e = new_editor(authtoken => $auth, xact => 1);
3929 return $e->die_event unless $e->checkauth;
3931 # fetch attr, LI, and check update permissions
3933 my $li_id = $args->{lineitem_id};
3935 if ($source_attr_id) {
3936 $source_attr = $e->retrieve_acq_lineitem_attr($source_attr_id)
3937 or return $e->die_event;
3938 $li_id = $source_attr->lineitem;
3941 my ($li, $evt, $perm_org) = fetch_and_check_li($e, $li_id, 'write');
3942 return $evt if $evt;
3944 return $e->die_event unless
3945 $e->allowed('ACQ_SET_LINEITEM_IDENTIFIER', $perm_org);
3947 # if needed, create a new marc attr for
3948 # the lineitem to represent the ident value
3950 ($source_attr, $evt) = apply_new_li_ident_attr(
3951 $e, $li, $perm_org, $args->{attr_name}, $args->{attr_value})
3952 unless $source_attr;
3954 return $evt if $evt;
3956 # remove the existing order_ident attribute if present
3958 my $old_attr = $e->search_acq_lineitem_attr({
3959 attr_type => 'lineitem_local_attr_definition',
3960 lineitem => $li->id,
3966 # if we already have an order_ident that matches the
3967 # source attr, there's nothing left to do.
3969 if ($old_attr->attr_name eq $source_attr->attr_name and
3970 $old_attr->attr_value eq $source_attr->attr_value) {
3976 # remove the old order_ident attribute
3977 $e->delete_acq_lineitem_attr($old_attr) or return $e->die_event;
3981 # make sure we have a local_attr_def to match the source attr def
3983 my $local_def = $e->search_acq_lineitem_local_attr_definition({
3984 code => $source_attr->attr_name
3989 $e->retrieve_acq_lineitem_attr_definition($source_attr->definition);
3990 $local_def = Fieldmapper::acq::lineitem_local_attr_definition->new;
3991 $local_def->code($source_def->code);
3992 $local_def->description($source_def->description);
3993 $local_def = $e->create_acq_lineitem_local_attr_definition($local_def)
3994 or return $e->die_event;
3997 # create the new order_ident local attr
3999 my $new_attr = Fieldmapper::acq::lineitem_attr->new;
4000 $new_attr->definition($local_def->id);
4001 $new_attr->attr_type('lineitem_local_attr_definition');
4002 $new_attr->lineitem($li->id);
4003 $new_attr->attr_name($source_attr->attr_name);
4004 $new_attr->attr_value($source_attr->attr_value);
4005 $new_attr->order_ident('t');
4007 $new_attr = $e->create_acq_lineitem_attr($new_attr)
4008 or return $e->die_event;
4015 # Given an isbn, issn, or upc, add the value to the lineitem marc.
4016 # Upon update, the value will be auto-magically represented as
4017 # a lineitem marc attr.
4018 # If the li is linked to a bib record and the user has the correct
4019 # permissions, update the bib record to match.
4020 sub apply_new_li_ident_attr {
4021 my ($e, $li, $perm_org, $attr_name, $attr_value) = @_;
4029 my $marc_field = MARC::Field->new(
4030 $tags{$attr_name}, '', '','a' => $attr_value);
4032 my $li_rec = MARC::Record->new_from_xml($li->marc, 'UTF-8', 'USMARC');
4033 $li_rec->insert_fields_ordered($marc_field);
4035 $li->marc(clean_marc($li_rec));
4036 $li->editor($e->requestor->id);
4037 $li->edit_time('now');
4039 $e->update_acq_lineitem($li) or return (undef, $e->die_event);
4041 my $source_attr = $e->search_acq_lineitem_attr({
4042 attr_name => $attr_name,
4043 attr_value => $attr_value,
4044 attr_type => 'lineitem_marc_attr_definition'
4047 if (!$source_attr) {
4048 $logger->error("ACQ lineitem update failed to produce a matching ".
4049 " marc attribute for $attr_name => $attr_value");
4050 return (undef, OpenILS::Event->new('INTERNAL_SERVER_ERROR'));
4053 return ($source_attr) unless
4055 $e->allowed('ACQ_ADD_LINEITEM_IDENTIFIER', $perm_org);
4057 # li is linked to a bib record and user has the update perms
4059 my $bre = $e->retrieve_biblio_record_entry($li->eg_bib_id);
4060 my $bre_marc = MARC::Record->new_from_xml($bre->marc, 'UTF-8', 'USMARC');
4061 $bre_marc->insert_fields_ordered($marc_field);
4063 $bre->marc(clean_marc($bre_marc));
4064 $bre->editor($e->requestor->id);
4065 $bre->edit_date('now');
4067 $e->update_biblio_record_entry($bre) or return (undef, $e->die_event);
4069 return ($source_attr);
4072 __PACKAGE__->register_method(
4073 method => 'li_existing_copies',
4074 api_name => 'open-ils.acq.lineitem.existing_copies.count',
4078 Returns the number of catalog copies (acp) which are children of
4079 the same bib record linked to by the given lineitem and which
4080 are owned at or below the lineitem context org unit.
4081 Copies with the following statuses are not counted:
4082 Lost, Missing, Discard Weed, and Lost and Paid.
4085 {desc => 'Authentication token', type => 'string'},
4086 {desc => 'Lineitem ID', type => 'number'}
4088 return => {desc => q/Count or event on error/}
4092 sub li_existing_copies {
4093 my ($self, $client, $auth, $li_id) = @_;
4094 my $e = new_editor("authtoken" => $auth);
4095 return $e->die_event unless $e->checkauth;
4097 my ($li, $evt, $org) = fetch_and_check_li($e, $li_id);
4100 # No fuzzy matching here (e.g. on ISBN). Only exact matches are supported.
4101 return 0 unless $li->eg_bib_id;
4103 my $counts = $e->json_query({
4104 select => {acp => [{
4106 transform => 'count',
4113 field => 'eg_copy_id',
4116 acn => {join => {bre => {}}}
4120 '+bre' => {id => $li->eg_bib_id},
4121 # don't count copies linked to the lineitem in question
4124 {lineitem => undef},
4125 {lineitem => {'<>' => $li_id}}
4129 owning_lib => $U->get_org_descendants($org)
4131 # NOTE: should the excluded copy statuses be an AOUS?
4132 '+acp' => {status => {'not in' => [3, 4, 13, 17]}}
4136 return $counts->[0]->{id};