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 if ($copy->status == OILS_COPY_STATUS_ON_ORDER) {
771 my $custom_status = $U->ou_ancestor_setting_value(
772 $e->requestor->ws_ou, 'acq.copy_status_on_receiving', $e);
773 my $new_status = $custom_status || OILS_COPY_STATUS_IN_PROCESS;
774 $copy->status($new_status);
776 $copy->edit_date('now');
777 $copy->editor($e->requestor->id);
778 $copy->creator($e->requestor->id) if $U->ou_ancestor_setting_value(
779 $e->requestor->ws_ou, 'acq.copy_creator_uses_receiver', $e);
780 $e->update_asset_copy($copy) or return 0;
785 return 1 if $skip_complete_check;
787 my $li = check_lineitem_received($mgr, $lid->lineitem) or return 0;
788 return 1 if $li == 1; # li not received
790 return check_purchase_order_received($mgr, $li->purchase_order);
794 sub rollback_receive_lineitem_detail {
795 my($mgr, $lid_id) = @_;
796 my $e = $mgr->editor;
798 my $lid = $e->retrieve_acq_lineitem_detail([
802 acqlid => ['fund_debit']
807 return 1 unless $lid->recv_time;
809 $lid->clear_receiver;
810 $lid->clear_recv_time;
811 $e->update_acq_lineitem_detail($lid) or return 0;
813 if ($lid->eg_copy_id) {
814 my $copy = $e->retrieve_asset_copy($lid->eg_copy_id) or return 0;
815 $copy->status(OILS_COPY_STATUS_ON_ORDER);
816 $copy->edit_date('now');
817 $copy->editor($e->requestor->id);
818 $e->update_asset_copy($copy) or return 0;
825 # ----------------------------------------------------------------------------
827 # ----------------------------------------------------------------------------
828 sub set_lineitem_attr {
829 my($mgr, %args) = @_;
830 my $attr_type = $args{attr_type};
832 # first, see if it's already set. May just need to overwrite it
833 my $attr = $mgr->editor->search_acq_lineitem_attr({
834 lineitem => $args{lineitem},
835 attr_type => $args{attr_type},
836 attr_name => $args{attr_name}
840 $attr->attr_value($args{attr_value});
841 return $attr if $mgr->editor->update_acq_lineitem_attr($attr);
846 $attr = Fieldmapper::acq::lineitem_attr->new;
847 $attr->$_($args{$_}) for keys %args;
849 unless($attr->definition) {
850 my $find = "search_acq_$attr_type";
851 my $attr_def_id = $mgr->editor->$find({code => $attr->attr_name}, {idlist=>1})->[0] or return 0;
852 $attr->definition($attr_def_id);
854 return $mgr->editor->create_acq_lineitem_attr($attr);
858 # ----------------------------------------------------------------------------
860 # ----------------------------------------------------------------------------
861 sub create_lineitem_debits {
862 my ($mgr, $li, $options) = @_;
864 my $dry_run = $options->{dry_run};
866 unless($li->estimated_unit_price) {
867 $mgr->editor->event(OpenILS::Event->new('ACQ_LINEITEM_NO_PRICE', payload => $li->id));
868 $mgr->editor->rollback;
872 unless($li->provider) {
873 $mgr->editor->event(OpenILS::Event->new('ACQ_LINEITEM_NO_PROVIDER', payload => $li->id));
874 $mgr->editor->rollback;
878 my $lid_ids = $mgr->editor->search_acq_lineitem_detail(
879 {lineitem => $li->id},
883 if (@$lid_ids == 0 and !$options->{zero_copy_activate}) {
884 $mgr->editor->event(OpenILS::Event->new('ACQ_LINEITEM_NO_COPIES', payload => $li->id));
885 $mgr->editor->rollback;
889 for my $lid_id (@$lid_ids) {
891 my $lid = $mgr->editor->retrieve_acq_lineitem_detail([
894 flesh_fields => {acqlid => ['fund']}
898 create_lineitem_detail_debit($mgr, $li, $lid, $dry_run) or return 0;
907 sub create_lineitem_detail_debit {
908 my ($mgr, $li, $lid, $dry_run, $no_translate) = @_;
910 # don't create the debit if one already exists
911 return $mgr->editor->retrieve_acq_fund_debit($lid->fund_debit) if $lid->fund_debit;
913 my $li_id = ref($li) ? $li->id : $li;
915 unless(ref $li and ref $li->provider) {
916 $li = $mgr->editor->retrieve_acq_lineitem([
919 flesh_fields => {jub => ['provider']},
925 $lid->fund($mgr->editor->retrieve_acq_fund($lid->fund)) unless(ref $lid->fund);
927 $lid = $mgr->editor->retrieve_acq_lineitem_detail([
930 flesh_fields => {acqlid => ['fund']}
935 unless ($lid->fund) {
937 new OpenILS::Event("ACQ_FUND_NOT_FOUND") # close enough
942 my $amount = $li->estimated_unit_price;
943 if($li->provider->currency_type ne $lid->fund->currency_type and !$no_translate) {
945 # At Fund debit creation time, translate into the currency of the fund
946 # TODO: org setting to disable automatic currency conversion at debit create time?
948 $amount = $mgr->editor->json_query({
950 'acq.exchange_ratio',
951 $li->provider->currency_type, # source currency
952 $lid->fund->currency_type, # destination currency
953 $li->estimated_unit_price # source amount
955 })->[0]->{'acq.exchange_ratio'};
958 my $debit = create_fund_debit(
961 fund => $lid->fund->id,
962 origin_amount => $li->estimated_unit_price,
963 origin_currency_type => $li->provider->currency_type,
967 $lid->fund_debit($debit->id);
968 $lid->fund($lid->fund->id);
969 $mgr->editor->update_acq_lineitem_detail($lid) or return 0;
974 __PACKAGE__->register_method(
975 "method" => "fund_exceeds_balance_percent_api",
976 "api_name" => "open-ils.acq.fund.check_balance_percentages",
978 "desc" => q/Determine whether a given fund exceeds its defined
979 "balance stop and warning percentages"/,
981 {"desc" => "Authentication token", "type" => "string"},
982 {"desc" => "Fund ID", "type" => "number"},
983 {"desc" => "Theoretical debit amount (optional)",
986 "return" => {"desc" => q/An array of two values, for stop and warning,
987 in that order: 1 if fund exceeds that balance percentage, else 0/}
991 sub fund_exceeds_balance_percent_api {
992 my ($self, $conn, $auth, $fund_id, $debit_amount) = @_;
996 my $e = new_editor("authtoken" => $auth);
997 return $e->die_event unless $e->checkauth;
999 my $fund = $e->retrieve_acq_fund($fund_id) or return $e->die_event;
1000 return $e->die_event unless $e->allowed("VIEW_FUND", $fund->org);
1003 fund_exceeds_balance_percent($fund, $debit_amount, $e, "stop"),
1004 fund_exceeds_balance_percent($fund, $debit_amount, $e, "warning")
1011 sub fund_exceeds_balance_percent {
1012 my ($fund, $debit_amount, $e, $which) = @_;
1014 my ($method_name, $event_name) = @{{
1016 "balance_warning_percent", "ACQ_FUND_EXCEEDS_WARN_PERCENT"
1019 "balance_stop_percent", "ACQ_FUND_EXCEEDS_STOP_PERCENT"
1023 if ($fund->$method_name) {
1025 $e->search_acq_fund_combined_balance({"fund" => $fund->id})->[0];
1027 $e->search_acq_fund_allocation_total({"fund" => $fund->id})->[0];
1029 $balance = ($balance) ? $balance->amount : 0;
1030 $allocations = ($allocations) ? $allocations->amount : 0;
1033 $allocations == 0 || # if no allocations were ever made, assume we have hit the stop percent
1034 ((($allocations - $balance + $debit_amount) / $allocations) * 100) > $fund->$method_name
1036 $logger->info("fund would hit a limit: " . $fund->id . ", $balance, $debit_amount, $allocations, $method_name");
1041 "fund" => $fund, "debit_amount" => $debit_amount
1051 # ----------------------------------------------------------------------------
1053 # ----------------------------------------------------------------------------
1054 sub create_fund_debit {
1055 my($mgr, $dry_run, %args) = @_;
1057 # Verify the fund is not being spent beyond the hard stop amount
1058 my $fund = $mgr->editor->retrieve_acq_fund($args{fund}) or return 0;
1061 fund_exceeds_balance_percent(
1062 $fund, $args{"amount"}, $mgr->editor, "stop"
1065 $dry_run and fund_exceeds_balance_percent(
1066 $fund, $args{"amount"}, $mgr->editor, "warning"
1069 my $debit = Fieldmapper::acq::fund_debit->new;
1070 $debit->debit_type('purchase');
1071 $debit->encumbrance('t');
1072 $debit->$_($args{$_}) for keys %args;
1074 $mgr->add_debit($debit->amount);
1075 return $mgr->editor->create_acq_fund_debit($debit);
1079 # ----------------------------------------------------------------------------
1081 # ----------------------------------------------------------------------------
1082 sub create_picklist {
1083 my($mgr, %args) = @_;
1084 my $picklist = Fieldmapper::acq::picklist->new;
1085 $picklist->creator($mgr->editor->requestor->id);
1086 $picklist->owner($picklist->creator);
1087 $picklist->editor($picklist->creator);
1088 $picklist->create_time('now');
1089 $picklist->edit_time('now');
1090 $picklist->org_unit($mgr->editor->requestor->ws_ou);
1091 $picklist->owner($mgr->editor->requestor->id);
1092 $picklist->$_($args{$_}) for keys %args;
1093 $picklist->clear_id;
1094 $mgr->picklist($picklist);
1095 return $mgr->editor->create_acq_picklist($picklist);
1098 sub update_picklist {
1099 my($mgr, $picklist) = @_;
1100 $picklist = $mgr->editor->retrieve_acq_picklist($picklist) unless ref $picklist;
1101 $picklist->edit_time('now');
1102 $picklist->editor($mgr->editor->requestor->id);
1103 if ($mgr->editor->update_acq_picklist($picklist)) {
1104 $picklist = $mgr->editor->retrieve_acq_picklist($mgr->editor->data);
1105 $mgr->picklist($picklist);
1112 sub delete_picklist {
1113 my($mgr, $picklist) = @_;
1114 $picklist = $mgr->editor->retrieve_acq_picklist($picklist) unless ref $picklist;
1116 # delete all 'new' lineitems
1117 my $li_ids = $mgr->editor->search_acq_lineitem(
1119 picklist => $picklist->id,
1120 "-or" => {state => "new", purchase_order => undef}
1124 for my $li_id (@$li_ids) {
1125 my $li = $mgr->editor->retrieve_acq_lineitem($li_id);
1126 return 0 unless delete_lineitem($mgr, $li);
1130 # detach all non-'new' lineitems
1131 $li_ids = $mgr->editor->search_acq_lineitem({picklist => $picklist->id, state => {'!=' => 'new'}}, {idlist => 1});
1132 for my $li_id (@$li_ids) {
1133 my $li = $mgr->editor->retrieve_acq_lineitem($li_id);
1134 $li->clear_picklist;
1135 return 0 unless update_lineitem($mgr, $li);
1139 # remove any picklist-specific object perms
1140 my $ops = $mgr->editor->search_permission_usr_object_perm_map({object_type => 'acqpl', object_id => ''.$picklist->id});
1141 for my $op (@$ops) {
1142 return 0 unless $mgr->editor->delete_usr_object_perm_map($op);
1145 return $mgr->editor->delete_acq_picklist($picklist);
1148 # ----------------------------------------------------------------------------
1150 # ----------------------------------------------------------------------------
1151 sub update_purchase_order {
1153 $po = $mgr->editor->retrieve_acq_purchase_order($po) unless ref $po;
1154 $po->editor($mgr->editor->requestor->id);
1155 $po->edit_time('now');
1156 $mgr->purchase_order($po);
1157 return $mgr->editor->retrieve_acq_purchase_order($mgr->editor->data)
1158 if $mgr->editor->update_acq_purchase_order($po);
1162 sub create_purchase_order {
1163 my($mgr, %args) = @_;
1165 # verify the chosen provider is still active
1166 my $provider = $mgr->editor->retrieve_acq_provider($args{provider}) or return 0;
1167 unless($U->is_true($provider->active)) {
1168 $logger->error("provider is not active. cannot create PO");
1169 $mgr->editor->event(OpenILS::Event->new('ACQ_PROVIDER_INACTIVE'));
1173 my $po = Fieldmapper::acq::purchase_order->new;
1174 $po->creator($mgr->editor->requestor->id);
1175 $po->editor($mgr->editor->requestor->id);
1176 $po->owner($mgr->editor->requestor->id);
1177 $po->edit_time('now');
1178 $po->create_time('now');
1179 $po->state('pending');
1180 $po->ordering_agency($mgr->editor->requestor->ws_ou);
1181 $po->$_($args{$_}) for keys %args;
1183 $mgr->purchase_order($po);
1184 return $mgr->editor->create_acq_purchase_order($po);
1187 # ----------------------------------------------------------------------------
1188 # if all of the lineitems for this PO are received and no
1189 # blanket charges are still encumbered, mark the PO as received.
1190 # ----------------------------------------------------------------------------
1191 sub check_purchase_order_received {
1192 my($mgr, $po_id) = @_;
1194 my $non_recv_li = $mgr->editor->json_query({
1199 "jub" => {"acqcr" => {"type" => "left"}}
1202 "+jub" => {"purchase_order" => $po_id},
1203 # Return lineitems that are not in the received/cancelled [sic]
1204 # state OR those that are canceled with keep_debits=true.
1207 "state" => {"not in" => ["received", "cancelled"]}}
1210 {"+jub" => {"state" => "cancelled"}},
1211 {"+acqcr" => {"keep_debits" =>"t"}}
1218 my $po = $mgr->editor->retrieve_acq_purchase_order($po_id);
1219 return $po if @$non_recv_li;
1221 # avoid marking the PO as received if any blanket charges
1222 # are still encumbered.
1223 my $blankets = $mgr->editor->json_query({
1224 select => {acqpoi => ['id']},
1227 aiit => {filter => {blanket=>'t'}},
1228 acqfdeb => {filter => {encumbrance => 't'}}
1231 where => {'+acqpoi' => {purchase_order => $po_id}}
1234 return $po if @$blankets;
1236 $po->state('received');
1237 return update_purchase_order($mgr, $po);
1241 # ----------------------------------------------------------------------------
1242 # Bib, Callnumber, and Copy data
1243 # ----------------------------------------------------------------------------
1245 sub create_lineitem_assets {
1246 my($mgr, $li_id) = @_;
1249 my $li = $mgr->editor->retrieve_acq_lineitem([
1252 flesh_fields => {jub => ['purchase_order', 'attributes']}
1256 # note: at this point, the bib record this LI links to should already be created
1258 # -----------------------------------------------------------------
1259 # The lineitem is going live, promote user request holds to real holds
1260 # -----------------------------------------------------------------
1261 promote_lineitem_holds($mgr, $li) or return 0;
1263 my $li_details = $mgr->editor->search_acq_lineitem_detail({lineitem => $li_id}, {idlist=>1});
1265 # -----------------------------------------------------------------
1266 # for each lineitem_detail, create the volume if necessary, create
1267 # a copy, and link them all together.
1268 # -----------------------------------------------------------------
1270 for my $lid_id (@{$li_details}) {
1272 my $lid = $mgr->editor->retrieve_acq_lineitem_detail($lid_id) or return 0;
1273 next if $lid->eg_copy_id;
1275 # use the same callnumber label for all items within this lineitem
1276 $lid->cn_label($first_cn) if $first_cn and not $lid->cn_label;
1278 # apply defaults if necessary
1279 return 0 unless complete_lineitem_detail($mgr, $lid);
1281 $first_cn = $lid->cn_label unless $first_cn;
1283 my $org = $lid->owning_lib;
1284 my $label = $lid->cn_label;
1285 my $bibid = $li->eg_bib_id;
1287 my $volume = $mgr->cache($org, "cn.$bibid.$label");
1289 $volume = create_volume($mgr, $li, $lid) or return 0;
1290 $mgr->cache($org, "cn.$bibid.$label", $volume);
1292 create_copy($mgr, $volume, $lid, $li) or return 0;
1295 return { li => $li };
1299 my($mgr, $li, $lid) = @_;
1301 my ($volume, $evt) =
1302 OpenILS::Application::Cat::AssetCommon->find_or_create_volume(
1310 $mgr->editor->event($evt);
1318 my($mgr, $volume, $lid, $li) = @_;
1319 my $copy = Fieldmapper::asset::copy->new;
1321 $copy->loan_duration(2);
1322 $copy->fine_level(2);
1323 $copy->status(($lid->recv_time) ? OILS_COPY_STATUS_IN_PROCESS : OILS_COPY_STATUS_ON_ORDER);
1324 $copy->barcode($lid->barcode);
1325 $copy->location($lid->location);
1326 $copy->call_number($volume->id);
1327 $copy->circ_lib($volume->owning_lib);
1328 $copy->circ_modifier($lid->circ_modifier);
1330 # AKA list price. We might need a $li->list_price field since
1331 # estimated price is not necessarily the same as list price
1332 $copy->price($li->estimated_unit_price);
1334 my $evt = OpenILS::Application::Cat::AssetCommon->create_copy($mgr->editor, $volume, $copy);
1336 $mgr->editor->event($evt);
1341 $lid->eg_copy_id($copy->id);
1342 $mgr->editor->update_acq_lineitem_detail($lid) or return 0;
1350 # ----------------------------------------------------------------------------
1351 # Workflow: Build a selection list from a Z39.50 search
1352 # ----------------------------------------------------------------------------
1354 __PACKAGE__->register_method(
1355 method => 'zsearch',
1356 api_name => 'open-ils.acq.picklist.search.z3950',
1359 desc => 'Performs a z3950 federated search and creates a picklist and associated lineitems',
1361 {desc => 'Authentication token', type => 'string'},
1362 {desc => 'Search definition', type => 'object'},
1363 {desc => 'Picklist name, optional', type => 'string'},
1369 my($self, $conn, $auth, $search, $name, $options) = @_;
1370 my $e = new_editor(authtoken=>$auth);
1371 return $e->event unless $e->checkauth;
1372 return $e->event unless $e->allowed('CREATE_PICKLIST');
1374 $search->{limit} ||= 10;
1377 my $ses = OpenSRF::AppSession->create('open-ils.search');
1378 my $req = $ses->request('open-ils.search.z3950.search_class', $auth, $search);
1383 while(my $resp = $req->recv(timeout=>60)) {
1386 my $e = new_editor(requestor=>$e->requestor, xact=>1);
1387 $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1388 $picklist = zsearch_build_pl($mgr, $name);
1392 my $result = $resp->content;
1393 my $count = $result->{count} || 0;
1394 $mgr->total( (($count < $search->{limit}) ? $count : $search->{limit})+1 );
1396 for my $rec (@{$result->{records}}) {
1398 my $li = create_lineitem($mgr,
1399 picklist => $picklist->id,
1400 source_label => $result->{service},
1401 marc => $rec->{marcxml},
1402 eg_bib_id => $rec->{bibid}
1405 if($$options{respond_li}) {
1406 $li->attributes($mgr->editor->search_acq_lineitem_attr({lineitem => $li->id}))
1407 if $$options{flesh_attrs};
1408 $li->clear_marc if $$options{clear_marc};
1409 $mgr->respond(lineitem => $li);
1416 $mgr->editor->commit;
1417 return $mgr->respond_complete;
1420 sub zsearch_build_pl {
1421 my($mgr, $name) = @_;
1424 my $picklist = $mgr->editor->search_acq_picklist({
1425 owner => $mgr->editor->requestor->id,
1429 if($name eq '' and $picklist) {
1430 return 0 unless delete_picklist($mgr, $picklist);
1434 return update_picklist($mgr, $picklist) if $picklist;
1435 return create_picklist($mgr, name => $name);
1439 # ----------------------------------------------------------------------------
1440 # Workflow: Build a selection list / PO by importing a batch of MARC records
1441 # ----------------------------------------------------------------------------
1443 __PACKAGE__->register_method(
1444 method => 'upload_records',
1445 api_name => 'open-ils.acq.process_upload_records',
1447 max_chunk_count => 1
1450 sub upload_records {
1451 my($self, $conn, $auth, $key, $args) = @_;
1454 my $e = new_editor(authtoken => $auth, xact => 1);
1455 return $e->die_event unless $e->checkauth;
1456 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1458 my $cache = OpenSRF::Utils::Cache->new;
1460 my $data = $cache->get_cache("vandelay_import_spool_$key");
1461 my $filename = $data->{path};
1462 my $provider = $args->{provider};
1463 my $picklist = $args->{picklist};
1464 my $create_po = $args->{create_po};
1465 my $activate_po = $args->{activate_po};
1466 my $vandelay = $args->{vandelay};
1467 my $ordering_agency = $args->{ordering_agency} || $e->requestor->ws_ou;
1468 my $fiscal_year = $args->{fiscal_year};
1470 # if the user provides no fiscal year, find the
1471 # current fiscal year for the ordering agency.
1472 $fiscal_year ||= $U->simplereq(
1474 'open-ils.acq.org_unit.current_fiscal_year',
1482 unless(-r $filename) {
1483 $logger->error("unable to read MARC file $filename");
1485 return OpenILS::Event->new('FILE_UPLOAD_ERROR', payload => {filename => $filename});
1488 $provider = $e->retrieve_acq_provider($provider) or return $e->die_event;
1491 $picklist = $e->retrieve_acq_picklist($picklist) or return $e->die_event;
1492 if($picklist->owner != $e->requestor->id) {
1493 return $e->die_event unless
1494 $e->allowed('CREATE_PICKLIST', $picklist->org_unit, $picklist);
1496 $mgr->picklist($picklist);
1500 return $e->die_event unless
1501 $e->allowed('CREATE_PURCHASE_ORDER', $ordering_agency);
1503 $po = create_purchase_order($mgr,
1504 ordering_agency => $ordering_agency,
1505 provider => $provider->id,
1506 state => 'pending' # will be updated later if activated
1507 ) or return $mgr->editor->die_event;
1510 $logger->info("acq processing MARC file=$filename");
1512 my $batch = new MARC::Batch ('USMARC', $filename);
1520 my ($err, $xml, $r);
1525 } catch Error with {
1527 $logger->warn("Proccessing of record $count in set $key failed with error $err. Skipping this record");
1534 $xml = clean_marc($r);
1535 } catch Error with {
1537 $logger->warn("Proccessing XML of record $count in set $key failed with error $err. Skipping this record");
1540 next if $err or not $xml;
1543 source_label => $provider->code,
1544 provider => $provider->id,
1548 $args{picklist} = $picklist->id if $picklist;
1550 $args{purchase_order} = $po->id;
1551 $args{state} = 'pending-order';
1554 my $li = create_lineitem($mgr, %args) or return $mgr->editor->die_event;
1556 $li->provider($provider); # flesh it, we'll need it later
1558 import_lineitem_details($mgr, $ordering_agency, $li, $fiscal_year)
1559 or return $mgr->editor->die_event;
1562 push(@li_list, $li->id);
1567 $evt = extract_po_name($mgr, $po, \@li_list);
1568 return $evt if $evt;
1573 $cache->delete_cache('vandelay_import_spool_' . $key);
1575 if ($po and $activate_po) {
1576 my $die_event = activate_purchase_order_impl($mgr, $po->id, $vandelay);
1577 return $die_event if $die_event;
1579 } elsif ($vandelay) {
1580 $vandelay->{new_rec_perm} = 'IMPORT_ACQ_LINEITEM_BIB_RECORD_UPLOAD';
1581 create_lineitem_list_assets($mgr, \@li_list, $vandelay,
1582 !$vandelay->{create_assets}) or return $e->die_event;
1585 return $mgr->respond_complete;
1588 # see if the PO name is encoded in the newly imported records
1589 sub extract_po_name {
1590 my ($mgr, $po, $li_ids) = @_;
1591 my $e = $mgr->editor;
1593 # find the first instance of the name
1594 my $attr = $e->search_acq_lineitem_attr([
1595 { lineitem => $li_ids,
1596 attr_type => 'lineitem_provider_attr_definition',
1597 attr_name => 'purchase_order'
1599 order_by => {aqlia => 'id'},
1602 ])->[0] or return undef;
1604 my $name = $attr->attr_value;
1606 # see if another PO already has the name, provider, and org
1607 my $existing = $e->search_acq_purchase_order(
1609 ordering_agency => $po->ordering_agency,
1610 provider => $po->provider
1615 # if a PO exists with the same name (and provider/org)
1616 # tack the po ID into the name to differentiate
1617 $name = sprintf("$name (%s)", $po->id) if $existing;
1619 $logger->info("Extracted PO name: $name");
1622 update_purchase_order($mgr, $po) or return $e->die_event;
1626 sub import_lineitem_details {
1627 my($mgr, $ordering_agency, $li, $fiscal_year) = @_;
1629 my $holdings = $mgr->editor->json_query({from => ['acq.extract_provider_holding_data', $li->id]});
1630 return 1 unless @$holdings;
1631 my $org_path = $U->get_org_ancestors($ordering_agency);
1632 $org_path = [ reverse (@$org_path) ];
1638 # create a lineitem detail for each copy in the data
1640 my $compiled = extract_lineitem_detail_data($mgr, $org_path, $holdings, $idx, $fiscal_year);
1641 last unless defined $compiled;
1642 return 0 unless $compiled;
1644 # this takes the price of the last copy and uses it as the lineitem price
1645 # need to determine if a given record would include different prices for the same item
1646 $price = $$compiled{estimated_price};
1648 last unless $$compiled{quantity};
1650 for(1..$$compiled{quantity}) {
1651 my $lid = create_lineitem_detail(
1653 lineitem => $li->id,
1654 owning_lib => $$compiled{owning_lib},
1655 cn_label => $$compiled{call_number},
1656 fund => $$compiled{fund},
1657 circ_modifier => $$compiled{circ_modifier},
1658 note => $$compiled{note},
1659 location => $$compiled{copy_location},
1660 collection_code => $$compiled{collection_code},
1661 barcode => $$compiled{barcode}
1669 $li->estimated_unit_price($price);
1670 update_lineitem($mgr, $li) or return 0;
1674 # return hash on success, 0 on error, undef on no more holdings
1675 sub extract_lineitem_detail_data {
1676 my($mgr, $org_path, $holdings, $index, $fiscal_year) = @_;
1678 my @data_list = grep { $_->{holding} eq $index } @$holdings;
1679 return undef unless @data_list;
1681 my %compiled = map { $_->{attr} => $_->{data} } @data_list;
1682 my $base_org = $$org_path[0];
1686 $logger->error("Item import extraction error: $msg");
1687 $logger->error('Holdings Data: ' . OpenSRF::Utils::JSON->perl2JSON(\%compiled));
1688 $mgr->editor->rollback;
1689 $mgr->editor->event(OpenILS::Event->new('ACQ_IMPORT_ERROR', payload => $msg));
1693 # ---------------------------------------------------------------------
1695 if(my $code = $compiled{fund_code}) {
1697 my $fund = $mgr->cache($base_org, "fund.$code");
1699 # search up the org tree for the most appropriate fund
1700 for my $org (@$org_path) {
1701 $fund = $mgr->editor->search_acq_fund(
1702 {org => $org, code => $code, year => $fiscal_year}, {idlist => 1})->[0];
1706 return $killme->("no fund with code $code at orgs [@$org_path]") unless $fund;
1707 $compiled{fund} = $fund;
1708 $mgr->cache($base_org, "fund.$code", $fund);
1712 # ---------------------------------------------------------------------
1714 if(my $sn = $compiled{owning_lib}) {
1715 my $org_id = $mgr->cache($base_org, "orgsn.$sn") ||
1716 $mgr->editor->search_actor_org_unit({shortname => $sn}, {idlist => 1})->[0];
1717 return $killme->("invalid owning_lib defined: $sn") unless $org_id;
1718 $compiled{owning_lib} = $org_id;
1719 $mgr->cache($$org_path[0], "orgsn.$sn", $org_id);
1723 # ---------------------------------------------------------------------
1725 my $code = $compiled{circ_modifier};
1729 # verify this is a valid circ modifier
1730 return $killme->("invlalid circ_modifier $code") unless
1731 defined $mgr->cache($base_org, "mod.$code") or
1732 $mgr->editor->retrieve_config_circ_modifier($code);
1734 # if valid, cache for future tests
1735 $mgr->cache($base_org, "mod.$code", $code);
1738 $compiled{circ_modifier} = get_default_circ_modifier($mgr, $base_org);
1742 # ---------------------------------------------------------------------
1744 if( my $name = $compiled{copy_location}) {
1746 my $cp_base_org = $base_org;
1748 if ($compiled{owning_lib}) {
1749 # start looking for copy locations at the copy
1750 # owning lib instaed of the upload context org
1751 $cp_base_org = $compiled{owning_lib};
1754 my $loc = $mgr->cache($cp_base_org, "copy_loc.$name");
1756 my $org = $cp_base_org;
1758 $loc = $mgr->editor->search_asset_copy_location(
1759 {owning_lib => $org, name => $name, deleted => 'f'}, {idlist => 1})->[0];
1761 $org = $mgr->editor->retrieve_actor_org_unit($org)->parent_ou;
1764 return $killme->("Invalid copy location $name") unless $loc;
1765 $compiled{copy_location} = $loc;
1766 $mgr->cache($cp_base_org, "copy_loc.$name", $loc);
1774 # ----------------------------------------------------------------------------
1775 # Workflow: Given an existing purchase order, import/create the bibs,
1776 # callnumber and copy objects
1777 # ----------------------------------------------------------------------------
1779 __PACKAGE__->register_method(
1780 method => 'create_po_assets',
1781 api_name => 'open-ils.acq.purchase_order.assets.create',
1783 desc => q/Creates assets for each lineitem in the purchase order/,
1785 {desc => 'Authentication token', type => 'string'},
1786 {desc => 'The purchase order id', type => 'number'},
1788 return => {desc => 'Streams a total versus completed counts object, event on error'}
1790 max_chunk_count => 1
1793 sub create_po_assets {
1794 my($self, $conn, $auth, $po_id, $args) = @_;
1797 my $e = new_editor(authtoken=>$auth, xact=>1);
1798 return $e->die_event unless $e->checkauth;
1799 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1801 my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->die_event;
1803 my $li_ids = $e->search_acq_lineitem({purchase_order => $po_id}, {idlist => 1});
1805 # it's ugly, but it's fast. Get the total count of lineitem detail objects to process
1806 my $lid_total = $e->json_query({
1807 select => { acqlid => [{aggregate => 1, transform => 'count', column => 'id'}] },
1813 join => {acqpo => {fkey => 'purchase_order', field => 'id'}}
1817 where => {'+acqpo' => {id => $po_id}}
1820 # maximum number of Vandelay bib actions is twice
1821 # the number line items (queue bib, then create it)
1822 $mgr->total(scalar(@$li_ids) * 2 + $lid_total);
1824 create_lineitem_list_assets($mgr, $li_ids, $args->{vandelay})
1825 or return $e->die_event;
1828 update_purchase_order($mgr, $po) or return $e->die_event;
1831 return $mgr->respond_complete;
1836 __PACKAGE__->register_method(
1837 method => 'create_purchase_order_api',
1838 api_name => 'open-ils.acq.purchase_order.create',
1840 desc => 'Creates a new purchase order',
1842 {desc => 'Authentication token', type => 'string'},
1843 {desc => 'purchase_order to create', type => 'object'}
1845 return => {desc => 'The purchase order id, Event on failure'}
1847 max_chunk_count => 1
1850 sub create_purchase_order_api {
1851 my($self, $conn, $auth, $po, $args) = @_;
1854 my $e = new_editor(xact=>1, authtoken=>$auth);
1855 return $e->die_event unless $e->checkauth;
1856 return $e->die_event unless $e->allowed('CREATE_PURCHASE_ORDER', $po->ordering_agency);
1857 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1860 my %pargs = (ordering_agency => $e->requestor->ws_ou); # default
1861 $pargs{provider} = $po->provider if $po->provider;
1862 $pargs{ordering_agency} = $po->ordering_agency if $po->ordering_agency;
1863 $pargs{prepayment_required} = $po->prepayment_required if $po->prepayment_required;
1864 $pargs{name} = $po->name if $po->name;
1865 my $vandelay = $args->{vandelay};
1867 $po = create_purchase_order($mgr, %pargs) or return $e->die_event;
1869 my $li_ids = $$args{lineitems};
1873 for my $li_id (@$li_ids) {
1875 my $li = $e->retrieve_acq_lineitem([
1877 {flesh => 1, flesh_fields => {jub => ['attributes']}}
1878 ]) or return $e->die_event;
1880 return $e->die_event(
1882 "BAD_PARAMS", payload => $li,
1883 note => "acq.lineitem #" . $li->id .
1884 ": purchase_order #" . $li->purchase_order
1886 ) if $li->purchase_order;
1888 $li->provider($po->provider);
1889 $li->purchase_order($po->id);
1890 $li->state('pending-order');
1891 update_lineitem($mgr, $li) or return $e->die_event;
1896 # see if we have a PO name encoded in any of our lineitems
1897 my $evt = extract_po_name($mgr, $po, $li_ids);
1898 return $evt if $evt;
1900 # commit before starting the asset creation
1906 create_lineitem_list_assets(
1907 $mgr, $li_ids, $vandelay, !$$args{create_assets})
1908 or return $e->die_event;
1912 apply_default_copies($mgr, $po) or return $e->die_event;
1916 return $mgr->respond_complete;
1919 # !transaction must be managed by the caller
1920 # creates the default number of copies for each lineitem on the PO.
1921 # when a LI already has copies attached, no default copies are added.
1922 # without li_id, all lineitems are checked/applied
1923 # returns 1 on success, 0 on error
1924 sub apply_default_copies {
1925 my ($mgr, $po, $li_id) = @_;
1927 my $e = $mgr->editor;
1929 my $provider = ref($po->provider) ? $po->provider :
1930 $e->retrieve_acq_provider($po->provider);
1932 my $copy_count = $provider->default_copy_count || return 1;
1934 $logger->info("Applying $copy_count default copies for PO ".$po->id);
1936 my $li_ids = $li_id ? [$li_id] :
1937 $e->search_acq_lineitem({
1938 purchase_order => $po->id,
1939 cancel_reason => undef
1944 for my $li_id (@$li_ids) {
1946 my $lid_ids = $e->search_acq_lineitem_detail(
1947 {lineitem => $li_id}, {idlist => 1});
1949 # do not apply default copies when copies already exist
1952 for (1 .. $copy_count) {
1953 create_lineitem_detail($mgr,
1955 owning_lib => $e->requestor->ws_ou
1965 __PACKAGE__->register_method(
1966 method => 'update_lineitem_fund_batch',
1967 api_name => 'open-ils.acq.lineitem.fund.update.batch',
1970 desc => q/Given a set of lineitem IDS, updates the fund for all attached lineitem details/
1974 sub update_lineitem_fund_batch {
1975 my($self, $conn, $auth, $li_ids, $fund_id) = @_;
1976 my $e = new_editor(xact=>1, authtoken=>$auth);
1977 return $e->die_event unless $e->checkauth;
1978 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1979 for my $li_id (@$li_ids) {
1980 my ($li, $evt) = fetch_and_check_li($e, $li_id, 'write');
1981 return $evt if $evt;
1982 my $li_details = $e->search_acq_lineitem_detail({lineitem => $li_id});
1983 $_->fund($fund_id) and $_->ischanged(1) for @$li_details;
1984 $evt = lineitem_detail_CUD_batch($mgr, $li_details);
1985 return $evt if $evt;
1990 return $mgr->respond_complete;
1995 __PACKAGE__->register_method(
1996 method => 'lineitem_detail_CUD_batch_api',
1997 api_name => 'open-ils.acq.lineitem_detail.cud.batch',
2000 desc => q/Creates a new purchase order line item detail. / .
2001 q/Additionally creates the associated fund_debit/,
2003 {desc => 'Authentication token', type => 'string'},
2004 {desc => 'List of lineitem_details to create', type => 'array'},
2005 {desc => 'Create Debits. Used for creating post-po-asset-creation debits', type => 'bool'},
2007 return => {desc => 'Streaming response of current position in the array'}
2011 __PACKAGE__->register_method(
2012 method => 'lineitem_detail_CUD_batch_api',
2013 api_name => 'open-ils.acq.lineitem_detail.cud.batch.dry_run',
2017 Dry run version of open-ils.acq.lineitem_detail.cud.batch.
2018 In dry_run mode, updated fund_debit's the exceed the warning
2019 percent return an event.
2025 sub lineitem_detail_CUD_batch_api {
2026 my($self, $conn, $auth, $li_details, $create_debits) = @_;
2027 my $e = new_editor(xact=>1, authtoken=>$auth);
2028 return $e->die_event unless $e->checkauth;
2029 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
2030 my $dry_run = ($self->api_name =~ /dry_run/o);
2031 my $evt = lineitem_detail_CUD_batch($mgr, $li_details, $create_debits, $dry_run);
2032 return $evt if $evt;
2034 return $mgr->respond_complete;
2038 sub lineitem_detail_CUD_batch {
2039 my($mgr, $li_details, $create_debits, $dry_run) = @_;
2041 $mgr->total(scalar(@$li_details));
2042 my $e = $mgr->editor;
2046 my $fund_cache = {};
2049 for my $lid (@$li_details) {
2051 unless($li = $li_cache{$lid->lineitem}) {
2052 ($li, $evt) = fetch_and_check_li($e, $lid->lineitem, 'write');
2053 return $evt if $evt;
2057 $lid = create_lineitem_detail($mgr, %{$lid->to_bare_hash}) or return $e->die_event;
2058 if($create_debits) {
2059 $li->provider($e->retrieve_acq_provider($li->provider)) or return $e->die_event;
2060 $lid->fund($e->retrieve_acq_fund($lid->fund)) or return $e->die_event;
2061 create_lineitem_detail_debit($mgr, $li, $lid, 0, 1) or return $e->die_event;
2064 } elsif($lid->ischanged) {
2065 return $evt if $evt = handle_changed_lid($e, $lid, $dry_run, $fund_cache);
2067 } elsif($lid->isdeleted) {
2068 delete_lineitem_detail($mgr, $lid) or return $e->die_event;
2071 $mgr->respond(li => $li);
2072 $li_cache{$lid->lineitem} = $li;
2078 sub handle_changed_lid {
2079 my($e, $lid, $dry_run, $fund_cache) = @_;
2081 my $orig_lid = $e->retrieve_acq_lineitem_detail($lid->id) or return $e->die_event;
2083 # updating the fund, so update the debit
2084 if($orig_lid->fund_debit and $orig_lid->fund != $lid->fund) {
2086 my $debit = $e->retrieve_acq_fund_debit($orig_lid->fund_debit);
2087 my $new_fund = $$fund_cache{$lid->fund} =
2088 $$fund_cache{$lid->fund} || $e->retrieve_acq_fund($lid->fund);
2090 # check the thresholds
2091 return $e->die_event if
2092 fund_exceeds_balance_percent($new_fund, $debit->amount, $e, "stop");
2093 return $e->die_event if $dry_run and
2094 fund_exceeds_balance_percent($new_fund, $debit->amount, $e, "warning");
2096 $debit->fund($new_fund->id);
2097 $e->update_acq_fund_debit($debit) or return $e->die_event;
2100 $e->update_acq_lineitem_detail($lid) or return $e->die_event;
2105 __PACKAGE__->register_method(
2106 method => 'receive_po_api',
2107 api_name => 'open-ils.acq.purchase_order.receive'
2110 sub receive_po_api {
2111 my($self, $conn, $auth, $po_id) = @_;
2112 my $e = new_editor(xact => 1, authtoken => $auth);
2113 return $e->die_event unless $e->checkauth;
2114 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
2116 my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->die_event;
2117 return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency);
2119 my $li_ids = $e->search_acq_lineitem({purchase_order => $po_id}, {idlist => 1});
2121 for my $li_id (@$li_ids) {
2122 receive_lineitem($mgr, $li_id) or return $e->die_event;
2126 $po->state('received');
2127 update_purchase_order($mgr, $po) or return $e->die_event;
2130 return $mgr->respond_complete;
2134 # At the moment there's a lack of parallelism between the receive and unreceive
2135 # API methods for POs and the API methods for LIs and LIDs. The methods for
2136 # POs stream back objects as they act, whereas the methods for LIs and LIDs
2137 # atomically return an object that describes only what changed (in LIs and LIDs
2138 # themselves or in the objects to which to LIs and LIDs belong).
2140 # The methods for LIs and LIDs work the way they do to faciliate the UI's
2141 # maintaining correct information about the state of these things when a user
2142 # wants to receive or unreceive these objects without refreshing their whole
2143 # display. The UI feature for receiving and un-receiving a whole PO just
2144 # refreshes the whole display, so this absence of parallelism in the UI is also
2145 # relected in this module.
2147 # This could be neatened in the future by making POs receive and unreceive in
2148 # the same way the LIs and LIDs do.
2150 __PACKAGE__->register_method(
2151 method => 'receive_lineitem_detail_api',
2152 api_name => 'open-ils.acq.lineitem_detail.receive',
2154 desc => 'Mark a lineitem_detail as received',
2156 {desc => 'Authentication token', type => 'string'},
2157 {desc => 'lineitem detail ID', type => 'number'}
2160 "on success, object describing changes to LID and possibly " .
2161 "to LI and PO; on error, Event"
2166 sub receive_lineitem_detail_api {
2167 my($self, $conn, $auth, $lid_id) = @_;
2169 my $e = new_editor(xact=>1, authtoken=>$auth);
2170 return $e->die_event unless $e->checkauth;
2171 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
2174 "flesh" => 2, "flesh_fields" => {
2175 "acqlid" => ["lineitem"], "jub" => ["purchase_order"]
2179 my $lid = $e->retrieve_acq_lineitem_detail([$lid_id, $fleshing]);
2181 return $e->die_event unless $e->allowed(
2182 'RECEIVE_PURCHASE_ORDER', $lid->lineitem->purchase_order->ordering_agency);
2185 my $recvd = receive_lineitem_detail($mgr, $lid_id) or return $e->die_event;
2187 # .. and re-retrieve
2188 $lid = $e->retrieve_acq_lineitem_detail([$lid_id, $fleshing]);
2190 # Now build result data structure.
2191 my $result = {"lid" => {$lid->id => {"recv_time" => $lid->recv_time}}};
2194 if ($recvd->class_name =~ /::purchase_order/) {
2195 $result->{"po"} = describe_affected_po($e, $recvd);
2197 $lid->lineitem->id => {"state" => $lid->lineitem->state}
2199 } elsif ($recvd->class_name =~ /::lineitem/) {
2200 $result->{"li"} = {$recvd->id => {"state" => $recvd->state}};
2204 describe_affected_po($e, $lid->lineitem->purchase_order);
2210 __PACKAGE__->register_method(
2211 method => 'receive_lineitem_api',
2212 api_name => 'open-ils.acq.lineitem.receive',
2214 desc => 'Mark a lineitem as received',
2216 {desc => 'Authentication token', type => 'string'},
2217 {desc => 'lineitem ID', type => 'number'}
2220 "on success, object describing changes to LI and possibly PO; " .
2226 sub receive_lineitem_api {
2227 my($self, $conn, $auth, $li_id) = @_;
2229 my $e = new_editor(xact=>1, authtoken=>$auth);
2230 return $e->die_event unless $e->checkauth;
2231 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
2233 my $li = $e->retrieve_acq_lineitem([
2237 jub => ['purchase_order']
2240 ]) or return $e->die_event;
2242 return $e->die_event unless $e->allowed(
2243 'RECEIVE_PURCHASE_ORDER', $li->purchase_order->ordering_agency);
2245 my $res = receive_lineitem($mgr, $li_id) or return $e->die_event;
2247 $conn->respond_complete($res);
2248 $mgr->run_post_response_hooks
2252 __PACKAGE__->register_method(
2253 method => 'receive_lineitem_batch_api',
2254 api_name => 'open-ils.acq.lineitem.receive.batch',
2257 desc => 'Mark lineitems as received',
2259 {desc => 'Authentication token', type => 'string'},
2260 {desc => 'lineitem ID list', type => 'array'}
2263 q/On success, stream of objects describing changes to LIs and
2264 possibly PO; onerror, Event. Any event, even after lots of other
2265 objects, should mean general failure of whole batch operation./
2270 sub receive_lineitem_batch_api {
2271 my ($self, $conn, $auth, $li_idlist) = @_;
2273 return unless ref $li_idlist eq 'ARRAY' and @$li_idlist;
2275 my $e = new_editor(xact => 1, authtoken => $auth);
2276 return $e->die_event unless $e->checkauth;
2278 my $mgr = new OpenILS::Application::Acq::BatchManager(
2279 editor => $e, conn => $conn
2282 for my $li_id (map { int $_ } @$li_idlist) {
2283 my $li = $e->retrieve_acq_lineitem([
2286 flesh_fields => { jub => ['purchase_order'] }
2288 ]) or return $e->die_event;
2290 return $e->die_event unless $e->allowed(
2291 'RECEIVE_PURCHASE_ORDER', $li->purchase_order->ordering_agency
2294 receive_lineitem($mgr, $li_id) or return $e->die_event;
2298 $e->commit or return $e->die_event;
2299 $mgr->respond_complete;
2300 $mgr->run_post_response_hooks;
2303 __PACKAGE__->register_method(
2304 method => 'rollback_receive_po_api',
2305 api_name => 'open-ils.acq.purchase_order.receive.rollback'
2308 sub rollback_receive_po_api {
2309 my($self, $conn, $auth, $po_id) = @_;
2310 my $e = new_editor(xact => 1, authtoken => $auth);
2311 return $e->die_event unless $e->checkauth;
2312 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
2314 my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->die_event;
2315 return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency);
2317 my $li_ids = $e->search_acq_lineitem({purchase_order => $po_id}, {idlist => 1});
2319 for my $li_id (@$li_ids) {
2320 rollback_receive_lineitem($mgr, $li_id) or return $e->die_event;
2324 $po->state('on-order');
2325 update_purchase_order($mgr, $po) or return $e->die_event;
2328 return $mgr->respond_complete;
2332 __PACKAGE__->register_method(
2333 method => 'rollback_receive_lineitem_detail_api',
2334 api_name => 'open-ils.acq.lineitem_detail.receive.rollback',
2336 desc => 'Mark a lineitem_detail as Un-received',
2338 {desc => 'Authentication token', type => 'string'},
2339 {desc => 'lineitem detail ID', type => 'number'}
2342 "on success, object describing changes to LID and possibly " .
2343 "to LI and PO; on error, Event"
2348 sub rollback_receive_lineitem_detail_api {
2349 my($self, $conn, $auth, $lid_id) = @_;
2351 my $e = new_editor(xact=>1, authtoken=>$auth);
2352 return $e->die_event unless $e->checkauth;
2353 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
2355 my $lid = $e->retrieve_acq_lineitem_detail([
2359 acqlid => ['lineitem'],
2360 jub => ['purchase_order']
2364 my $li = $lid->lineitem;
2365 my $po = $li->purchase_order;
2367 return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency);
2371 my $recvd = rollback_receive_lineitem_detail($mgr, $lid_id)
2372 or return $e->die_event;
2375 $result->{"lid"} = {$recvd->id => {"recv_time" => $recvd->recv_time}};
2377 $result->{"lid"} = {$lid->id => {"recv_time" => $lid->recv_time}};
2380 if ($li->state eq "received") {
2381 $li->state("on-order");
2382 $li = update_lineitem($mgr, $li) or return $e->die_event;
2383 $result->{"li"} = {$li->id => {"state" => $li->state}};
2386 if ($po->state eq "received") {
2387 $po->state("on-order");
2388 $po = update_purchase_order($mgr, $po) or return $e->die_event;
2390 $result->{"po"} = describe_affected_po($e, $po);
2392 $e->commit and return $result or return $e->die_event;
2395 __PACKAGE__->register_method(
2396 method => 'rollback_receive_lineitem_api',
2397 api_name => 'open-ils.acq.lineitem.receive.rollback',
2399 desc => 'Mark a lineitem as Un-received',
2401 {desc => 'Authentication token', type => 'string'},
2402 {desc => 'lineitem ID', type => 'number'}
2405 "on success, object describing changes to LI and possibly PO; " .
2411 sub rollback_receive_lineitem_api {
2412 my($self, $conn, $auth, $li_id) = @_;
2414 my $e = new_editor(xact=>1, authtoken=>$auth);
2415 return $e->die_event unless $e->checkauth;
2416 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
2418 my $li = $e->retrieve_acq_lineitem([
2420 "flesh" => 1, "flesh_fields" => {"jub" => ["purchase_order"]}
2423 my $po = $li->purchase_order;
2425 return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency);
2427 $li = rollback_receive_lineitem($mgr, $li_id) or return $e->die_event;
2429 my $result = {"li" => {$li->id => {"state" => $li->state}}};
2430 if ($po->state eq "received") {
2431 $po->state("on-order");
2432 $po = update_purchase_order($mgr, $po) or return $e->die_event;
2434 $result->{"po"} = describe_affected_po($e, $po);
2436 $e->commit and return $result or return $e->die_event;
2439 __PACKAGE__->register_method(
2440 method => 'rollback_receive_lineitem_batch_api',
2441 api_name => 'open-ils.acq.lineitem.receive.rollback.batch',
2444 desc => 'Mark a list of lineitems as Un-received',
2446 {desc => 'Authentication token', type => 'string'},
2447 {desc => 'lineitem ID list', type => 'array'}
2450 q/on success, a stream of objects describing changes to LI and
2451 possibly PO; on error, Event. Any event means all previously
2452 returned objects indicate changes that didn't really happen./
2457 sub rollback_receive_lineitem_batch_api {
2458 my ($self, $conn, $auth, $li_idlist) = @_;
2460 return unless ref $li_idlist eq 'ARRAY' and @$li_idlist;
2462 my $e = new_editor(xact => 1, authtoken => $auth);
2463 return $e->die_event unless $e->checkauth;
2465 my $mgr = new OpenILS::Application::Acq::BatchManager(
2466 editor => $e, conn => $conn
2469 for my $li_id (map { int $_ } @$li_idlist) {
2470 my $li = $e->retrieve_acq_lineitem([
2473 "flesh_fields" => {"jub" => ["purchase_order"]}
2477 my $po = $li->purchase_order;
2479 return $e->die_event unless
2480 $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency);
2482 $li = rollback_receive_lineitem($mgr, $li_id) or return $e->die_event;
2484 my $result = {"li" => {$li->id => {"state" => $li->state}}};
2485 if ($po->state eq "received") { # should happen first time, not after
2486 $po->state("on-order");
2487 $po = update_purchase_order($mgr, $po) or return $e->die_event;
2489 $result->{"po"} = describe_affected_po($e, $po);
2491 $mgr->respond(%$result);
2494 $e->commit or return $e->die_event;
2495 $mgr->respond_complete;
2496 $mgr->run_post_response_hooks;
2500 __PACKAGE__->register_method(
2501 method => 'set_lineitem_price_api',
2502 api_name => 'open-ils.acq.lineitem.price.set',
2504 desc => 'Set lineitem price. If debits already exist, update them as well',
2506 {desc => 'Authentication token', type => 'string'},
2507 {desc => 'lineitem ID', type => 'number'}
2509 return => {desc => 'status blob, Event on error'}
2513 sub set_lineitem_price_api {
2514 my($self, $conn, $auth, $li_id, $price) = @_;
2516 my $e = new_editor(xact=>1, authtoken=>$auth);
2517 return $e->die_event unless $e->checkauth;
2518 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
2520 my ($li, $evt) = fetch_and_check_li($e, $li_id, 'write');
2521 return $evt if $evt;
2523 $li->estimated_unit_price($price);
2524 update_lineitem($mgr, $li) or return $e->die_event;
2526 my $lid_ids = $e->search_acq_lineitem_detail(
2527 {lineitem => $li_id, fund_debit => {'!=' => undef}},
2531 for my $lid_id (@$lid_ids) {
2533 my $lid = $e->retrieve_acq_lineitem_detail([
2535 flesh => 1, flesh_fields => {acqlid => ['fund', 'fund_debit']}}
2538 $lid->fund_debit->amount($price);
2539 $e->update_acq_fund_debit($lid->fund_debit) or return $e->die_event;
2545 return $mgr->respond_complete;
2549 __PACKAGE__->register_method(
2550 method => 'clone_picklist_api',
2551 api_name => 'open-ils.acq.picklist.clone',
2553 desc => 'Clones a picklist, including lineitem and lineitem details',
2555 {desc => 'Authentication token', type => 'string'},
2556 {desc => 'Picklist ID', type => 'number'},
2557 {desc => 'New Picklist Name', type => 'string'}
2559 return => {desc => 'status blob, Event on error'}
2563 sub clone_picklist_api {
2564 my($self, $conn, $auth, $pl_id, $name) = @_;
2566 my $e = new_editor(xact=>1, authtoken=>$auth);
2567 return $e->die_event unless $e->checkauth;
2568 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
2570 my $old_pl = $e->retrieve_acq_picklist($pl_id);
2571 my $new_pl = create_picklist($mgr, %{$old_pl->to_bare_hash}, name => $name) or return $e->die_event;
2573 my $li_ids = $e->search_acq_lineitem({picklist => $pl_id}, {idlist => 1});
2575 # get the current user
2576 my $cloner = $mgr->editor->requestor->id;
2578 for my $li_id (@$li_ids) {
2580 # copy the lineitems' MARC
2581 my $marc = ($e->retrieve_acq_lineitem($li_id))->marc;
2583 # create a skeletal clone of the item
2584 my $li = Fieldmapper::acq::lineitem->new;
2585 $li->creator($cloner);
2586 $li->selector($cloner);
2587 $li->editor($cloner);
2590 my $new_li = create_lineitem($mgr, %{$li->to_bare_hash}, picklist => $new_pl->id) or return $e->die_event;
2596 return $mgr->respond_complete;
2600 __PACKAGE__->register_method(
2601 method => 'merge_picklist_api',
2602 api_name => 'open-ils.acq.picklist.merge',
2604 desc => 'Merges 2 or more picklists into a single list',
2606 {desc => 'Authentication token', type => 'string'},
2607 {desc => 'Lead Picklist ID', type => 'number'},
2608 {desc => 'List of subordinate picklist IDs', type => 'array'}
2610 return => {desc => 'status blob, Event on error'}
2614 sub merge_picklist_api {
2615 my($self, $conn, $auth, $lead_pl, $pl_list) = @_;
2617 my $e = new_editor(xact=>1, authtoken=>$auth);
2618 return $e->die_event unless $e->checkauth;
2619 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
2621 # XXX perms on each picklist modified
2623 $lead_pl = $e->retrieve_acq_picklist($lead_pl) or return $e->die_event;
2624 # point all of the lineitems at the lead picklist
2625 my $li_ids = $e->search_acq_lineitem({picklist => $pl_list}, {idlist => 1});
2627 for my $li_id (@$li_ids) {
2628 my $li = $e->retrieve_acq_lineitem($li_id);
2629 $li->picklist($lead_pl);
2630 update_lineitem($mgr, $li) or return $e->die_event;
2634 # now delete the subordinate lists
2635 for my $pl_id (@$pl_list) {
2636 my $pl = $e->retrieve_acq_picklist($pl_id);
2637 $e->delete_acq_picklist($pl) or return $e->die_event;
2640 update_picklist($mgr, $lead_pl) or return $e->die_event;
2643 return $mgr->respond_complete;
2647 __PACKAGE__->register_method(
2648 method => 'delete_picklist_api',
2649 api_name => 'open-ils.acq.picklist.delete',
2651 desc => q/Deletes a picklist. It also deletes any lineitems in the "new" state. / .
2652 q/Other attached lineitems are detached/,
2654 {desc => 'Authentication token', type => 'string'},
2655 {desc => 'Picklist ID to delete', type => 'number'}
2657 return => {desc => '1 on success, Event on error'}
2661 sub delete_picklist_api {
2662 my($self, $conn, $auth, $picklist_id) = @_;
2663 my $e = new_editor(xact=>1, authtoken=>$auth);
2664 return $e->die_event unless $e->checkauth;
2665 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
2666 my $pl = $e->retrieve_acq_picklist($picklist_id) or return $e->die_event;
2667 delete_picklist($mgr, $pl) or return $e->die_event;
2669 return $mgr->respond_complete;
2674 __PACKAGE__->register_method(
2675 method => 'activate_purchase_order',
2676 api_name => 'open-ils.acq.purchase_order.activate.dry_run'
2679 __PACKAGE__->register_method(
2680 method => 'activate_purchase_order',
2681 api_name => 'open-ils.acq.purchase_order.activate',
2683 desc => q/Activates a purchase order. This updates the status of the PO / .
2684 q/and Lineitems to 'on-order'. Activated PO's are ready for EDI delivery if appropriate./,
2686 {desc => 'Authentication token', type => 'string'},
2687 {desc => 'Purchase ID', type => 'number'}
2689 return => {desc => '1 on success, Event on error'}
2693 sub activate_purchase_order {
2694 my($self, $conn, $auth, $po_id, $vandelay, $options) = @_;
2696 $$options{dry_run} = ($self->api_name =~ /\.dry_run/) ? 1 : 0;
2698 my $e = new_editor(authtoken=>$auth);
2699 return $e->die_event unless $e->checkauth;
2700 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
2701 my $die_event = activate_purchase_order_impl($mgr, $po_id, $vandelay, $options);
2702 return $e->die_event if $die_event;
2703 $conn->respond_complete(1);
2704 $mgr->run_post_response_hooks unless $$options{dry_run};
2708 # xacts managed within
2709 sub activate_purchase_order_impl {
2710 my ($mgr, $po_id, $vandelay, $options) = @_;
2712 my $dry_run = $$options{dry_run};
2713 my $no_assets = $$options{no_assets};
2715 # read-only until lineitem asset creation
2716 my $e = $mgr->editor;
2719 my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->die_event;
2720 return $e->die_event unless $e->allowed('CREATE_PURCHASE_ORDER', $po->ordering_agency);
2722 return $e->die_event(OpenILS::Event->new('PO_ALREADY_ACTIVATED'))
2723 if $po->order_date; # PO cannot be re-activated
2725 my $provider = $e->retrieve_acq_provider($po->provider);
2727 # find lineitems and create assets for all
2730 purchase_order => $po_id,
2731 state => [qw/pending-order new order-ready/]
2734 my $li_ids = $e->search_acq_lineitem($query, {idlist => 1});
2736 my $vl_resp; # imported li's and the managing queue
2737 unless ($dry_run or $no_assets) {
2738 $e->rollback; # read-only thus far
2740 # list_assets manages its own transactions
2741 $vl_resp = create_lineitem_list_assets($mgr, $li_ids, $vandelay)
2742 or return OpenILS::Event->new('ACQ_LI_IMPORT_FAILED');
2746 # create fund debits for lineitems
2748 for my $li_id (@$li_ids) {
2749 my $li = $e->retrieve_acq_lineitem($li_id);
2751 unless ($li->eg_bib_id or $dry_run or $no_assets) {
2752 # we encountered a lineitem that was not successfully imported.
2753 # we cannot continue. rollback and report.
2755 return OpenILS::Event->new('ACQ_LI_IMPORT_FAILED', {queue => $vl_resp->{queue}});
2758 $li->state('on-order');
2759 $li->claim_policy($provider->default_claim_policy)
2760 if $provider->default_claim_policy and !$li->claim_policy;
2761 create_lineitem_debits($mgr, $li, $options) or return $e->die_event;
2762 update_lineitem($mgr, $li) or return $e->die_event;
2763 $mgr->post_process( sub { create_lineitem_status_events($mgr, $li->id, 'aur.ordered'); });
2767 # create po-item debits
2769 for my $po_item (@{$e->search_acq_po_item({purchase_order => $po_id})}) {
2771 my $debit = create_fund_debit(
2774 debit_type => 'direct_charge', # to match invoicing
2775 origin_amount => $po_item->estimated_cost,
2776 origin_currency_type => $e->retrieve_acq_fund($po_item->fund)->currency_type,
2777 amount => $po_item->estimated_cost,
2778 fund => $po_item->fund
2779 ) or return $e->die_event;
2780 $po_item->fund_debit($debit->id);
2781 $e->update_acq_po_item($po_item) or return $e->die_event;
2785 # mark PO as ordered
2787 $po->state('on-order');
2788 $po->order_date('now');
2789 update_purchase_order($mgr, $po) or return $e->die_event;
2792 $dry_run and $e->rollback or $e->commit;
2794 # tell the world we activated a PO
2795 $U->create_events_for_hook('acqpo.activated', $po, $po->ordering_agency) unless $dry_run;
2801 __PACKAGE__->register_method(
2802 method => 'split_purchase_order_by_lineitems',
2803 api_name => 'open-ils.acq.purchase_order.split_by_lineitems',
2805 desc => q/Splits a PO into many POs, 1 per lineitem. Only works for / .
2806 q/POs a) with more than one lineitems, and b) in the "pending" state./,
2808 {desc => 'Authentication token', type => 'string'},
2809 {desc => 'Purchase order ID', type => 'number'}
2811 return => {desc => 'list of new PO IDs on success, Event on error'}
2815 sub split_purchase_order_by_lineitems {
2816 my ($self, $conn, $auth, $po_id) = @_;
2818 my $e = new_editor("xact" => 1, "authtoken" => $auth);
2819 return $e->die_event unless $e->checkauth;
2821 my $po = $e->retrieve_acq_purchase_order([
2824 "flesh_fields" => {"acqpo" => [qw/lineitems notes/]}
2826 ]) or return $e->die_event;
2828 return $e->die_event
2829 unless $e->allowed("CREATE_PURCHASE_ORDER", $po->ordering_agency);
2831 unless ($po->state eq "pending") {
2833 return new OpenILS::Event("ACQ_PURCHASE_ORDER_TOO_LATE");
2836 unless (@{$po->lineitems} > 1) {
2838 return new OpenILS::Event("ACQ_PURCHASE_ORDER_TOO_SHORT");
2841 # To split an existing PO into many, it seems unwise to just delete the
2842 # original PO, so we'll instead detach all of the original POs' lineitems
2843 # but the first, then create new POs for each of the remaining LIs, and
2844 # then attach the LIs to their new POs.
2846 my @po_ids = ($po->id);
2847 my @moving_li = @{$po->lineitems};
2848 shift @moving_li; # discard first LI
2850 foreach my $li (@moving_li) {
2851 my $new_po = $po->clone;
2853 $new_po->clear_name;
2854 $new_po->creator($e->requestor->id);
2855 $new_po->editor($e->requestor->id);
2856 $new_po->owner($e->requestor->id);
2857 $new_po->edit_time("now");
2858 $new_po->create_time("now");
2860 $new_po = $e->create_acq_purchase_order($new_po);
2862 # Clone any notes attached to the old PO and attach to the new one.
2863 foreach my $note (@{$po->notes}) {
2864 my $new_note = $note->clone;
2865 $new_note->clear_id;
2866 $new_note->edit_time("now");
2867 $new_note->purchase_order($new_po->id);
2868 $e->create_acq_po_note($new_note);
2871 $li->edit_time("now");
2872 $li->purchase_order($new_po->id);
2873 $e->update_acq_lineitem($li);
2875 push @po_ids, $new_po->id;
2878 $po->edit_time("now");
2879 $e->update_acq_purchase_order($po);
2881 return \@po_ids if $e->commit;
2882 return $e->die_event;
2886 sub not_cancelable {
2888 (ref $o eq "HASH" and $o->{"textcode"} eq "ACQ_NOT_CANCELABLE");
2891 __PACKAGE__->register_method(
2892 method => "cancel_purchase_order_api",
2893 api_name => "open-ils.acq.purchase_order.cancel",
2895 desc => q/Cancels an on-order purchase order/,
2897 {desc => "Authentication token", type => "string"},
2898 {desc => "PO ID to cancel", type => "number"},
2899 {desc => "Cancel reason ID", type => "number"}
2901 return => {desc => q/Object describing changed POs, LIs and LIDs
2902 on success; Event on error./}
2906 sub cancel_purchase_order_api {
2907 my ($self, $conn, $auth, $po_id, $cancel_reason) = @_;
2909 my $e = new_editor("xact" => 1, "authtoken" => $auth);
2910 return $e->die_event unless $e->checkauth;
2911 my $mgr = new OpenILS::Application::Acq::BatchManager(
2912 "editor" => $e, "conn" => $conn
2915 $cancel_reason = $mgr->editor->retrieve_acq_cancel_reason($cancel_reason) or
2916 return new OpenILS::Event(
2917 "BAD_PARAMS", "note" => "Provide cancel reason ID"
2920 my $result = cancel_purchase_order($mgr, $po_id, $cancel_reason) or
2921 return $e->die_event;
2922 if (not_cancelable($result)) { # event not from CStoreEditor
2925 } elsif ($result == -1) {
2927 return new OpenILS::Event("ACQ_ALREADY_CANCELED");
2930 $e->commit or return $e->die_event;
2932 # XXX create purchase order status events?
2934 if ($mgr->{post_commit}) {
2935 foreach my $func (@{$mgr->{post_commit}}) {
2943 sub cancel_purchase_order {
2944 my ($mgr, $po_id, $cancel_reason) = @_;
2946 my $po = $mgr->editor->retrieve_acq_purchase_order($po_id) or return 0;
2948 # XXX is "cancelled" a typo? It's not correct US spelling, anyway.
2949 # Depending on context, this may not warrant an event.
2950 return -1 if $po->state eq "cancelled";
2952 # But this always does.
2953 return new OpenILS::Event(
2954 "ACQ_NOT_CANCELABLE", "note" => "purchase_order $po_id"
2955 ) unless ($po->state eq "on-order" or $po->state eq "pending");
2958 $mgr->editor->allowed("CREATE_PURCHASE_ORDER", $po->ordering_agency);
2960 $po->state("cancelled");
2961 $po->cancel_reason($cancel_reason->id);
2963 my $li_ids = $mgr->editor->search_acq_lineitem(
2964 {"purchase_order" => $po_id}, {"idlist" => 1}
2967 my $result = {"li" => {}, "lid" => {}};
2968 foreach my $li_id (@$li_ids) {
2969 my $li_result = cancel_lineitem($mgr, $li_id, $cancel_reason)
2972 next if $li_result == -1; # already canceled:skip.
2973 return $li_result if not_cancelable($li_result); # not cancelable:stop.
2975 # Merge in each LI result (there's only going to be
2976 # one per call to cancel_lineitem).
2977 my ($k, $v) = each %{$li_result->{"li"}};
2978 $result->{"li"}->{$k} = $v;
2980 # Merge in each LID result (there may be many per call to
2982 while (($k, $v) = each %{$li_result->{"lid"}}) {
2983 $result->{"lid"}->{$k} = $v;
2987 my $po_item_ids = $mgr->editor
2988 ->search_acq_po_item({purchase_order => $po_id}, {idlist => 1});
2990 for my $po_item_id (@$po_item_ids) {
2992 my $po_item = $mgr->editor->retrieve_acq_po_item([
2995 flesh_fields => {acqpoi => ['purchase_order', 'fund_debit']}
2997 ]) or return -1; # results in rollback
2999 # returns undef on success
3000 my $result = clear_po_item($mgr->editor, $po_item);
3002 return $result if not_cancelable($result);
3003 return -1 if $result; # other failure events, results in rollback
3007 # TODO who/what/where/how do we indicate this change for electronic orders?
3008 # TODO return changes to encumbered/spent
3009 # TODO maybe cascade up from smaller object to container object if last
3010 # smaller object in the container has been canceled?
3012 update_purchase_order($mgr, $po) or return 0;
3014 $po_id => {"state" => $po->state, "cancel_reason" => $cancel_reason}
3020 __PACKAGE__->register_method(
3021 method => "cancel_lineitem_api",
3022 api_name => "open-ils.acq.lineitem.cancel",
3024 desc => q/Cancels an on-order lineitem/,
3026 {desc => "Authentication token", type => "string"},
3027 {desc => "Lineitem ID to cancel", type => "number"},
3028 {desc => "Cancel reason ID", type => "number"}
3030 return => {desc => q/Object describing changed LIs and LIDs on success;
3035 __PACKAGE__->register_method(
3036 method => "cancel_lineitem_api",
3037 api_name => "open-ils.acq.lineitem.cancel.batch",
3039 desc => q/Batched version of open-ils.acq.lineitem.cancel/,
3040 return => {desc => q/Object describing changed LIs and LIDs on success;
3045 sub cancel_lineitem_api {
3046 my ($self, $conn, $auth, $li_id, $cancel_reason) = @_;
3048 my $batched = $self->api_name =~ /\.batch/;
3050 my $e = new_editor("xact" => 1, "authtoken" => $auth);
3051 return $e->die_event unless $e->checkauth;
3052 my $mgr = new OpenILS::Application::Acq::BatchManager(
3053 "editor" => $e, "conn" => $conn
3056 $cancel_reason = $mgr->editor->retrieve_acq_cancel_reason($cancel_reason) or
3057 return new OpenILS::Event(
3058 "BAD_PARAMS", "note" => "Provide cancel reason ID"
3061 my ($result, $maybe_event);
3064 $result = {"li" => {}, "lid" => {}};
3065 foreach my $one_li_id (@$li_id) {
3066 my $one = cancel_lineitem($mgr, $one_li_id, $cancel_reason) or
3067 return $e->die_event;
3068 if (not_cancelable($one)) {
3069 $maybe_event = $one;
3070 } elsif ($result == -1) {
3071 $maybe_event = new OpenILS::Event("ACQ_ALREADY_CANCELED");
3075 while (($k, $v) = each %{$one->{"li"}}) {
3076 $result->{"li"}->{$k} = $v;
3079 if ($one->{"lid"}) {
3080 while (($k, $v) = each %{$one->{"lid"}}) {
3081 $result->{"lid"}->{$k} = $v;
3087 $result = cancel_lineitem($mgr, $li_id, $cancel_reason) or
3088 return $e->die_event;
3090 if (not_cancelable($result)) {
3093 } elsif ($result == -1) {
3095 return new OpenILS::Event("ACQ_ALREADY_CANCELED");
3099 if ($batched and not scalar keys %{$result->{"li"}}) {
3101 return $maybe_event;
3103 $e->commit or return $e->die_event;
3104 # create_lineitem_status_events should handle array li_id ok
3105 create_lineitem_status_events($mgr, $li_id, "aur.cancelled");
3107 if ($mgr->{post_commit}) {
3108 foreach my $func (@{$mgr->{post_commit}}) {
3117 sub cancel_lineitem {
3118 my ($mgr, $li_id, $cancel_reason) = @_;
3120 my $li = $mgr->editor->retrieve_acq_lineitem([
3121 $li_id, {flesh => 1,
3122 flesh_fields => {jub => ['purchase_order','cancel_reason']}}
3125 return 0 unless $mgr->editor->allowed(
3126 "CREATE_PURCHASE_ORDER", $li->purchase_order->ordering_agency
3129 # Depending on context, this may not warrant an event.
3130 return -1 if $li->state eq "cancelled"
3131 and $li->cancel_reason->keep_debits eq 'f';
3133 # But this always does. Note that this used to be looser, but you can
3134 # no longer cancel lineitems that lack a PO or that are in "pending-order"
3135 # state (you could in the past).
3136 return new OpenILS::Event(
3137 "ACQ_NOT_CANCELABLE", "note" => "lineitem $li_id"
3138 ) unless $li->purchase_order and
3139 ($li->state eq "on-order" or $li->state eq "cancelled");
3141 $li->state("cancelled");
3142 $li->cancel_reason($cancel_reason->id);
3144 my $lids = $mgr->editor->search_acq_lineitem_detail([{
3145 "lineitem" => $li_id
3148 flesh_fields => { acqlid => ['eg_copy_id'] }
3151 my $result = {"lid" => {}};
3153 foreach my $lid (@$lids) {
3154 my $lid_result = cancel_lineitem_detail($mgr, $lid->id, $cancel_reason)
3157 # gathering any real copies for deletion
3158 if ($lid->eg_copy_id) {
3159 $lid->eg_copy_id->isdeleted('t');
3160 push @$copies, $lid->eg_copy_id;
3163 next if $lid_result == -1; # already canceled: just skip it.
3164 return $lid_result if not_cancelable($lid_result); # not cxlable: stop.
3166 # Merge in each LID result (there's only going to be one per call to
3167 # cancel_lineitem_detail).
3168 my ($k, $v) = each %{$lid_result->{"lid"}};
3169 $result->{"lid"}->{$k} = $v;
3172 # Attempt to delete the gathered copies (this will also handle volume deletion and bib deletion)
3173 # Delete empty bibs according org unit setting
3174 my $force_delete_empty_bib = $U->ou_ancestor_setting_value(
3175 $mgr->editor->requestor->ws_ou, 'cat.bib.delete_on_no_copy_via_acq_lineitem_cancel', $mgr->editor);
3176 if (scalar(@$copies)>0) {
3178 my $delete_stats = undef;
3179 my $retarget_holds = [];
3180 my $cat_evt = OpenILS::Application::Cat::AssetCommon->update_fleshed_copies(
3181 $mgr->editor, $override, undef, $copies, $delete_stats, $retarget_holds,$force_delete_empty_bib);
3184 $logger->info("fleshed copy update failed with event: ".OpenSRF::Utils::JSON->perl2JSON($cat_evt));
3185 return new OpenILS::Event(
3186 "ACQ_NOT_CANCELABLE", "note" => "lineitem $li_id", "payload" => $cat_evt
3190 # We can't do the following and stay within the same transaction, but that's okay, the hold targeter will pick these up later.
3191 #my $ses = OpenSRF::AppSession->create('open-ils.circ');
3192 #$ses->request('open-ils.circ.hold.reset.batch', $auth, $retarget_holds);
3195 # if we have a bib, check to see whether it has been deleted. if so, cancel any active holds targeting that bib
3196 if ($li->eg_bib_id) {
3197 my $bib = $mgr->editor->retrieve_biblio_record_entry($li->eg_bib_id) or return new OpenILS::Event(
3198 "ACQ_NOT_CANCELABLE", "note" => "Could not retrieve bib " . $li->eg_bib_id . " for lineitem $li_id"
3200 if ($U->is_true($bib->deleted)) {
3201 my $holds = $mgr->editor->search_action_hold_request(
3202 { cancel_time => undef,
3203 fulfillment_time => undef,
3204 target => $li->eg_bib_id
3208 my %cached_usr_home_ou = ();
3210 for my $hold (@$holds) {
3212 $logger->info("Cancelling hold ".$hold->id.
3213 " due to acq lineitem cancellation.");
3215 $hold->cancel_time('now');
3216 $hold->cancel_cause(5); # 'Staff forced'--we may want a new hold cancel cause reason for this
3217 $hold->cancel_note('Corresponding Acquistion Lineitem/Purchase Order was cancelled.');
3218 unless($mgr->editor->update_action_hold_request($hold)) {
3219 my $evt = $mgr->editor->event;
3220 $logger->error("Error updating hold ". $evt->textcode .":". $evt->desc .":". $evt->stacktrace);
3221 return new OpenILS::Event(
3222 "ACQ_NOT_CANCELABLE", "note" => "Could not cancel hold " . $hold->id . " for lineitem $li_id", "payload" => $evt
3225 if (! defined $mgr->{post_commit}) { # we need a mechanism for creating trigger events, but only if the transaction gets committed
3226 $mgr->{post_commit} = [];
3228 push @{ $mgr->{post_commit} }, sub {
3229 my $home_ou = $cached_usr_home_ou{$hold->usr};
3231 my $user = $mgr->editor->retrieve_actor_user($hold->usr); # FIXME: how do we want to handle failures here?
3232 $home_ou = $user->home_ou;
3233 $cached_usr_home_ou{$hold->usr} = $home_ou;
3235 $U->create_events_for_hook('hold_request.cancel.cancelled_order', $hold, $home_ou);
3241 update_lineitem($mgr, $li) or return 0;
3244 "state" => $li->state,
3245 "cancel_reason" => $cancel_reason
3249 # check to see if this cancelation should result in
3250 # marking the purchase order "received"
3251 return 0 unless check_purchase_order_received($mgr, $li->purchase_order->id);
3257 __PACKAGE__->register_method(
3258 method => "cancel_lineitem_detail_api",
3259 api_name => "open-ils.acq.lineitem_detail.cancel",
3261 desc => q/Cancels an on-order lineitem detail/,
3263 {desc => "Authentication token", type => "string"},
3264 {desc => "Lineitem detail ID to cancel", type => "number"},
3265 {desc => "Cancel reason ID", type => "number"}
3267 return => {desc => q/Object describing changed LIDs on success;
3272 sub cancel_lineitem_detail_api {
3273 my ($self, $conn, $auth, $lid_id, $cancel_reason) = @_;
3275 my $e = new_editor("xact" => 1, "authtoken" => $auth);
3276 return $e->die_event unless $e->checkauth;
3277 my $mgr = new OpenILS::Application::Acq::BatchManager(
3278 "editor" => $e, "conn" => $conn
3281 $cancel_reason = $mgr->editor->retrieve_acq_cancel_reason($cancel_reason) or
3282 return new OpenILS::Event(
3283 "BAD_PARAMS", "note" => "Provide cancel reason ID"
3286 my $result = cancel_lineitem_detail($mgr, $lid_id, $cancel_reason) or
3287 return $e->die_event;
3289 if (not_cancelable($result)) {
3292 } elsif ($result == -1) {
3294 return new OpenILS::Event("ACQ_ALREADY_CANCELED");
3297 $e->commit or return $e->die_event;
3299 # XXX create lineitem detail status events?
3303 sub cancel_lineitem_detail {
3304 my ($mgr, $lid_id, $cancel_reason) = @_;
3305 my $lid = $mgr->editor->retrieve_acq_lineitem_detail([
3309 "acqlid" => ["lineitem","cancel_reason"],
3310 "jub" => ["purchase_order"]
3315 # It's OK to cancel an already-canceled copy if the copy was
3316 # previously "delayed" -- keep_debits == true
3317 # Depending on context, this may not warrant an event.
3318 return -1 if $lid->cancel_reason
3319 and $lid->cancel_reason->keep_debits eq 'f';
3321 # But this always does.
3322 return new OpenILS::Event(
3323 "ACQ_NOT_CANCELABLE", "note" => "lineitem_detail $lid_id"
3325 (! $lid->lineitem->purchase_order) or
3327 (not $lid->recv_time) and
3329 $lid->lineitem->purchase_order and (
3330 $lid->lineitem->state eq "on-order" or
3331 $lid->lineitem->state eq "pending-order" or
3332 $lid->lineitem->state eq "cancelled"
3337 return 0 unless $mgr->editor->allowed(
3338 "CREATE_PURCHASE_ORDER",
3339 $lid->lineitem->purchase_order->ordering_agency
3340 ) or (! $lid->lineitem->purchase_order);
3342 $lid->cancel_reason($cancel_reason->id);
3344 unless($U->is_true($cancel_reason->keep_debits)) {
3345 my $debit_id = $lid->fund_debit;
3346 $lid->clear_fund_debit;
3349 # item is cancelled. Remove the fund debit.
3350 my $debit = $mgr->editor->retrieve_acq_fund_debit($debit_id);
3351 if (!$U->is_true($debit->encumbrance)) {
3352 $mgr->editor->rollback;
3353 return OpenILS::Event->new('ACQ_NOT_CANCELABLE',
3354 note => "Debit is marked as paid: $debit_id");
3356 $mgr->editor->delete_acq_fund_debit($debit) or return $mgr->editor->die_event;
3360 # XXX LIDs don't have either an editor or a edit_time field. Should we
3361 # update these on the LI when we alter an LID?
3362 $mgr->editor->update_acq_lineitem_detail($lid) or return 0;
3364 return {"lid" => {$lid_id => {"cancel_reason" => $cancel_reason}}};
3367 __PACKAGE__->register_method(
3368 method => "delete_po_item_api",
3369 api_name => "open-ils.acq.po_item.delete",
3371 desc => q/Deletes a po_item and removes its debit/,
3373 {desc => "Authentication token", type => "string"},
3374 {desc => "po_item ID to delete", type => "number"},
3376 return => {desc => q/1 on success, Event on error/}
3380 sub delete_po_item_api {
3381 my($self, $client, $auth, $po_item_id) = @_;
3382 my $e = new_editor(authtoken => $auth, xact => 1);
3383 return $e->die_event unless $e->checkauth;
3385 my $po_item = $e->retrieve_acq_po_item([
3388 flesh_fields => {acqpoi => ['purchase_order', 'fund_debit']}
3390 ]) or return $e->die_event;
3392 return $e->die_event unless
3393 $e->allowed('CREATE_PURCHASE_ORDER',
3394 $po_item->purchase_order->ordering_agency);
3396 # remove debit, delete item
3397 my $result = clear_po_item($e, $po_item, 1);
3409 # 1. Removes linked fund debit from a PO item if present and still encumbered.
3410 # 2. Optionally also deletes the po_item object
3411 # po_item is fleshed with purchase_order and fund_debit
3413 my ($e, $po_item, $delete_item) = @_;
3415 if ($po_item->fund_debit) {
3417 if (!$U->is_true($po_item->fund_debit->encumbrance)) {
3418 # debit has been paid. We cannot delete it.
3419 return OpenILS::Event->new('ACQ_NOT_CANCELABLE',
3420 note => "Debit is marked as paid: ".$po_item->fund_debit->id);
3423 # fund_debit is OK to delete.
3424 $e->delete_acq_fund_debit($po_item->fund_debit)
3425 or return $e->die_event;
3429 $e->delete_acq_po_item($po_item) or return $e->die_event;
3431 # remove our link to the now-deleted fund_debit.
3432 $po_item->clear_fund_debit;
3433 $e->update_acq_po_item($po_item) or return $e->die_event;
3440 __PACKAGE__->register_method(
3441 method => 'user_requests',
3442 api_name => 'open-ils.acq.user_request.retrieve.by_user_id',
3445 desc => 'Retrieve fleshed user requests and related data for a given user.',
3447 { desc => 'Authentication token', type => 'string' },
3448 { desc => 'User ID of the owner, or array of IDs', },
3449 { desc => 'Options hash (optional) with any of the keys: order_by, limit, offset, state (of the lineitem)',
3454 desc => 'Fleshed user requests and related data',
3460 __PACKAGE__->register_method(
3461 method => 'user_requests',
3462 api_name => 'open-ils.acq.user_request.retrieve.by_home_ou',
3465 desc => 'Retrieve fleshed user requests and related data for a given org unit or units.',
3467 { desc => 'Authentication token', type => 'string' },
3468 { desc => 'Org unit ID, or array of IDs', },
3469 { desc => 'Options hash (optional) with any of the keys: order_by, limit, offset, state (of the lineitem)',
3474 desc => 'Fleshed user requests and related data',
3481 my($self, $conn, $auth, $search_value, $options) = @_;
3482 my $e = new_editor(authtoken => $auth);
3483 return $e->event unless $e->checkauth;
3484 my $rid = $e->requestor->id;
3488 "select"=>{"aur"=>["id"],"au"=>["home_ou", {column => 'id', alias => 'usr_id'} ]},
3489 "from"=>{ "aur" => { "au" => {}, "jub" => { "type" => "left" } } },
3493 {"id"=>undef}, # this with the left-join pulls in requests without lineitems
3494 {"state"=>["new","on-order","pending-order"]} # FIXME - probably needs softcoding
3498 "order_by"=>[{"class"=>"aur", "field"=>"request_date", "direction"=>"desc"}]
3501 foreach (qw/ order_by limit offset /) {
3502 $query->{$_} = $options->{$_} if defined $options->{$_};
3504 if (defined $options->{'state'}) {
3505 $query->{'where'}->{'+jub'}->{'-or'}->[1]->{'state'} = $options->{'state'};
3508 if ($self->api_name =~ /by_user_id/) {
3509 $query->{'where'}->{'usr'} = $search_value;
3511 $query->{'where'}->{'+au'} = { 'home_ou' => $search_value };
3514 my $pertinent_ids = $e->json_query($query);
3517 for my $id_blob (@$pertinent_ids) {
3518 if ($rid != $id_blob->{usr_id}) {
3519 if (!defined $perm_test{ $id_blob->{home_ou} }) {
3520 $perm_test{ $id_blob->{home_ou} } = $e->allowed( ['user_request.view'], $id_blob->{home_ou} );
3522 if (!$perm_test{ $id_blob->{home_ou} }) {
3526 my $aur_obj = $e->retrieve_acq_user_request([
3528 {flesh => 1, flesh_fields => { "aur" => [ 'lineitem' ] } }
3530 if (! $aur_obj) { next; }
3532 if ($aur_obj->lineitem()) {
3533 $aur_obj->lineitem()->clear_marc();
3535 $conn->respond($aur_obj);
3541 __PACKAGE__->register_method (
3542 method => 'update_user_request',
3543 api_name => 'open-ils.acq.user_request.cancel.batch',
3546 desc => 'If given a cancel reason, will update the request with that reason, otherwise, this will delete the request altogether. The ' .
3547 'intention is for staff interfaces or processes to provide cancel reasons, and for patron interfaces to just delete the requests.' ,
3549 { desc => 'Authentication token', type => 'string' },
3550 { desc => 'ID or array of IDs for the user requests to cancel' },
3551 { desc => 'Cancel Reason ID (optional)', type => 'string' }
3554 desc => 'progress object, event on error',
3558 __PACKAGE__->register_method (
3559 method => 'update_user_request',
3560 api_name => 'open-ils.acq.user_request.set_no_hold.batch',
3563 desc => 'Remove the hold from a user request or set of requests',
3565 { desc => 'Authentication token', type => 'string' },
3566 { desc => 'ID or array of IDs for the user requests to modify' }
3569 desc => 'progress object, event on error',
3574 sub update_user_request {
3575 my($self, $conn, $auth, $aur_ids, $cancel_reason) = @_;
3576 my $e = new_editor(xact => 1, authtoken => $auth);
3577 return $e->die_event unless $e->checkauth;
3578 my $rid = $e->requestor->id;
3582 for my $id (@$aur_ids) {
3584 my $aur_obj = $e->retrieve_acq_user_request([
3587 flesh_fields => { "aur" => ['lineitem', 'usr'] }
3589 ]) or return $e->die_event;
3591 my $context_org = $aur_obj->usr()->home_ou();
3592 $aur_obj->usr( $aur_obj->usr()->id() );
3594 if ($rid != $aur_obj->usr) {
3595 if (!defined $perm_test{ $context_org }) {
3596 $perm_test{ $context_org } = $e->allowed( ['user_request.update'], $context_org );
3598 if (!$perm_test{ $context_org }) {
3603 if($self->api_name =~ /set_no_hold/) {
3604 if ($U->is_true($aur_obj->hold)) {
3606 $e->update_acq_user_request($aur_obj) or return $e->die_event;
3610 if($self->api_name =~ /cancel/) {
3611 if ( $cancel_reason ) {
3612 $aur_obj->cancel_reason( $cancel_reason );
3613 $e->update_acq_user_request($aur_obj) or return $e->die_event;
3614 create_user_request_events( $e, [ $aur_obj ], 'aur.rejected' );
3616 $e->delete_acq_user_request($aur_obj);
3620 $conn->respond({maximum => scalar(@$aur_ids), progress => $x++});
3624 return {complete => 1};
3627 __PACKAGE__->register_method (
3628 method => 'new_user_request',
3629 api_name => 'open-ils.acq.user_request.create',
3631 desc => 'Create a new user request object in the DB',
3633 { desc => 'Authentication token', type => 'string' },
3634 { desc => 'User request data hash. Hash keys match the fields for the "aur" object', type => 'object' }
3637 desc => 'The created user request object, or event on error'
3642 sub new_user_request {
3643 my($self, $conn, $auth, $form_data) = @_;
3644 my $e = new_editor(xact => 1, authtoken => $auth);
3645 return $e->die_event unless $e->checkauth;
3646 my $rid = $e->requestor->id;
3647 my $target_user_fleshed;
3648 if (! defined $$form_data{'usr'}) {
3649 $$form_data{'usr'} = $rid;
3651 if ($$form_data{'usr'} != $rid) {
3652 # See if the requestor can place the request on behalf of a different user.
3653 $target_user_fleshed = $e->retrieve_actor_user($$form_data{'usr'}) or return $e->die_event;
3654 $e->allowed('user_request.create', $target_user_fleshed->home_ou) or return $e->die_event;
3656 $target_user_fleshed = $e->requestor;
3657 $e->allowed('CREATE_PURCHASE_REQUEST') or return $e->die_event;
3659 if (! defined $$form_data{'pickup_lib'}) {
3660 if ($target_user_fleshed->ws_ou) {
3661 $$form_data{'pickup_lib'} = $target_user_fleshed->ws_ou;
3663 $$form_data{'pickup_lib'} = $target_user_fleshed->home_ou;
3666 if (! defined $$form_data{'request_type'}) {
3667 $$form_data{'request_type'} = 1; # Books
3669 my $aur_obj = new Fieldmapper::acq::user_request;
3671 $aur_obj->usr( $$form_data{'usr'} );
3672 $aur_obj->request_date( 'now' );
3673 for my $field ( keys %$form_data ) {
3674 if (defined $$form_data{$field} and $field !~ /^(id|lineitem|eg_bib|request_date|cancel_reason)$/) {
3675 $aur_obj->$field( $$form_data{$field} );
3679 $aur_obj = $e->create_acq_user_request($aur_obj) or return $e->die_event;
3681 $e->commit and create_user_request_events( $e, [ $aur_obj ], 'aur.created' );
3686 sub create_user_request_events {
3687 my($e, $user_reqs, $hook) = @_;
3689 my $ses = OpenSRF::AppSession->create('open-ils.trigger');
3692 my %cached_usr_home_ou = ();
3693 for my $user_req (@$user_reqs) {
3694 my $home_ou = $cached_usr_home_ou{$user_req->usr};
3696 my $user = $e->retrieve_actor_user($user_req->usr) or return $e->die_event;
3697 $home_ou = $user->home_ou;
3698 $cached_usr_home_ou{$user_req->usr} = $home_ou;
3700 my $req = $ses->request('open-ils.trigger.event.autocreate', $hook, $user_req, $home_ou);
3709 __PACKAGE__->register_method(
3710 method => "po_note_CUD_batch",
3711 api_name => "open-ils.acq.po_note.cud.batch",
3714 desc => q/Manage purchase order notes/,
3716 {desc => "Authentication token", type => "string"},
3717 {desc => "List of po_notes to manage", type => "array"},
3719 return => {desc => "Stream of successfully managed objects"}
3723 sub po_note_CUD_batch {
3724 my ($self, $conn, $auth, $notes) = @_;
3726 my $e = new_editor("xact"=> 1, "authtoken" => $auth);
3727 return $e->die_event unless $e->checkauth;
3730 my $total = @$notes;
3733 foreach my $note (@$notes) {
3735 $note->editor($e->requestor->id);
3736 $note->edit_time("now");
3739 $note->creator($e->requestor->id);
3740 $note = $e->create_acq_po_note($note) or return $e->die_event;
3741 } elsif ($note->isdeleted) {
3742 $e->delete_acq_po_note($note) or return $e->die_event;
3743 } elsif ($note->ischanged) {
3744 $e->update_acq_po_note($note) or return $e->die_event;
3747 unless ($note->isdeleted) {
3748 $note = $e->retrieve_acq_po_note($note->id) or
3749 return $e->die_event;
3753 {"maximum" => $total, "progress" => ++$count, "note" => $note}
3757 $e->commit and $conn->respond_complete or return $e->die_event;
3761 # retrieves a lineitem, fleshes its PO and PL, checks perms
3762 # returns ($li, $evt, $org)
3763 sub fetch_and_check_li {
3766 my $perm_mode = shift || 'read';
3768 my $li = $e->retrieve_acq_lineitem([
3771 flesh_fields => {jub => ['purchase_order', 'picklist']}
3773 ]) or return (undef, $e->die_event);
3776 if(my $po = $li->purchase_order) {
3777 $org = $po->ordering_agency;
3778 my $perms = ($perm_mode eq 'read') ? 'VIEW_PURCHASE_ORDER' : 'CREATE_PURCHASE_ORDER';
3779 return ($li, $e->die_event) unless $e->allowed($perms, $org);
3781 } elsif(my $pl = $li->picklist) {
3782 $org = $pl->org_unit;
3783 my $perms = ($perm_mode eq 'read') ? 'VIEW_PICKLIST' : 'CREATE_PICKLIST';
3784 return ($li, $e->die_event) unless $e->allowed($perms, $org);
3787 return ($li, undef, $org);
3791 __PACKAGE__->register_method(
3792 method => "clone_distrib_form",
3793 api_name => "open-ils.acq.distribution_formula.clone",
3796 desc => q/Clone a distribution formula/,
3798 {desc => "Authentication token", type => "string"},
3799 {desc => "Original formula ID", type => 'integer'},
3800 {desc => "Name of new formula", type => 'string'},
3802 return => {desc => "ID of newly created formula"}
3806 sub clone_distrib_form {
3807 my($self, $client, $auth, $form_id, $new_name) = @_;
3809 my $e = new_editor("xact"=> 1, "authtoken" => $auth);
3810 return $e->die_event unless $e->checkauth;
3812 my $old_form = $e->retrieve_acq_distribution_formula($form_id) or return $e->die_event;
3813 return $e->die_event unless $e->allowed('ADMIN_ACQ_DISTRIB_FORMULA', $old_form->owner);
3815 my $new_form = Fieldmapper::acq::distribution_formula->new;
3817 $new_form->owner($old_form->owner);
3818 $new_form->name($new_name);
3819 $e->create_acq_distribution_formula($new_form) or return $e->die_event;
3821 my $entries = $e->search_acq_distribution_formula_entry({formula => $form_id});
3822 for my $entry (@$entries) {
3823 my $new_entry = Fieldmapper::acq::distribution_formula_entry->new;
3824 $new_entry->$_($entry->$_()) for $entry->real_fields;
3825 $new_entry->formula($new_form->id);
3826 $new_entry->clear_id;
3827 $e->create_acq_distribution_formula_entry($new_entry) or return $e->die_event;
3831 return $new_form->id;
3834 __PACKAGE__->register_method(
3835 method => 'add_li_to_po',
3836 api_name => 'open-ils.acq.purchase_order.add_lineitem',
3838 desc => q/Adds a lineitem to an existing purchase order/,
3840 {desc => 'Authentication token', type => 'string'},
3841 {desc => 'The purchase order id', type => 'number'},
3842 {desc => 'The lineitem ID (or an array of them)', type => 'mixed'},
3844 return => {desc => 'Streams a total versus completed counts object, event on error'}
3849 my($self, $conn, $auth, $po_id, $li_id) = @_;
3851 my $e = new_editor(authtoken => $auth, xact => 1);
3852 return $e->die_event unless $e->checkauth;
3854 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
3856 my $po = $e->retrieve_acq_purchase_order($po_id)
3857 or return $e->die_event;
3859 return $e->die_event unless
3860 $e->allowed('CREATE_PURCHASE_ORDER', $po->ordering_agency);
3862 unless ($po->state =~ /new|pending/) {
3864 return {success => 0, po => $po, error => 'bad-po-state'};
3869 if (ref $li_id eq "ARRAY") {
3870 $li_id = [ map { int($_) } @$li_id ];
3871 return $e->die_event(new OpenILS::Event("BAD_PARAMS")) unless @$li_id;
3873 $lis = $e->search_acq_lineitem({id => $li_id})
3874 or return $e->die_event;
3876 my $li = $e->retrieve_acq_lineitem(int($li_id))
3877 or return $e->die_event;
3881 foreach my $li (@$lis) {
3882 if ($li->state !~ /new|order-ready|pending-order/ or
3883 $li->purchase_order) {
3885 return {success => 0, li => $li, error => 'bad-li-state'};
3888 $li->provider($po->provider);
3889 $li->purchase_order($po_id);
3890 $li->state('pending-order');
3891 apply_default_copies($mgr, $po, $li->id) or return $e->die_event;
3892 update_lineitem($mgr, $li) or return $e->die_event;
3896 return {success => 1};
3899 __PACKAGE__->register_method(
3900 method => 'po_lineitems_no_copies',
3901 api_name => 'open-ils.acq.purchase_order.no_copy_lineitems.id_list',
3905 desc => q/Returns the set of lineitem IDs for a given PO that have no copies attached/,
3907 {desc => 'Authentication token', type => 'string'},
3908 {desc => 'The purchase order id', type => 'number'},
3910 return => {desc => 'Stream of lineitem IDs on success, event on error'}
3914 sub po_lineitems_no_copies {
3915 my ($self, $conn, $auth, $po_id) = @_;
3917 my $e = new_editor(authtoken => $auth);
3918 return $e->event unless $e->checkauth;
3920 # first check the view perms for LI's attached to this PO
3921 my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->event;
3922 return $e->event unless $e->allowed('VIEW_PURCHASE_ORDER', $po->ordering_agency);
3924 my $ids = $e->json_query({
3925 select => {jub => ['id']},
3926 from => {jub => {acqlid => {type => 'left'}}},
3928 '+jub' => {purchase_order => $po_id},
3929 '+acqlid' => {lineitem => undef}
3933 $conn->respond($_->{id}) for @$ids;
3937 __PACKAGE__->register_method(
3938 method => 'set_li_order_ident',
3939 api_name => 'open-ils.acq.lineitem.order_identifier.set',
3942 Given an existing lineitem_attr (typically a marc_attr), this will
3943 create a matching local_attr to store the name and value and mark
3944 the attr as the order_ident. Any existing local_attr marked as
3945 order_ident is removed.
3948 {desc => 'Authentication token', type => 'string'},
3949 {desc => q/Args object:
3950 source_attr_id : ID of the existing lineitem_attr to use as
3952 lineitem_id : lineitem id
3953 attr_name : name ('isbn', etc.) of a new marc_attr to add to
3954 the lineitem to use for the order ident
3955 attr_value : value for the new marc_attr
3956 no_apply_bre : if set, newly added attrs will not be applied
3957 to the lineitems' linked bib record/,
3960 return => {desc => q/Returns the attribute
3961 responsible for tracking the order identifier/}
3965 sub set_li_order_ident {
3966 my ($self, $conn, $auth, $args) = @_;
3970 my $source_attr_id = $args->{source_attr_id};
3972 my $e = new_editor(authtoken => $auth, xact => 1);
3973 return $e->die_event unless $e->checkauth;
3975 # fetch attr, LI, and check update permissions
3977 my $li_id = $args->{lineitem_id};
3979 if ($source_attr_id) {
3980 $source_attr = $e->retrieve_acq_lineitem_attr($source_attr_id)
3981 or return $e->die_event;
3982 $li_id = $source_attr->lineitem;
3985 my ($li, $evt, $perm_org) = fetch_and_check_li($e, $li_id, 'write');
3986 return $evt if $evt;
3988 return $e->die_event unless
3989 $e->allowed('ACQ_SET_LINEITEM_IDENTIFIER', $perm_org);
3991 # if needed, create a new marc attr for
3992 # the lineitem to represent the ident value
3994 ($source_attr, $evt) = apply_new_li_ident_attr(
3995 $e, $li, $perm_org, $args->{attr_name}, $args->{attr_value})
3996 unless $source_attr;
3998 return $evt if $evt;
4000 # remove the existing order_ident attribute if present
4002 my $old_attr = $e->search_acq_lineitem_attr({
4003 attr_type => 'lineitem_local_attr_definition',
4004 lineitem => $li->id,
4010 # if we already have an order_ident that matches the
4011 # source attr, there's nothing left to do.
4013 if ($old_attr->attr_name eq $source_attr->attr_name and
4014 $old_attr->attr_value eq $source_attr->attr_value) {
4020 # remove the old order_ident attribute
4021 $e->delete_acq_lineitem_attr($old_attr) or return $e->die_event;
4025 # make sure we have a local_attr_def to match the source attr def
4027 my $local_def = $e->search_acq_lineitem_local_attr_definition({
4028 code => $source_attr->attr_name
4033 $e->retrieve_acq_lineitem_attr_definition($source_attr->definition);
4034 $local_def = Fieldmapper::acq::lineitem_local_attr_definition->new;
4035 $local_def->code($source_def->code);
4036 $local_def->description($source_def->description);
4037 $local_def = $e->create_acq_lineitem_local_attr_definition($local_def)
4038 or return $e->die_event;
4041 # create the new order_ident local attr
4043 my $new_attr = Fieldmapper::acq::lineitem_attr->new;
4044 $new_attr->definition($local_def->id);
4045 $new_attr->attr_type('lineitem_local_attr_definition');
4046 $new_attr->lineitem($li->id);
4047 $new_attr->attr_name($source_attr->attr_name);
4048 $new_attr->attr_value($source_attr->attr_value);
4049 $new_attr->order_ident('t');
4051 $new_attr = $e->create_acq_lineitem_attr($new_attr)
4052 or return $e->die_event;
4059 # Given an isbn, issn, or upc, add the value to the lineitem marc.
4060 # Upon update, the value will be auto-magically represented as
4061 # a lineitem marc attr.
4062 # If the li is linked to a bib record and the user has the correct
4063 # permissions, update the bib record to match.
4064 sub apply_new_li_ident_attr {
4065 my ($e, $li, $perm_org, $attr_name, $attr_value) = @_;
4073 my $marc_field = MARC::Field->new(
4074 $tags{$attr_name}, '', '','a' => $attr_value);
4076 my $li_rec = MARC::Record->new_from_xml($li->marc, 'UTF-8', 'USMARC');
4077 $li_rec->insert_fields_ordered($marc_field);
4079 $li->marc(clean_marc($li_rec));
4080 $li->editor($e->requestor->id);
4081 $li->edit_time('now');
4083 $e->update_acq_lineitem($li) or return (undef, $e->die_event);
4085 my $source_attr = $e->search_acq_lineitem_attr({
4086 attr_name => $attr_name,
4087 attr_value => $attr_value,
4088 attr_type => 'lineitem_marc_attr_definition'
4091 if (!$source_attr) {
4092 $logger->error("ACQ lineitem update failed to produce a matching ".
4093 " marc attribute for $attr_name => $attr_value");
4094 return (undef, OpenILS::Event->new('INTERNAL_SERVER_ERROR'));
4097 return ($source_attr) unless
4099 $e->allowed('ACQ_ADD_LINEITEM_IDENTIFIER', $perm_org);
4101 # li is linked to a bib record and user has the update perms
4103 my $bre = $e->retrieve_biblio_record_entry($li->eg_bib_id);
4104 my $bre_marc = MARC::Record->new_from_xml($bre->marc, 'UTF-8', 'USMARC');
4105 $bre_marc->insert_fields_ordered($marc_field);
4107 $bre->marc(clean_marc($bre_marc));
4108 $bre->editor($e->requestor->id);
4109 $bre->edit_date('now');
4111 $e->update_biblio_record_entry($bre) or return (undef, $e->die_event);
4113 return ($source_attr);
4116 __PACKAGE__->register_method(
4117 method => 'li_existing_copies',
4118 api_name => 'open-ils.acq.lineitem.existing_copies.count',
4122 Returns the number of catalog copies (acp) which are children of
4123 the same bib record linked to by the given lineitem and which
4124 are owned at or below the lineitem context org unit.
4125 Copies with the following statuses are not counted:
4126 Lost, Missing, Discard Weed, and Lost and Paid.
4129 {desc => 'Authentication token', type => 'string'},
4130 {desc => 'Lineitem ID', type => 'number'}
4132 return => {desc => q/Count or event on error/}
4136 sub li_existing_copies {
4137 my ($self, $client, $auth, $li_id) = @_;
4138 my $e = new_editor("authtoken" => $auth);
4139 return $e->die_event unless $e->checkauth;
4141 my ($li, $evt, $org) = fetch_and_check_li($e, $li_id);
4144 # No fuzzy matching here (e.g. on ISBN). Only exact matches are supported.
4145 return 0 unless $li->eg_bib_id;
4147 my $counts = $e->json_query({
4148 select => {acp => [{
4150 transform => 'count',
4157 field => 'eg_copy_id',
4160 acn => {join => {bre => {}}}
4164 '+bre' => {id => $li->eg_bib_id},
4165 # don't count copies linked to the lineitem in question
4168 {lineitem => undef},
4169 {lineitem => {'<>' => $li_id}}
4173 owning_lib => $U->get_org_descendants($org)
4175 # NOTE: should the excluded copy statuses be an AOUS?
4176 '+acp' => {status => {'not in' => [3, 4, 13, 17]}}
4180 return $counts->[0]->{id};