1 package OpenILS::Application::Acq::BatchManager;
2 use OpenSRF::AppSession;
3 use OpenSRF::EX qw/:try/;
4 use strict; use warnings;
7 my($class, %args) = @_;
8 my $self = bless(\%args, $class);
16 purchase_order => undef,
22 $self->{ingest_queue} = [];
24 $self->throttle(5) unless $self->throttle;
30 $self->{conn} = $val if $val;
35 $self->{throttle} = $val if $val;
36 return $self->{throttle};
39 my($self, %other_args) = @_;
40 if($self->throttle and not %other_args) {
42 ($self->{args}->{progress} - $self->{last_respond_progress}) >= $self->throttle
45 $self->conn->respond({ %{$self->{args}}, %other_args });
46 $self->{last_respond_progress} = $self->{args}->{progress};
48 sub respond_complete {
49 my($self, %other_args) = @_;
51 $self->conn->respond_complete({ %{$self->{args}}, %other_args });
56 $self->{args}->{total} = $val if defined $val;
57 $self->{args}->{maximum} = $self->{args}->{total};
58 return $self->{args}->{total};
62 $self->{args}->{purchase_order} = $val if $val;
67 $self->{args}->{picklist} = $val if $val;
72 $self->{args}->{lid} += 1;
73 $self->{args}->{progress} += 1;
78 $self->{args}->{li} += 1;
79 $self->{args}->{progress} += 1;
84 $self->{args}->{copies} += 1;
85 $self->{args}->{progress} += 1;
90 $self->{args}->{bibs} += 1;
91 $self->{args}->{progress} += 1;
95 my($self, $amount) = @_;
96 $self->{args}->{debits_accrued} += $amount;
97 $self->{args}->{progress} += 1;
101 my($self, $editor) = @_;
102 $self->{editor} = $editor if defined $editor;
103 return $self->{editor};
107 $self->{args}->{complete} = 1;
112 my($self, $val) = @_;
113 $self->{ingest_ses} = $val if $val;
114 return $self->{ingest_ses};
117 sub push_ingest_queue {
118 my($self, $rec_id) = @_;
120 $self->ingest_ses(OpenSRF::AppSession->connect('open-ils.ingest'))
121 unless $self->ingest_ses;
123 my $req = $self->ingest_ses->request('open-ils.ingest.full.biblio.record', $rec_id);
125 push(@{$self->{ingest_queue}}, $req);
128 sub process_ingest_records {
130 return unless @{$self->{ingest_queue}};
132 for my $req (@{$self->{ingest_queue}}) {
136 $self->{args}->{indexed} += 1;
137 $self->{args}->{progress} += 1;
142 $self->ingest_ses->disconnect;
147 my($self, $org, $key, $val) = @_;
148 $self->{cache}->{$org} = {} unless $self->{cache}->{org};
149 $self->{cache}->{$org}->{$key} = $val if defined $val;
150 return $self->{cache}->{$org}->{$key};
154 package OpenILS::Application::Acq::Order;
155 use base qw/OpenILS::Application/;
156 use strict; use warnings;
157 # ----------------------------------------------------------------------------
158 # Break up each component of the order process and pieces into managable
159 # actions that can be shared across different workflows
160 # ----------------------------------------------------------------------------
162 use OpenSRF::Utils::Logger qw(:logger);
163 use OpenSRF::Utils::JSON;
164 use OpenILS::Utils::Fieldmapper;
165 use OpenILS::Utils::CStoreEditor q/:funcs/;
166 use OpenILS::Const qw/:const/;
167 use OpenSRF::EX q/:try/;
168 use OpenILS::Application::AppUtils;
169 use OpenILS::Application::Cat::BibCommon;
170 use OpenILS::Application::Cat::AssetCommon;
174 my $U = 'OpenILS::Application::AppUtils';
177 # ----------------------------------------------------------------------------
179 # ----------------------------------------------------------------------------
180 sub create_lineitem {
181 my($mgr, %args) = @_;
182 my $li = Fieldmapper::acq::lineitem->new;
183 $li->creator($mgr->editor->requestor->id);
184 $li->selector($li->creator);
185 $li->editor($li->creator);
186 $li->create_time('now');
187 $li->edit_time('now');
189 $li->$_($args{$_}) for keys %args;
191 return 0 unless update_picklist($mgr, $li->picklist);
194 return $mgr->editor->create_acq_lineitem($li);
197 sub update_lineitem {
199 $li->edit_time('now');
200 $li->editor($mgr->editor->requestor->id);
201 return $li if $mgr->editor->update_acq_lineitem($li);
206 sub delete_lineitem {
208 $li = $mgr->editor->retrieve_acq_lineitem($li) unless ref $li;
210 # delete the attached lineitem_details
211 my $lid_ids = $mgr->editor->search_acq_lineitem_detail({lineitem => $li->id}, {idlist=>1});
212 for my $lid_id (@$lid_ids) {
213 return 0 unless delete_lineitem_detail($mgr, $lid_id);
216 return $mgr->editor->delete_acq_lineitem($li);
219 # begins and commit transactions as it goes
220 sub create_lineitem_list_assets {
221 my($mgr, $li_ids) = @_;
222 # create the bibs/volumes/copies and ingest the records
223 for my $li_id (@$li_ids) {
224 $mgr->editor->xact_begin;
225 my $data = create_lineitem_assets($mgr, $li_id) or return undef;
226 $mgr->editor->xact_commit;
227 $mgr->push_ingest_queue($data->{li}->eg_bib_id) if $data->{new_bib};
230 $mgr->process_ingest_records;
234 # ----------------------------------------------------------------------------
235 # if all of the lineitem details for this lineitem have
236 # been received, mark the lineitem as received
237 # returns 1 on non-received, li on received, 0 on error
238 # ----------------------------------------------------------------------------
239 sub check_lineitem_received {
240 my($mgr, $li_id) = @_;
242 my $non_recv = $mgr->editor->search_acq_lineitem_detail(
243 {recv_time => undef, lineitem => $li_id}, {idlist=>1});
245 return 1 if @$non_recv;
247 my $li = $mgr->editor->retrieve_acq_lineitem($li_id);
248 $li->state('received');
249 return update_lineitem($mgr, $li);
252 sub receive_lineitem {
253 my($mgr, $li_id, $skip_complete_check) = @_;
254 my $li = $mgr->editor->retrieve_acq_lineitem($li_id) or return 0;
256 my $lid_ids = $mgr->editor->search_acq_lineitem_detail(
257 {lineitem => $li_id, recv_time => undef}, {idlist => 1});
259 for my $lid_id (@$lid_ids) {
260 receive_lineitem_detail($mgr, $lid_id, 1) or return 0;
264 $li->state('received');
265 update_lineitem($mgr, $li) or return 0;
266 return 1 if $skip_complete_check;
268 return check_purchase_order_received($mgr, $li->purchase_order);
271 sub rollback_receive_lineitem {
272 my($mgr, $li_id) = @_;
273 my $li = $mgr->editor->retrieve_acq_lineitem($li_id) or return 0;
275 my $lid_ids = $mgr->editor->search_acq_lineitem_detail(
276 {lineitem => $li_id, recv_time => {'!=' => undef}}, {idlist => 1});
278 for my $lid_id (@$lid_ids) {
279 rollback_receive_lineitem_detail($mgr, $lid_id, 1) or return 0;
283 $li->state('on-order');
284 return update_lineitem($mgr, $li);
287 # ----------------------------------------------------------------------------
289 # ----------------------------------------------------------------------------
290 sub create_lineitem_detail {
291 my($mgr, %args) = @_;
292 my $lid = Fieldmapper::acq::lineitem_detail->new;
293 $lid->$_($args{$_}) for keys %args;
294 $mgr->editor->create_acq_lineitem_detail($lid) or return 0;
297 # create some default values
298 unless($lid->barcode) {
299 my $pfx = $U->ou_ancestor_setting_value($lid->owning_lib, 'acq.tmp_barcode_prefix') || 'ACQ';
300 $lid->barcode($pfx.$lid->id);
303 unless($lid->cn_label) {
304 my $pfx = $U->ou_ancestor_setting_value($lid->owning_lib, 'acq.tmp_callnumber_prefix') || 'ACQ';
305 $lid->cn_label($pfx.$lid->id);
308 if(!$lid->location and my $loc = $U->ou_ancestor_setting_value($lid->owning_lib, 'acq.default_copy_location')) {
309 $lid->location($loc);
312 if(!$lid->circ_modifier and my $mod = get_default_circ_modifier($mgr, $lid->owning_lib)) {
313 $lid->circ_modifier($mod);
316 $mgr->editor->update_acq_lineitem_detail($lid) or return 0;
317 my $li = $mgr->editor->retrieve_acq_lineitem($lid->lineitem) or return 0;
318 update_lineitem($mgr, $li) or return 0;
322 sub get_default_circ_modifier {
324 my $mod = $mgr->cache($org, 'def_circ_mod');
326 $mod = $U->ou_ancestor_setting_value($org, 'acq.default_circ_modifier');
327 return $mgr->cache($org, 'def_circ_mod', $mod) if $mod;
331 sub delete_lineitem_detail {
333 $lid = $mgr->editor->retrieve_acq_lineitem_detail($lid) unless ref $lid;
334 return $mgr->editor->delete_acq_lineitem_detail($lid);
338 sub receive_lineitem_detail {
339 my($mgr, $lid_id, $skip_complete_check) = @_;
340 my $e = $mgr->editor;
342 my $lid = $e->retrieve_acq_lineitem_detail([
346 acqlid => ['fund_debit']
351 return 1 if $lid->recv_time;
353 $lid->recv_time('now');
354 $e->update_acq_lineitem_detail($lid) or return 0;
356 my $copy = $e->retrieve_asset_copy($lid->eg_copy_id) or return 0;
357 $copy->status(OILS_COPY_STATUS_IN_PROCESS);
358 $copy->edit_date('now');
359 $copy->editor($e->requestor->id);
360 $e->update_asset_copy($copy) or return 0;
362 if($lid->fund_debit) {
363 $lid->fund_debit->encumbrance('f');
364 $e->update_acq_fund_debit($lid->fund_debit) or return 0;
369 return 1 if $skip_complete_check;
371 my $li = check_lineitem_received($mgr, $lid->lineitem) or return 0;
372 return 1 if $li == 1; # li not received
374 return check_purchase_order_received($mgr, $li->purchase_order);
378 sub rollback_receive_lineitem_detail {
379 my($mgr, $lid_id) = @_;
380 my $e = $mgr->editor;
382 my $lid = $e->retrieve_acq_lineitem_detail([
386 acqlid => ['fund_debit']
391 return 1 unless $lid->recv_time;
393 $lid->clear_recv_time;
394 $e->update_acq_lineitem_detail($lid) or return 0;
396 my $copy = $e->retrieve_asset_copy($lid->eg_copy_id) or return 0;
397 $copy->status(OILS_COPY_STATUS_ON_ORDER);
398 $copy->edit_date('now');
399 $copy->editor($e->requestor->id);
400 $e->update_asset_copy($copy) or return 0;
402 if($lid->fund_debit) {
403 $lid->fund_debit->encumbrance('t');
404 $e->update_acq_fund_debit($lid->fund_debit) or return 0;
411 # ----------------------------------------------------------------------------
413 # ----------------------------------------------------------------------------
414 sub set_lineitem_attr {
415 my($mgr, %args) = @_;
416 my $attr_type = $args{attr_type};
418 # first, see if it's already set. May just need to overwrite it
419 my $attr = $mgr->editor->search_acq_lineitem_attr({
420 lineitem => $args{lineitem},
421 attr_type => $args{attr_type},
422 attr_name => $args{attr_name}
426 $attr->attr_value($args{attr_value});
427 return $attr if $mgr->editor->update_acq_lineitem_attr($attr);
432 $attr = Fieldmapper::acq::lineitem_attr->new;
433 $attr->$_($args{$_}) for keys %args;
435 unless($attr->definition) {
436 my $find = "search_acq_$attr_type";
437 my $attr_def_id = $mgr->editor->$find({code => $attr->attr_name}, {idlist=>1})->[0] or return 0;
438 $attr->definition($attr_def_id);
440 return $mgr->editor->create_acq_lineitem_attr($attr);
446 my $attrs = $li->attributes;
447 my ($marc_estimated, $local_estimated, $local_actual, $prov_estimated, $prov_actual);
449 for my $attr (@$attrs) {
450 if($attr->attr_name eq 'estimated_price') {
451 $local_estimated = $attr->attr_value
452 if $attr->attr_type eq 'lineitem_local_attr_definition';
453 $prov_estimated = $attr->attr_value
454 if $attr->attr_type eq 'lineitem_prov_attr_definition';
455 $marc_estimated = $attr->attr_value
456 if $attr->attr_type eq 'lineitem_marc_attr_definition';
458 } elsif($attr->attr_name eq 'actual_price') {
459 $local_actual = $attr->attr_value
460 if $attr->attr_type eq 'lineitem_local_attr_definition';
461 $prov_actual = $attr->attr_value
462 if $attr->attr_type eq 'lineitem_prov_attr_definition';
466 return ($local_actual, 1) if $local_actual;
467 return ($prov_actual, 2) if $prov_actual;
468 return ($local_estimated, 1) if $local_estimated;
469 return ($prov_estimated, 2) if $prov_estimated;
470 return ($marc_estimated, 3);
474 # ----------------------------------------------------------------------------
476 # ----------------------------------------------------------------------------
477 sub create_lineitem_debits {
478 my($mgr, $li, $price, $ptype) = @_;
480 ($price, $ptype) = get_li_price($li) unless $price;
483 $mgr->editor->event(OpenILS::Event->new('ACQ_LINEITEM_NO_PRICE', payload => $li->id));
484 $mgr->editor->rollback;
488 unless($li->provider) {
489 $mgr->editor->event(OpenILS::Event->new('ACQ_LINEITEM_NO_PROVIDER', payload => $li->id));
490 $mgr->editor->rollback;
494 my $lid_ids = $mgr->editor->search_acq_lineitem_detail(
495 {lineitem => $li->id},
499 for my $lid_id (@$lid_ids) {
501 my $lid = $mgr->editor->retrieve_acq_lineitem_detail([
504 flesh_fields => {acqlid => ['fund']}
508 create_lineitem_detail_debit($mgr, $li, $lid, $price, $ptype) or return 0;
517 # ptype 1=local, 2=provider, 3=marc
518 sub create_lineitem_detail_debit {
519 my($mgr, $li, $lid, $price, $ptype) = @_;
521 unless(ref $li and ref $li->provider) {
522 $li = $mgr->editor->retrieve_acq_lineitem([
525 flesh_fields => {jub => ['provider']},
530 unless(ref $lid and ref $lid->fund) {
531 $lid = $mgr->editor->retrieve_acq_lineitem_detail([
534 flesh_fields => {acqlid => ['fund']}
539 my $ctype = $lid->fund->currency_type;
542 if($ptype == 2) { # price from vendor
543 $ctype = $li->provider->currency_type;
544 $amount = currency_conversion($mgr, $ctype, $lid->fund->currency_type, $price);
547 my $debit = create_fund_debit(
549 fund => $lid->fund->id,
550 origin_amount => $price,
551 origin_currency_type => $ctype,
555 $lid->fund_debit($debit->id);
556 $lid->fund($lid->fund->id);
557 $mgr->editor->update_acq_lineitem_detail($lid) or return 0;
562 # ----------------------------------------------------------------------------
564 # ----------------------------------------------------------------------------
565 sub create_fund_debit {
566 my($mgr, %args) = @_;
567 my $debit = Fieldmapper::acq::fund_debit->new;
568 $debit->debit_type('purchase');
569 $debit->encumbrance('t');
570 $debit->$_($args{$_}) for keys %args;
571 $mgr->add_debit($debit->amount);
572 return $mgr->editor->create_acq_fund_debit($debit);
575 sub currency_conversion {
576 my($mgr, $src_currency, $dest_currency, $amount) = @_;
577 my $result = $mgr->editor->json_query(
578 {from => ['acq.exchange_ratio', $src_currency, $dest_currency, $amount]});
579 return $result->[0]->{'acq.exchange_ratio'};
583 # ----------------------------------------------------------------------------
585 # ----------------------------------------------------------------------------
586 sub create_picklist {
587 my($mgr, %args) = @_;
588 my $picklist = Fieldmapper::acq::picklist->new;
589 $picklist->creator($mgr->editor->requestor->id);
590 $picklist->owner($picklist->creator);
591 $picklist->editor($picklist->creator);
592 $picklist->create_time('now');
593 $picklist->edit_time('now');
594 $picklist->org_unit($mgr->editor->requestor->ws_ou);
595 $picklist->owner($mgr->editor->requestor->id);
596 $picklist->$_($args{$_}) for keys %args;
597 $mgr->picklist($picklist);
598 return $mgr->editor->create_acq_picklist($picklist);
601 sub update_picklist {
602 my($mgr, $picklist) = @_;
603 $picklist = $mgr->editor->retrieve_acq_picklist($picklist) unless ref $picklist;
604 $picklist->edit_time('now');
605 $picklist->editor($mgr->editor->requestor->id);
606 $mgr->picklist($picklist);
607 return $picklist if $mgr->editor->update_acq_picklist($picklist);
611 sub delete_picklist {
612 my($mgr, $picklist) = @_;
613 $picklist = $mgr->editor->retrieve_acq_picklist($picklist) unless ref $picklist;
615 # delete all 'new' lineitems
616 my $lis = $mgr->editor->search_acq_lineitem({picklist => $picklist->id, state => 'new'});
618 return 0 unless delete_lineitem($mgr, $li);
621 # detach all non-'new' lineitems
622 $lis = $mgr->editor->search_acq_lineitem({picklist => $picklist->id, state => {'!=' => 'new'}});
625 return 0 unless update_lineitem($mgr, $li);
628 # remove any picklist-specific object perms
629 my $ops = $mgr->editor->search_permission_usr_object_perm_map({object_type => 'acqpl', object_id => ''.$picklist->id});
631 return 0 unless $mgr->editor->delete_usr_object_perm_map($op);
634 return $mgr->editor->delete_acq_picklist($picklist);
637 # ----------------------------------------------------------------------------
639 # ----------------------------------------------------------------------------
640 sub update_purchase_order {
642 $po = $mgr->editor->retrieve_acq_purchase_order($po) unless ref $po;
643 $po->editor($mgr->editor->requestor->id);
644 $po->edit_time('now');
645 $mgr->purchase_order($po);
646 return $po if $mgr->editor->update_acq_purchase_order($po);
650 sub create_purchase_order {
651 my($mgr, %args) = @_;
652 my $po = Fieldmapper::acq::purchase_order->new;
653 $po->creator($mgr->editor->requestor->id);
654 $po->editor($mgr->editor->requestor->id);
655 $po->owner($mgr->editor->requestor->id);
656 $po->edit_time('now');
657 $po->create_time('now');
658 $po->ordering_agency($mgr->editor->requestor->ws_ou);
659 $po->$_($args{$_}) for keys %args;
660 $mgr->purchase_order($po);
661 return $mgr->editor->create_acq_purchase_order($po);
664 # ----------------------------------------------------------------------------
665 # if all of the lineitems for this PO are received,
666 # mark the PO as received
667 # ----------------------------------------------------------------------------
668 sub check_purchase_order_received {
669 my($mgr, $po_id) = @_;
671 my $non_recv_li = $mgr->editor->search_acq_lineitem(
672 { purchase_order => $po_id,
673 state => {'!=' => 'received'}
676 return 1 if @$non_recv_li;
678 my $po = $mgr->editor->retrieve_acq_purchase_order($po_id);
679 $po->state('received');
680 return update_purchase_order($mgr, $po);
684 # ----------------------------------------------------------------------------
685 # Bib, Callnumber, and Copy data
686 # ----------------------------------------------------------------------------
688 sub create_lineitem_assets {
689 my($mgr, $li_id) = @_;
692 my $li = $mgr->editor->retrieve_acq_lineitem([
695 flesh_fields => {jub => ['purchase_order', 'attributes']}
699 # -----------------------------------------------------------------
700 # first, create the bib record if necessary
701 # -----------------------------------------------------------------
703 unless($li->eg_bib_id) {
704 create_bib($mgr, $li) or return 0;
708 my $li_details = $mgr->editor->search_acq_lineitem_detail({lineitem => $li_id}, {idlist=>1});
710 # -----------------------------------------------------------------
711 # for each lineitem_detail, create the volume if necessary, create
712 # a copy, and link them all together.
713 # -----------------------------------------------------------------
714 for my $lid_id (@{$li_details}) {
716 my $lid = $mgr->editor->retrieve_acq_lineitem_detail($lid_id) or return 0;
717 next if $lid->eg_copy_id;
719 my $org = $lid->owning_lib;
720 my $label = $lid->cn_label;
721 my $bibid = $li->eg_bib_id;
723 my $volume = $mgr->cache($org, "cn.$bibid.$label");
725 $volume = create_volume($mgr, $li, $lid) or return 0;
726 $mgr->cache($org, "cn.$bibid.$label", $volume);
728 create_copy($mgr, $volume, $lid) or return 0;
731 return { li => $li, new_bib => $new_bib };
737 my $record = OpenILS::Application::Cat::BibCommon->biblio_record_xml_import(
742 1, # override tcn collisions
744 undef # $rec->bib_source
747 if($U->event_code($record)) {
748 $mgr->editor->event($record);
749 $mgr->editor->rollback;
753 $li->eg_bib_id($record->id);
755 return update_lineitem($mgr, $li);
759 my($mgr, $li, $lid) = @_;
762 OpenILS::Application::Cat::AssetCommon->find_or_create_volume(
770 $mgr->editor->event($evt);
778 my($mgr, $volume, $lid) = @_;
779 my $copy = Fieldmapper::asset::copy->new;
781 $copy->loan_duration(2);
782 $copy->fine_level(2);
783 $copy->status(OILS_COPY_STATUS_ON_ORDER);
784 $copy->barcode($lid->barcode);
785 $copy->location($lid->location);
786 $copy->call_number($volume->id);
787 $copy->circ_lib($volume->owning_lib);
788 $copy->circ_modifier($lid->circ_modifier);
790 my $evt = OpenILS::Application::Cat::AssetCommon->create_copy($mgr->editor, $volume, $copy);
792 $mgr->editor->event($evt);
797 $lid->eg_copy_id($copy->id);
798 $mgr->editor->update_acq_lineitem_detail($lid) or return 0;
806 # ----------------------------------------------------------------------------
807 # Workflow: Build a selection list from a Z39.50 search
808 # ----------------------------------------------------------------------------
810 __PACKAGE__->register_method(
812 api_name => 'open-ils.acq.picklist.search.z3950',
815 desc => 'Performs a z3950 federated search and creates a picklist and associated lineitems',
817 {desc => 'Authentication token', type => 'string'},
818 {desc => 'Search definition', type => 'object'},
819 {desc => 'Picklist name, optional', type => 'string'},
825 my($self, $conn, $auth, $search, $name, $options) = @_;
826 my $e = new_editor(authtoken=>$auth);
827 return $e->event unless $e->checkauth;
828 return $e->event unless $e->allowed('CREATE_PICKLIST');
830 $search->{limit} ||= 10;
833 my $ses = OpenSRF::AppSession->create('open-ils.search');
834 my $req = $ses->request('open-ils.search.z3950.search_class', $auth, $search);
839 while(my $resp = $req->recv(timeout=>60)) {
842 my $e = new_editor(requestor=>$e->requestor, xact=>1);
843 $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
844 $picklist = zsearch_build_pl($mgr, $name);
848 my $result = $resp->content;
849 my $count = $result->{count};
850 $mgr->total( (($count < $search->{limit}) ? $count : $search->{limit})+1 );
852 for my $rec (@{$result->{records}}) {
854 my $li = create_lineitem($mgr,
855 picklist => $picklist->id,
856 source_label => $result->{service},
857 marc => $rec->{marcxml},
858 eg_bib_id => $rec->{bibid}
861 if($$options{respond_li}) {
862 $li->attributes($mgr->editor->search_acq_lineitem_attr({lineitem => $li->id}))
863 if $$options{flesh_attrs};
864 $li->clear_marc if $$options{clear_marc};
865 $mgr->respond(lineitem => $li);
872 $mgr->editor->commit;
873 return $mgr->respond_complete;
876 sub zsearch_build_pl {
877 my($mgr, $name) = @_;
880 my $picklist = $mgr->editor->search_acq_picklist({
881 owner => $mgr->editor->requestor->id,
885 if($name eq '' and $picklist) {
886 return 0 unless delete_picklist($mgr, $picklist);
890 return update_picklist($mgr, $picklist) if $picklist;
891 return create_picklist($mgr, name => $name);
895 # ----------------------------------------------------------------------------
896 # Workflow: Build a selection list / PO by importing a batch of MARC records
897 # ----------------------------------------------------------------------------
899 __PACKAGE__->register_method(
900 method => 'upload_records',
901 api_name => 'open-ils.acq.process_upload_records',
906 my($self, $conn, $auth, $key) = @_;
908 my $e = new_editor(authtoken => $auth, xact => 1);
909 return $e->die_event unless $e->checkauth;
910 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
912 my $cache = OpenSRF::Utils::Cache->new;
914 my $data = $cache->get_cache("vandelay_import_spool_$key");
915 my $purpose = $data->{purpose};
916 my $filename = $data->{path};
917 my $provider = $data->{provider};
918 my $picklist = $data->{picklist};
919 my $create_po = $data->{create_po};
920 my $ordering_agency = $data->{ordering_agency};
921 my $create_assets = $data->{create_assets};
925 unless(-r $filename) {
926 $logger->error("unable to read MARC file $filename");
928 return OpenILS::Event->new('FILE_UPLOAD_ERROR', payload => {filename => $filename});
931 $provider = $e->retrieve_acq_provider($provider) or return $e->die_event;
934 $picklist = $e->retrieve_acq_picklist($picklist) or return $e->die_event;
935 if($picklist->owner != $e->requestor->id) {
936 return $e->die_event unless
937 $e->allowed('CREATE_PICKLIST', $picklist->org_unit, $picklist);
942 $po = create_purchase_order($mgr,
943 ordering_agency => $ordering_agency,
944 provider => $provider->id
945 ) or return $mgr->editor->die_event;
948 $logger->info("acq processing MARC file=$filename");
950 my $marctype = 'USMARC'; # ?
951 my $batch = new MARC::Batch ($marctype, $filename);
968 $logger->warn("Proccessing of record $count in set $key failed with error $err. Skipping this record");
975 ($xml = $r->as_xml_record()) =~ s/\n//sog;
976 $xml =~ s/^<\?xml.+\?\s*>//go;
977 $xml =~ s/>\s+</></go;
978 $xml =~ s/\p{Cc}//go;
979 $xml = $U->entityize($xml);
980 $xml =~ s/[\x00-\x1f]//go;
984 $logger->warn("Proccessing XML of record $count in set $key failed with error $err. Skipping this record");
987 next if $err or not $xml;
990 source_label => $provider->code,
991 provider => $provider->id,
995 $args{picklist} = $picklist->id if $picklist;
997 $args{purchase_order} = $po->id;
998 $args{state} = 'on-order';
1001 my $li = create_lineitem($mgr, %args) or return $mgr->editor->die_event;
1003 $li->provider($provider); # flesh it, we'll need it later
1005 import_lineitem_details($mgr, $ordering_agency, $li) or return $mgr->editor->die_event;
1008 push(@li_list, $li->id);
1014 $cache->delete_cache('vandelay_import_spool_' . $key);
1016 if($create_assets) {
1017 create_lineitem_list_assets($mgr, \@li_list) or return $e->die_event;
1020 return $mgr->respond_complete;
1023 sub import_lineitem_details {
1024 my($mgr, $ordering_agency, $li) = @_;
1026 my $holdings = $mgr->editor->json_query({from => ['acq.extract_provider_holding_data', $li->id]});
1027 return 1 unless @$holdings;
1028 my $org_path = $U->get_org_ancestors($ordering_agency);
1029 $org_path = [ reverse (@$org_path) ];
1034 # create a lineitem detail for each copy in the data
1036 my $compiled = extract_lineitem_detail_data($mgr, $org_path, $holdings, $idx);
1037 last unless defined $compiled;
1038 return 0 unless $compiled;
1040 # this takes the price of the last copy and uses it as the lineitem price
1041 # need to determine if a given record would include different prices for the same item
1042 $price = $$compiled{price};
1044 for(1..$$compiled{quantity}) {
1045 my $lid = create_lineitem_detail($mgr,
1046 lineitem => $li->id,
1047 owning_lib => $$compiled{owning_lib},
1048 cn_label => $$compiled{call_number},
1049 fund => $$compiled{fund},
1050 circ_modifier => $$compiled{circ_modifier},
1051 note => $$compiled{note},
1052 location => $$compiled{copy_location}
1060 # set the price attr so we'll know the source of the price
1063 attr_name => 'estimated_price',
1064 attr_type => 'lineitem_local_attr_definition',
1065 attr_value => $price,
1069 # if we're creating a purchase order, create the debits
1070 if($li->purchase_order) {
1071 create_lineitem_debits($mgr, $li, $price, 2) or return 0;
1078 # return hash on success, 0 on error, undef on no more holdings
1079 sub extract_lineitem_detail_data {
1080 my($mgr, $org_path, $holdings, $index) = @_;
1082 my @data_list = grep { $_->{holding} eq $index } @$holdings;
1083 return undef unless @data_list;
1085 my %compiled = map { $_->{attr} => $_->{data} } @data_list;
1086 my $base_org = $$org_path[0];
1090 $logger->error("Item import extraction error: $msg");
1091 $logger->error('Holdings Data: ' . OpenSRF::Utils::JSON->perl2JSON(\%compiled));
1092 $mgr->editor->rollback;
1093 $mgr->editor->event(OpenILS::Event->new('ACQ_IMPORT_ERROR', payload => $msg));
1097 $compiled{quantity} ||= 1;
1099 # ---------------------------------------------------------------------
1101 my $code = $compiled{fund_code};
1102 return $killme->('no fund code provided') unless $code;
1104 my $fund = $mgr->cache($base_org, "fund.$code");
1106 # search up the org tree for the most appropriate fund
1107 for my $org (@$org_path) {
1108 $fund = $mgr->editor->search_acq_fund(
1109 {org => $org, code => $code, year => DateTime->now->year}, {idlist => 1})->[0];
1113 return $killme->("no fund with code $code at orgs [@$org_path]") unless $fund;
1114 $compiled{fund} = $fund;
1115 $mgr->cache($base_org, "fund.$code", $fund);
1118 # ---------------------------------------------------------------------
1120 my $sn = $compiled{owning_lib};
1121 return $killme->('no owning_lib defined') unless $sn;
1123 $mgr->cache($base_org, "orgsn.$sn") ||
1124 $mgr->editor->search_actor_org_unit({shortname => $sn}, {idlist => 1})->[0];
1125 return $killme->("invalid owning_lib defined: $sn") unless $org_id;
1126 $compiled{owning_lib} = $org_id;
1127 $mgr->cache($$org_path[0], "orgsn.$sn", $org_id);
1130 # ---------------------------------------------------------------------
1133 $code = $compiled{circ_modifier};
1137 $mod = $mgr->cache($base_org, "mod.$code") ||
1138 $mgr->editor->retrieve_config_circ_modifier($code);
1139 return $killme->("invlalid circ_modifier $code") unless $mod;
1140 $mgr->cache($base_org, "mod.$code", $mod);
1144 $mod = get_default_circ_modifier($mgr, $base_org)
1145 or return $killme->('no circ_modifier defined');
1148 $compiled{circ_modifier} = $mod;
1151 # ---------------------------------------------------------------------
1153 my $name = $compiled{copy_location};
1154 return $killme->('no copy_location defined') unless $name;
1155 my $loc = $mgr->cache($base_org, "copy_loc.$name");
1157 for my $org (@$org_path) {
1158 $loc = $mgr->editor->search_asset_copy_location(
1159 {owning_lib => $org, name => $name}, {idlist => 1})->[0];
1163 return $killme->("Invalid copy location $name") unless $loc;
1164 $compiled{copy_location} = $loc;
1165 $mgr->cache($base_org, "copy_loc.$name", $loc);
1172 # ----------------------------------------------------------------------------
1173 # Workflow: Given an existing purchase order, import/create the bibs,
1174 # callnumber and copy objects
1175 # ----------------------------------------------------------------------------
1177 __PACKAGE__->register_method(
1178 method => 'create_po_assets',
1179 api_name => 'open-ils.acq.purchase_order.assets.create',
1181 desc => q/Creates assets for each lineitem in the purchase order/,
1183 {desc => 'Authentication token', type => 'string'},
1184 {desc => 'The purchase order id', type => 'number'},
1186 return => {desc => 'Streams a total versus completed counts object, event on error'}
1190 sub create_po_assets {
1191 my($self, $conn, $auth, $po_id) = @_;
1193 my $e = new_editor(authtoken=>$auth, xact=>1);
1194 return $e->die_event unless $e->checkauth;
1195 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1197 my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->die_event;
1198 return $e->die_event unless $e->allowed('IMPORT_PURCHASE_ORDER_ASSETS', $po->ordering_agency);
1200 my $li_ids = $e->search_acq_lineitem({purchase_order => $po_id}, {idlist => 1});
1202 # it's ugly, but it's fast. Get the total count of lineitem detail objects to process
1203 my $lid_total = $e->json_query({
1204 select => { acqlid => [{aggregate => 1, transform => 'count', column => 'id'}] },
1210 join => {acqpo => {fkey => 'purchase_order', field => 'id'}}
1214 where => {'+acqpo' => {id => $po_id}}
1217 $mgr->total(scalar(@$li_ids) + $lid_total);
1219 create_lineitem_list_assets($mgr, $li_ids) or return $e->die_event;
1222 update_purchase_order($mgr, $po) or return $e->die_event;
1225 return $mgr->respond_complete;
1230 __PACKAGE__->register_method(
1231 method => 'create_purchase_order_api',
1232 api_name => 'open-ils.acq.purchase_order.create',
1234 desc => 'Creates a new purchase order',
1236 {desc => 'Authentication token', type => 'string'},
1237 {desc => 'purchase_order to create', type => 'object'}
1239 return => {desc => 'The purchase order id, Event on failure'}
1243 sub create_purchase_order_api {
1244 my($self, $conn, $auth, $po, $args) = @_;
1247 my $e = new_editor(xact=>1, authtoken=>$auth);
1248 return $e->die_event unless $e->checkauth;
1249 return $e->die_event unless $e->allowed('CREATE_PURCHASE_ORDER', $po->ordering_agency);
1250 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1253 my %pargs = (ordering_agency => $e->requestor->ws_ou);
1254 $pargs{provider} = $po->provider if $po->provider;
1255 $po = create_purchase_order($mgr, %pargs) or return $e->die_event;
1257 my $li_ids = $$args{lineitems};
1261 for my $li_id (@$li_ids) {
1263 my $li = $e->retrieve_acq_lineitem([
1265 {flesh => 1, flesh_fields => {jub => ['attributes']}}
1266 ]) or return $e->die_event;
1268 $li->provider($po->provider);
1269 $li->purchase_order($po->id);
1270 update_lineitem($mgr, $li) or return $e->die_event;
1273 create_lineitem_debits($mgr, $li) or return $e->die_event;
1277 # commit before starting the asset creation
1280 if($li_ids and $$args{create_assets}) {
1281 create_lineitem_list_assets($mgr, $li_ids) or return $e->die_event;
1284 return $mgr->respond_complete;
1288 __PACKAGE__->register_method(
1289 method => 'lineitem_detail_CUD_batch',
1290 api_name => 'open-ils.acq.lineitem_detail.cud.batch',
1293 desc => q/Creates a new purchase order line item detail.
1294 Additionally creates the associated fund_debit/,
1296 {desc => 'Authentication token', type => 'string'},
1297 {desc => 'List of lineitem_details to create', type => 'array'},
1299 return => {desc => 'Streaming response of current position in the array'}
1303 sub lineitem_detail_CUD_batch {
1304 my($self, $conn, $auth, $li_details) = @_;
1306 my $e = new_editor(xact=>1, authtoken=>$auth);
1307 return $e->die_event unless $e->checkauth;
1308 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1312 $mgr->total(scalar(@$li_details));
1316 for my $lid (@$li_details) {
1318 my $li = $li_cache{$lid->lineitem} || $e->retrieve_acq_lineitem($lid->lineitem);
1321 create_lineitem_detail($mgr, %{$lid->to_bare_hash}) or return $e->die_event;
1323 } elsif($lid->ischanged) {
1324 $e->update_acq_lineitem_detail($lid) or return $e->die_event;
1326 } elsif($lid->isdeleted) {
1327 delete_lineitem_detail($mgr, $lid) or return $e->die_event;
1330 $mgr->respond(li => $li);
1331 $li_cache{$lid->lineitem} = $li;
1335 return $mgr->respond_complete;
1339 __PACKAGE__->register_method(
1340 method => 'receive_po_api',
1341 api_name => 'open-ils.acq.purchase_order.receive'
1344 sub receive_po_api {
1345 my($self, $conn, $auth, $po_id) = @_;
1346 my $e = new_editor(xact => 1, authtoken => $auth);
1347 return $e->die_event unless $e->checkauth;
1348 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1350 my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->die_event;
1351 return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency);
1353 my $li_ids = $e->search_acq_lineitem({purchase_order => $po_id}, {idlist => 1});
1355 for my $li_id (@$li_ids) {
1356 receive_lineitem($mgr, $li_id) or return $e->die_event;
1360 $po->state('received');
1361 update_purchase_order($mgr, $po) or return $e->die_event;
1364 return $mgr->respond_complete;
1368 __PACKAGE__->register_method(
1369 method => 'receive_lineitem_detail_api',
1370 api_name => 'open-ils.acq.lineitem_detail.receive',
1372 desc => 'Mark a lineitem_detail as received',
1374 {desc => 'Authentication token', type => 'string'},
1375 {desc => 'lineitem detail ID', type => 'number'}
1377 return => {desc => '1 on success, Event on error'}
1381 sub receive_lineitem_detail_api {
1382 my($self, $conn, $auth, $lid_id) = @_;
1384 my $e = new_editor(xact=>1, authtoken=>$auth);
1385 return $e->die_event unless $e->checkauth;
1386 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1388 my $lid = $e->retrieve_acq_lineitem_detail([
1392 acqlid => ['lineitem'],
1393 jub => ['purchase_order']
1398 return $e->die_event unless $e->allowed(
1399 'RECEIVE_PURCHASE_ORDER', $lid->lineitem->purchase_order->ordering_agency);
1401 receive_lineitem_detail($mgr, $lid_id) or return $e->die_event;
1406 __PACKAGE__->register_method(
1407 method => 'receive_lineitem_api',
1408 api_name => 'open-ils.acq.lineitem.receive',
1410 desc => 'Mark a lineitem as received',
1412 {desc => 'Authentication token', type => 'string'},
1413 {desc => 'lineitem detail ID', type => 'number'}
1415 return => {desc => '1 on success, Event on error'}
1419 sub receive_lineitem_api {
1420 my($self, $conn, $auth, $li_id) = @_;
1422 my $e = new_editor(xact=>1, authtoken=>$auth);
1423 return $e->die_event unless $e->checkauth;
1424 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1426 my $li = $e->retrieve_acq_lineitem([
1430 jub => ['purchase_order']
1433 ]) or return $e->die_event;
1435 return $e->die_event unless $e->allowed(
1436 'RECEIVE_PURCHASE_ORDER', $li->purchase_order->ordering_agency);
1438 receive_lineitem($mgr, $li_id) or return $e->die_event;
1444 __PACKAGE__->register_method(
1445 method => 'rollback_receive_po_api',
1446 api_name => 'open-ils.acq.purchase_order.receive.rollback'
1449 sub rollback_receive_po_api {
1450 my($self, $conn, $auth, $po_id) = @_;
1451 my $e = new_editor(xact => 1, authtoken => $auth);
1452 return $e->die_event unless $e->checkauth;
1453 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1455 my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->die_event;
1456 return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency);
1458 my $li_ids = $e->search_acq_lineitem({purchase_order => $po_id}, {idlist => 1});
1460 for my $li_id (@$li_ids) {
1461 rollback_receive_lineitem($mgr, $li_id) or return $e->die_event;
1465 $po->state('on-order');
1466 update_purchase_order($mgr, $po) or return $e->die_event;
1469 return $mgr->respond_complete;
1473 __PACKAGE__->register_method(
1474 method => 'rollback_receive_lineitem_detail_api',
1475 api_name => 'open-ils.acq.lineitem_detail.receive.rollback',
1477 desc => 'Mark a lineitem_detail as received',
1479 {desc => 'Authentication token', type => 'string'},
1480 {desc => 'lineitem detail ID', type => 'number'}
1482 return => {desc => '1 on success, Event on error'}
1486 sub rollback_receive_lineitem_detail_api {
1487 my($self, $conn, $auth, $lid_id) = @_;
1489 my $e = new_editor(xact=>1, authtoken=>$auth);
1490 return $e->die_event unless $e->checkauth;
1491 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1493 my $lid = $e->retrieve_acq_lineitem_detail([
1497 acqlid => ['lineitem'],
1498 jub => ['purchase_order']
1502 my $li = $lid->lineitem;
1503 my $po = $li->purchase_order;
1505 return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency);
1506 rollback_receive_lineitem_detail($mgr, $lid_id) or return $e->die_event;
1508 $li->state('on-order');
1509 $po->state('on-order');
1510 udpate_lineitem($mgr, $li) or return $e->die_event;
1511 udpate_purchase_order($mgr, $po) or return $e->die_event;
1517 __PACKAGE__->register_method(
1518 method => 'rollback_receive_lineitem_api',
1519 api_name => 'open-ils.acq.lineitem.receive.rollback',
1521 desc => 'Mark a lineitem as received',
1523 {desc => 'Authentication token', type => 'string'},
1524 {desc => 'lineitem detail ID', type => 'number'}
1526 return => {desc => '1 on success, Event on error'}
1530 sub rollback_receive_lineitem_api {
1531 my($self, $conn, $auth, $li_id) = @_;
1533 my $e = new_editor(xact=>1, authtoken=>$auth);
1534 return $e->die_event unless $e->checkauth;
1535 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1537 my $li = $e->retrieve_acq_lineitem_detail([
1541 jub => ['purchase_order']
1545 my $po = $li->purchase_order;
1547 return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency);
1549 rollback_receive_lineitem($mgr, $li_id) or return $e->die_event;
1551 $po->state('on-order');
1552 update_purchase_order($mgr, $po) or return $e->die_event;
1559 __PACKAGE__->register_method(
1560 method => 'set_lineitem_price_api',
1561 api_name => 'open-ils.acq.lineitem.price.set',
1563 desc => 'Set lineitem price. If debits already exist, update them as well',
1565 {desc => 'Authentication token', type => 'string'},
1566 {desc => 'lineitem ID', type => 'number'}
1568 return => {desc => 'status blob, Event on error'}
1572 sub set_lineitem_price_api {
1573 my($self, $conn, $auth, $li_id, $price, $currency) = @_;
1575 my $e = new_editor(xact=>1, authtoken=>$auth);
1576 return $e->die_event unless $e->checkauth;
1577 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1581 my $li = $e->retrieve_acq_lineitem($li_id) or return $e->die_event;
1583 # update the local attr for estimated price
1586 attr_name => 'estimated_price',
1587 attr_type => 'lineitem_local_attr_definition',
1588 attr_value => $price,
1590 ) or return $e->die_event;
1592 my $lid_ids = $e->search_acq_lineitem_detail(
1593 {lineitem => $li_id, fund_debit => {'!=' => undef}},
1597 for my $lid_id (@$lid_ids) {
1599 my $lid = $e->retrieve_acq_lineitem_detail([
1601 flesh => 1, flesh_fields => {acqlid => ['fund', 'fund_debit']}}
1604 # onless otherwise specified, assume currency of new price is same as currency type of the fund
1605 $currency ||= $lid->fund->currency_type;
1606 my $amount = $price;
1608 if($lid->fund->currency_type ne $currency) {
1609 $amount = currency_conversion($mgr, $currency, $lid->fund->currency_type, $price);
1612 $lid->fund_debit->origin_currency_type($currency);
1613 $lid->fund_debit->origin_amount($price);
1614 $lid->fund_debit->amount($amount);
1616 $e->update_acq_fund_debit($lid->fund_debit) or return $e->die_event;
1622 return $mgr->respond_complete;