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;
211 return 0 unless update_picklist($mgr, $li->picklist);
214 if($li->purchase_order) {
215 return 0 unless update_purchase_order($mgr, $li->purchase_order);
218 # delete the attached lineitem_details
219 my $lid_ids = $mgr->editor->search_acq_lineitem_detail({lineitem => $li->id}, {idlist=>1});
220 for my $lid_id (@$lid_ids) {
221 return 0 unless delete_lineitem_detail($mgr, undef, $lid_id);
224 return $mgr->editor->delete_acq_lineitem($li);
227 # begins and commit transactions as it goes
228 sub create_lineitem_list_assets {
229 my($mgr, $li_ids) = @_;
230 # create the bibs/volumes/copies and ingest the records
231 for my $li_id (@$li_ids) {
232 $mgr->editor->xact_begin;
233 my $data = create_lineitem_assets($mgr, $li_id) or return undef;
234 $mgr->editor->xact_commit;
235 $mgr->push_ingest_queue($data->{li}->eg_bib_id) if $data->{new_bib};
238 $mgr->process_ingest_records;
242 # ----------------------------------------------------------------------------
243 # if all of the lineitem details for this lineitem have
244 # been received, mark the lineitem as received
245 # returns 1 on non-received, li on received, 0 on error
246 # ----------------------------------------------------------------------------
247 sub check_lineitem_received {
248 my($mgr, $li_id) = @_;
250 my $non_recv = $mgr->editor->search_acq_lineitem_detail(
251 {recv_time => undef, lineitem => $li_id}, {idlist=>1});
253 return 1 unless @$non_recv;
255 my $li = $mgr->editor->retrieve_acq_lineitem($li_id);
256 $li->state('received');
257 return update_lineitem($mgr, $li);
260 sub receive_lineitem {
261 my($mgr, $li_id, $skip_complete_check) = @_;
262 my $li = $mgr->editor->retrieve_acq_lineitem($li_id) or return 0;
264 my $lid_ids = $mgr->editor->search_acq_lineitem_detail(
265 {lineitem => $li_id, recv_time => undef}, {idlist => 1});
267 for my $lid_id (@$lid_ids) {
268 receive_lineitem_detail($mgr, $lid_id, 1) or return 0;
272 $li->state('received');
273 update_lineitem($mgr, $li) or return 0;
274 return 1 if $skip_complete_check;
276 return check_purchase_order_received($mgr, $li->purchase_order);
279 sub rollback_receive_lineitem {
280 my($mgr, $li_id) = @_;
281 my $li = $mgr->editor->retrieve_acq_lineitem($li_id) or return 0;
283 my $lid_ids = $mgr->editor->search_acq_lineitem_detail(
284 {lineitem => $li_id, recv_time => {'!=' => undef}}, {idlist => 1});
286 for my $lid_id (@$lid_ids) {
287 rollback_receive_lineitem_detail($mgr, $lid_id, 1) or return 0;
291 $li->state('on-order');
292 return update_lineitem($mgr, $li);
295 # ----------------------------------------------------------------------------
297 # ----------------------------------------------------------------------------
298 sub create_lineitem_detail {
299 my($mgr, %args) = @_;
300 my $lid = Fieldmapper::acq::lineitem_detail->new;
301 $lid->$_($args{$_}) for keys %args;
302 $mgr->editor->create_acq_lineitem_detail($lid) or return 0;
305 # create some default values
306 unless($lid->barcode) {
307 my $pfx = $U->ou_ancestor_setting_value($lid->owning_lib, 'acq.tmp_barcode_prefix') || 'ACQ';
308 $lid->barcode($pfx.$lid->id);
311 unless($lid->cn_label) {
312 my $pfx = $U->ou_ancestor_setting_value($lid->owning_lib, 'acq.tmp_callnumber_prefix') || 'ACQ';
313 $lid->cn_label($pfx.$lid->id);
316 if(!$lid->location and my $loc = $U->ou_ancestor_setting_value($lid->owning_lib, 'acq.default_copy_location')) {
317 $lid->location($loc);
320 if(!$lid->circ_modifier and my $mod = get_default_circ_modifier($mgr, $lid->owning_lib)) {
321 $lid->circ_modifier($mod);
324 $mgr->editor->update_acq_lineitem_detail($lid) or return 0;
325 my $li = $mgr->editor->retrieve_acq_lineitem($lid->lineitem) or return 0;
326 update_lineitem($mgr, $li) or return 0;
330 sub get_default_circ_modifier {
332 my $mod = $mgr->cache($org, 'def_circ_mod');
334 $mod = $U->ou_ancestor_setting_value($org, 'acq.default_circ_modifier');
335 return $mgr->cache($org, 'def_circ_mod', $mod) if $mod;
339 sub delete_lineitem_detail {
341 $lid = $mgr->editor->retrieve_acq_lineitem_detail($lid) unless ref $lid;
342 return $mgr->editor->delete_acq_lineitem_detail($lid);
346 sub receive_lineitem_detail {
347 my($mgr, $lid_id, $skip_complete_check) = @_;
348 my $e = $mgr->editor;
350 my $lid = $e->retrieve_acq_lineitem_detail([
354 acqlid => ['fund_debit']
359 return 1 if $lid->recv_time;
361 $lid->recv_time('now');
362 $e->update_acq_lineitem_detail($lid) or return 0;
364 my $copy = $e->retrieve_asset_copy($lid->eg_copy_id) or return 0;
365 $copy->status(OILS_COPY_STATUS_IN_PROCESS);
366 $copy->edit_date('now');
367 $copy->editor($e->requestor->id);
368 $e->update_asset_copy($copy) or return 0;
370 if($lid->fund_debit) {
371 $lid->fund_debit->encumbrance('f');
372 $e->update_acq_fund_debit($lid->fund_debit) or return 0;
377 return 1 if $skip_complete_check;
379 my $li = check_lineitem_received($mgr, $lid->lineitem) or return 0;
380 return 1 if $li == 1; # li not received
382 return check_purchase_order_received($mgr, $li->purchase_order);
386 sub rollback_receive_lineitem_detail {
387 my($mgr, $lid_id) = @_;
388 my $e = $mgr->editor;
390 my $lid = $e->retrieve_acq_lineitem_detail([
394 acqlid => ['fund_debit']
399 return 1 unless $lid->recv_time;
401 $lid->clear_recv_time;
402 $e->update_acq_lineitem_detail($lid) or return 0;
404 my $copy = $e->retrieve_asset_copy($lid->eg_copy_id) or return 0;
405 $copy->status(OILS_COPY_STATUS_ON_ORDER);
406 $copy->edit_date('now');
407 $copy->editor($e->requestor->id);
408 $e->update_asset_copy($copy) or return 0;
410 if($lid->fund_debit) {
411 $lid->fund_debit->encumbrance('t');
412 $e->update_acq_fund_debit($lid->fund_debit) or return 0;
419 # ----------------------------------------------------------------------------
421 # ----------------------------------------------------------------------------
422 sub set_lineitem_attr {
423 my($mgr, %args) = @_;
424 my $attr_type = $args{attr_type};
426 # first, see if it's already set. May just need to overwrite it
427 my $attr = $mgr->editor->search_acq_lineitem_attr({
428 lineitem => $args{lineitem},
429 attr_type => $args{attr_type},
430 attr_name => $args{attr_name}
434 $attr->attr_value($args{attr_value});
435 return $attr if $mgr->editor->update_acq_lineitem_attr($attr);
440 $attr = Fieldmapper::acq::lineitem_attr->new;
441 $attr->$_($args{$_}) for keys %args;
443 unless($attr->definition) {
444 my $find = "search_acq_$attr_type";
445 my $attr_def_id = $mgr->editor->$find({code => $attr->attr_name}, {idlist=>1})->[0] or return 0;
446 $attr->definition($attr_def_id);
448 return $mgr->editor->create_acq_lineitem_attr($attr);
454 my $attrs = $li->attributes;
455 my ($marc_estimated, $local_estimated, $local_actual, $prov_estimated, $prov_actual);
457 for my $attr (@$attrs) {
458 if($attr->attr_name eq 'estimated_price') {
459 $local_estimated = $attr->attr_value
460 if $attr->attr_type eq 'lineitem_local_attr_definition';
461 $prov_estimated = $attr->attr_value
462 if $attr->attr_type eq 'lineitem_prov_attr_definition';
463 $marc_estimated = $attr->attr_value
464 if $attr->attr_type eq 'lineitem_marc_attr_definition';
466 } elsif($attr->attr_name eq 'actual_price') {
467 $local_actual = $attr->attr_value
468 if $attr->attr_type eq 'lineitem_local_attr_definition';
469 $prov_actual = $attr->attr_value
470 if $attr->attr_type eq 'lineitem_prov_attr_definition';
474 return ($local_actual, 1) if $local_actual;
475 return ($prov_actual, 2) if $prov_actual;
476 return ($local_estimated, 1) if $local_estimated;
477 return ($prov_estimated, 2) if $prov_estimated;
478 return ($marc_estimated, 3);
482 # ----------------------------------------------------------------------------
484 # ----------------------------------------------------------------------------
485 sub create_lineitem_debits {
486 my($mgr, $li, $price, $ptype) = @_;
488 ($price, $ptype) = get_li_price($li) unless $price;
491 $mgr->editor->event(OpenILS::Event->new('ACQ_LINEITEM_NO_PRICE', payload => $li->id));
492 $mgr->editor->rollback;
496 unless($li->provider) {
497 $mgr->editor->event(OpenILS::Event->new('ACQ_LINEITEM_NO_PROVIDER', payload => $li->id));
498 $mgr->editor->rollback;
502 my $lid_ids = $mgr->editor->search_acq_lineitem_detail(
503 {lineitem => $li->id},
507 for my $lid_id (@$lid_ids) {
509 my $lid = $mgr->editor->retrieve_acq_lineitem_detail([
512 flesh_fields => {acqlid => ['fund']}
516 create_lineitem_detail_debit($mgr, $li, $lid, $price, $ptype) or return 0;
525 # ptype 1=local, 2=provider, 3=marc
526 sub create_lineitem_detail_debit {
527 my($mgr, $li, $lid, $price, $ptype) = @_;
529 unless(ref $li and ref $li->provider) {
530 $li = $mgr->editor->retrieve_acq_lineitem([
533 flesh_fields => {jub => ['provider']},
538 unless(ref $lid and ref $lid->fund) {
539 $lid = $mgr->editor->retrieve_acq_lineitem_detail([
542 flesh_fields => {acqlid => ['fund']}
547 my $ctype = $lid->fund->currency_type;
550 if($ptype == 2) { # price from vendor
551 $ctype = $li->provider->currency_type;
552 $amount = currency_conversion($mgr, $ctype, $lid->fund->currency_type, $price);
555 my $debit = create_fund_debit(
557 fund => $lid->fund->id,
558 origin_amount => $price,
559 origin_currency_type => $ctype,
563 $lid->fund_debit($debit->id);
564 $lid->fund($lid->fund->id);
565 $mgr->editor->update_acq_lineitem_detail($lid) or return 0;
570 # ----------------------------------------------------------------------------
572 # ----------------------------------------------------------------------------
573 sub create_fund_debit {
574 my($mgr, %args) = @_;
575 my $debit = Fieldmapper::acq::fund_debit->new;
576 $debit->debit_type('purchase');
577 $debit->encumbrance('t');
578 $debit->$_($args{$_}) for keys %args;
579 $mgr->add_debit($debit->amount);
580 return $mgr->editor->create_acq_fund_debit($debit);
583 sub currency_conversion {
584 my($mgr, $src_currency, $dest_currency, $amount) = @_;
585 my $result = $mgr->editor->json_query(
586 {from => ['acq.exchange_ratio', $src_currency, $dest_currency, $amount]});
587 return $result->[0]->{'acq.exchange_ratio'};
591 # ----------------------------------------------------------------------------
593 # ----------------------------------------------------------------------------
594 sub create_picklist {
595 my($mgr, %args) = @_;
596 my $picklist = Fieldmapper::acq::picklist->new;
597 $picklist->creator($mgr->editor->requestor->id);
598 $picklist->owner($picklist->creator);
599 $picklist->editor($picklist->creator);
600 $picklist->create_time('now');
601 $picklist->edit_time('now');
602 $picklist->org_unit($mgr->editor->requestor->ws_ou);
603 $picklist->owner($mgr->editor->requestor->id);
604 $picklist->$_($args{$_}) for keys %args;
605 $mgr->picklist($picklist);
606 return $mgr->editor->create_acq_picklist($picklist);
609 sub update_picklist {
610 my($mgr, $picklist) = @_;
611 $picklist = $mgr->editor->retrieve_acq_picklist($picklist) unless ref $picklist;
612 $picklist->edit_time('now');
613 $picklist->editor($mgr->editor->requestor->id);
614 $mgr->picklist($picklist);
615 return $picklist if $mgr->editor->update_acq_picklist($picklist);
619 sub delete_picklist {
620 my($mgr, $picklist) = @_;
621 $picklist = $mgr->editor->retrieve_acq_picklist($picklist) unless ref $picklist;
623 # delete all 'new' lineitems
624 my $lis = $mgr->editor->search_acq_lineitem({picklist => $picklist->id, state => 'new'});
626 return 0 unless delete_lineitem($mgr, $li);
629 # detach all non-'new' lineitems
630 $lis = $mgr->editor->search_acq_lineitem({picklist => $picklist->id, state => {'!=' => 'new'}});
633 return 0 unless update_lineitem($li);
636 # remove any picklist-specific object perms
637 my $ops = $mgr->editor->search_permission_usr_object_perm_map({object_type => 'acqpl', object_id => ''.$picklist->id});
639 return 0 unless $mgr->editor->delete_usr_object_perm_map($op);
642 return $mgr->editor->delete_acq_picklist($picklist);
645 # ----------------------------------------------------------------------------
647 # ----------------------------------------------------------------------------
648 sub update_purchase_order {
650 $po = $mgr->editor->retrieve_acq_purchase_order($po) unless ref $po;
651 $po->editor($mgr->editor->requestor->id);
652 $po->edit_time('now');
653 $mgr->purchase_order($po);
654 return $po if $mgr->editor->update_acq_purchase_order($po);
658 sub create_purchase_order {
659 my($mgr, %args) = @_;
660 my $po = Fieldmapper::acq::purchase_order->new;
661 $po->creator($mgr->editor->requestor->id);
662 $po->editor($mgr->editor->requestor->id);
663 $po->owner($mgr->editor->requestor->id);
664 $po->edit_time('now');
665 $po->create_time('now');
666 $po->ordering_agency($mgr->editor->requestor->ws_ou);
667 $po->$_($args{$_}) for keys %args;
668 $mgr->purchase_order($po);
669 return $mgr->editor->create_acq_purchase_order($po);
672 # ----------------------------------------------------------------------------
673 # if all of the lineitems for this PO are received,
674 # mark the PO as received
675 # ----------------------------------------------------------------------------
676 sub check_purchase_order_received {
677 my($mgr, $po_id) = @_;
679 my $non_recv_li = $mgr->editor->search_acq_lineitem(
680 { purchase_order => $po_id,
681 state => {'!=' => 'received'}
684 return 1 if @$non_recv_li;
686 my $po = $mgr->editor->retrieve_acq_purchase_order($po_id);
687 $po->state('received');
688 return update_purchase_order($mgr, $po);
692 # ----------------------------------------------------------------------------
693 # Bib, Callnumber, and Copy data
694 # ----------------------------------------------------------------------------
696 sub create_lineitem_assets {
697 my($mgr, $li_id) = @_;
700 my $li = $mgr->editor->retrieve_acq_lineitem([
703 flesh_fields => {jub => ['purchase_order', 'attributes']}
707 # -----------------------------------------------------------------
708 # first, create the bib record if necessary
709 # -----------------------------------------------------------------
711 unless($li->eg_bib_id) {
712 create_bib($mgr, $li) or return 0;
716 my $li_details = $mgr->editor->search_acq_lineitem_detail({lineitem => $li_id}, {idlist=>1});
718 # -----------------------------------------------------------------
719 # for each lineitem_detail, create the volume if necessary, create
720 # a copy, and link them all together.
721 # -----------------------------------------------------------------
722 for my $lid_id (@{$li_details}) {
724 my $lid = $mgr->editor->retrieve_acq_lineitem_detail($lid_id) or return 0;
725 next if $lid->eg_copy_id;
727 my $org = $lid->owning_lib;
728 my $label = $lid->cn_label;
729 my $bibid = $li->eg_bib_id;
731 my $volume = $mgr->cache($org, "cn.$bibid.$label");
733 $volume = create_volume($mgr, $li, $lid) or return 0;
734 $mgr->cache($org, "cn.$bibid.$label", $volume);
736 create_copy($mgr, $volume, $lid) or return 0;
739 return { li => $li, new_bib => $new_bib };
745 my $record = OpenILS::Application::Cat::BibCommon->biblio_record_xml_import(
750 1, # override tcn collisions
752 undef # $rec->bib_source
755 if($U->event_code($record)) {
756 $mgr->editor->event($record);
757 $mgr->editor->rollback;
761 $li->eg_bib_id($record->id);
763 return update_lineitem($mgr, $li);
767 my($mgr, $li, $lid) = @_;
770 OpenILS::Application::Cat::AssetCommon->find_or_create_volume(
778 $mgr->editor->event($evt);
786 my($mgr, $volume, $lid) = @_;
787 my $copy = Fieldmapper::asset::copy->new;
789 $copy->loan_duration(2);
790 $copy->fine_level(2);
791 $copy->status(OILS_COPY_STATUS_ON_ORDER);
792 $copy->barcode($lid->barcode);
793 $copy->location($lid->location);
794 $copy->call_number($volume->id);
795 $copy->circ_lib($volume->owning_lib);
796 $copy->circ_modifier($lid->circ_modifier);
798 my $evt = OpenILS::Application::Cat::AssetCommon->create_copy($mgr->editor, $volume, $copy);
800 $mgr->editor->event($evt);
805 $lid->eg_copy_id($copy->id);
806 $mgr->editor->update_acq_lineitem_detail($lid) or return 0;
814 # ----------------------------------------------------------------------------
815 # Workflow: Build a selection list from a Z39.50 search
816 # ----------------------------------------------------------------------------
818 __PACKAGE__->register_method(
820 api_name => 'open-ils.acq.picklist.search.z3950',
823 desc => 'Performs a z3950 federated search and creates a picklist and associated lineitems',
825 {desc => 'Authentication token', type => 'string'},
826 {desc => 'Search definition', type => 'object'},
827 {desc => 'Picklist name, optional', type => 'string'},
833 my($self, $conn, $auth, $search, $name, $options) = @_;
834 my $e = new_editor(authtoken=>$auth);
835 return $e->event unless $e->checkauth;
836 return $e->event unless $e->allowed('CREATE_PICKLIST');
838 $search->{limit} ||= 10;
841 my $ses = OpenSRF::AppSession->create('open-ils.search');
842 my $req = $ses->request('open-ils.search.z3950.search_class', $auth, $search);
847 while(my $resp = $req->recv(timeout=>60)) {
850 my $e = new_editor(requestor=>$e->requestor, xact=>1);
851 $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
852 $picklist = zsearch_build_pl($mgr, $name);
856 my $result = $resp->content;
857 my $count = $result->{count};
858 $mgr->total( (($count < $search->{limit}) ? $count : $search->{limit})+1 );
860 for my $rec (@{$result->{records}}) {
862 my $li = create_lineitem($mgr,
863 picklist => $picklist->id,
864 source_label => $result->{service},
865 marc => $rec->{marcxml},
866 eg_bib_id => $rec->{bibid}
869 if($$options{respond_li}) {
870 $li->attributes($mgr->editor->search_acq_lineitem_attr({lineitem => $li->id}))
871 if $$options{flesh_attrs};
872 $li->clear_marc if $$options{clear_marc};
873 $mgr->respond(lineitem => $li);
880 $mgr->editor->commit;
881 return $mgr->respond_complete;
884 sub zsearch_build_pl {
885 my($mgr, $name) = @_;
888 my $picklist = $mgr->editor->search_acq_picklist({
889 owner => $mgr->editor->requestor->id,
893 if($name eq '' and $picklist) {
894 return 0 unless delete_picklist($mgr, $picklist);
898 return update_picklist($mgr, $picklist) if $picklist;
899 return create_picklist($mgr, name => $name);
903 # ----------------------------------------------------------------------------
904 # Workflow: Build a selection list / PO by importing a batch of MARC records
905 # ----------------------------------------------------------------------------
907 __PACKAGE__->register_method(
908 method => 'upload_records',
909 api_name => 'open-ils.acq.process_upload_records',
914 my($self, $conn, $auth, $key) = @_;
916 my $e = new_editor(authtoken => $auth, xact => 1);
917 return $e->die_event unless $e->checkauth;
918 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
920 my $cache = OpenSRF::Utils::Cache->new;
922 my $data = $cache->get_cache("vandelay_import_spool_$key");
923 my $purpose = $data->{purpose};
924 my $filename = $data->{path};
925 my $provider = $data->{provider};
926 my $picklist = $data->{picklist};
927 my $create_po = $data->{create_po};
928 my $ordering_agency = $data->{ordering_agency};
929 my $create_assets = $data->{create_assets};
933 unless(-r $filename) {
934 $logger->error("unable to read MARC file $filename");
936 return OpenILS::Event->new('FILE_UPLOAD_ERROR', payload => {filename => $filename});
939 $provider = $e->retrieve_acq_provider($provider) or return $e->die_event;
942 $picklist = $e->retrieve_acq_picklist($picklist) or return $e->die_event;
943 if($picklist->owner != $e->requestor->id) {
944 return $e->die_event unless
945 $e->allowed('CREATE_PICKLIST', $picklist->org_unit, $picklist);
950 $po = create_purchase_order($mgr,
951 ordering_agency => $ordering_agency,
952 provider => $provider->id
953 ) or return $mgr->editor->die_event;
956 $logger->info("acq processing MARC file=$filename");
958 my $marctype = 'USMARC'; # ?
959 my $batch = new MARC::Batch ($marctype, $filename);
976 $logger->warn("Proccessing of record $count in set $key failed with error $err. Skipping this record");
983 ($xml = $r->as_xml_record()) =~ s/\n//sog;
984 $xml =~ s/^<\?xml.+\?\s*>//go;
985 $xml =~ s/>\s+</></go;
986 $xml =~ s/\p{Cc}//go;
987 $xml = $U->entityize($xml);
988 $xml =~ s/[\x00-\x1f]//go;
992 $logger->warn("Proccessing XML of record $count in set $key failed with error $err. Skipping this record");
995 next if $err or not $xml;
998 source_label => $provider->code,
999 provider => $provider->id,
1003 $args{picklist} = $picklist->id if $picklist;
1005 $args{purchase_order} = $po->id;
1006 $args{state} = 'on-order';
1009 my $li = create_lineitem($mgr, %args) or return $mgr->editor->die_event;
1011 $li->provider($provider); # flesh it, we'll need it later
1013 import_lineitem_details($mgr, $ordering_agency, $li) or return $mgr->editor->die_event;
1016 push(@li_list, $li->id);
1022 $cache->delete_cache('vandelay_import_spool_' . $key);
1024 if($create_assets) {
1025 create_lineitem_list_assets($mgr, \@li_list) or return $e->die_event;
1028 return $mgr->respond_complete;
1031 sub import_lineitem_details {
1032 my($mgr, $ordering_agency, $li) = @_;
1034 my $holdings = $mgr->editor->json_query({from => ['acq.extract_provider_holding_data', $li->id]});
1035 return 1 unless @$holdings;
1036 my $org_path = $U->get_org_ancestors($ordering_agency);
1037 $org_path = [ reverse (@$org_path) ];
1042 # create a lineitem detail for each copy in the data
1044 my $compiled = extract_lineitem_detail_data($mgr, $org_path, $holdings, $idx);
1045 last unless defined $compiled;
1046 return 0 unless $compiled;
1048 # this takes the price of the last copy and uses it as the lineitem price
1049 # need to determine if a given record would include different prices for the same item
1050 $price = $$compiled{price};
1052 for(1..$$compiled{quantity}) {
1053 my $lid = create_lineitem_detail($mgr,
1054 lineitem => $li->id,
1055 owning_lib => $$compiled{owning_lib},
1056 cn_label => $$compiled{call_number},
1057 fund => $$compiled{fund},
1058 circ_modifier => $$compiled{circ_modifier},
1059 note => $$compiled{note},
1060 location => $$compiled{copy_location}
1068 # set the price attr so we'll know the source of the price
1071 attr_name => 'estimated_price',
1072 attr_type => 'lineitem_local_attr_definition',
1073 attr_value => $price,
1077 # if we're creating a purchase order, create the debits
1078 if($li->purchase_order) {
1079 create_lineitem_debits($mgr, $li, $price, 2) or return 0;
1086 # return hash on success, 0 on error, undef on no more holdings
1087 sub extract_lineitem_detail_data {
1088 my($mgr, $org_path, $holdings, $index) = @_;
1090 my @data_list = grep { $_->{holding} eq $index } @$holdings;
1091 return undef unless @data_list;
1093 my %compiled = map { $_->{attr} => $_->{data} } @data_list;
1094 my $base_org = $$org_path[0];
1098 $logger->error("Item import extraction error: $msg");
1099 $logger->error('Holdings Data: ' . OpenSRF::Utils::JSON->perl2JSON(\%compiled));
1100 $mgr->editor->rollback;
1101 $mgr->editor->event(OpenILS::Event->new('ACQ_IMPORT_ERROR', payload => $msg));
1105 $compiled{quantity} ||= 1;
1107 # ---------------------------------------------------------------------
1109 my $code = $compiled{fund_code};
1110 return $killme->('no fund code provided') unless $code;
1112 my $fund = $mgr->cache($base_org, "fund.$code");
1114 # search up the org tree for the most appropriate fund
1115 for my $org (@$org_path) {
1116 $fund = $mgr->editor->search_acq_fund(
1117 {org => $org, code => $code, year => DateTime->now->year}, {idlist => 1})->[0];
1121 return $killme->("no fund with code $code at orgs [@$org_path]") unless $fund;
1122 $compiled{fund} = $fund;
1123 $mgr->cache($base_org, "fund.$code", $fund);
1126 # ---------------------------------------------------------------------
1128 my $sn = $compiled{owning_lib};
1129 return $killme->('no owning_lib defined') unless $sn;
1131 $mgr->cache($base_org, "orgsn.$sn") ||
1132 $mgr->editor->search_actor_org_unit({shortname => $sn}, {idlist => 1})->[0];
1133 return $killme->("invalid owning_lib defined: $sn") unless $org_id;
1134 $compiled{owning_lib} = $org_id;
1135 $mgr->cache($$org_path[0], "orgsn.$sn", $org_id);
1138 # ---------------------------------------------------------------------
1141 $code = $compiled{circ_modifier};
1145 $mod = $mgr->cache($base_org, "mod.$code") ||
1146 $mgr->editor->retrieve_config_circ_modifier($code);
1147 return $killme->("invlalid circ_modifier $code") unless $mod;
1148 $mgr->cache($base_org, "mod.$code", $mod);
1152 $mod = get_default_circ_modifier($mgr, $base_org)
1153 or return $killme->('no circ_modifier defined');
1156 $compiled{circ_modifier} = $mod;
1159 # ---------------------------------------------------------------------
1161 my $name = $compiled{copy_location};
1162 return $killme->('no copy_location defined') unless $name;
1163 my $loc = $mgr->cache($base_org, "copy_loc.$name");
1165 for my $org (@$org_path) {
1166 $loc = $mgr->editor->search_asset_copy_location(
1167 {owning_lib => $org, name => $name}, {idlist => 1})->[0];
1171 return $killme->("Invalid copy location $name") unless $loc;
1172 $compiled{copy_location} = $loc;
1173 $mgr->cache($base_org, "copy_loc.$name", $loc);
1180 # ----------------------------------------------------------------------------
1181 # Workflow: Given an existing purchase order, import/create the bibs,
1182 # callnumber and copy objects
1183 # ----------------------------------------------------------------------------
1185 __PACKAGE__->register_method(
1186 method => 'create_po_assets',
1187 api_name => 'open-ils.acq.purchase_order.assets.create',
1189 desc => q/Creates assets for each lineitem in the purchase order/,
1191 {desc => 'Authentication token', type => 'string'},
1192 {desc => 'The purchase order id', type => 'number'},
1194 return => {desc => 'Streams a total versus completed counts object, event on error'}
1198 sub create_po_assets {
1199 my($self, $conn, $auth, $po_id) = @_;
1201 my $e = new_editor(authtoken=>$auth, xact=>1);
1202 return $e->die_event unless $e->checkauth;
1203 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1205 my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->die_event;
1206 return $e->die_event unless $e->allowed('IMPORT_PURCHASE_ORDER_ASSETS', $po->ordering_agency);
1208 my $li_ids = $e->search_acq_lineitem({purchase_order => $po_id}, {idlist => 1});
1210 # it's ugly, but it's fast. Get the total count of lineitem detail objects to process
1211 my $lid_total = $e->json_query({
1212 select => { acqlid => [{aggregate => 1, transform => 'count', column => 'id'}] },
1218 join => {acqpo => {fkey => 'purchase_order', field => 'id'}}
1222 where => {'+acqpo' => {id => $po_id}}
1225 $mgr->total(scalar(@$li_ids) + $lid_total);
1227 create_lineitem_list_assets($mgr, $li_ids) or return $e->die_event;
1230 update_purchase_order($mgr, $po) or return $e->die_event;
1233 return $mgr->respond_complete;
1238 __PACKAGE__->register_method(
1239 method => 'create_purchase_order_api',
1240 api_name => 'open-ils.acq.purchase_order.create',
1242 desc => 'Creates a new purchase order',
1244 {desc => 'Authentication token', type => 'string'},
1245 {desc => 'purchase_order to create', type => 'object'}
1247 return => {desc => 'The purchase order id, Event on failure'}
1251 sub create_purchase_order_api {
1252 my($self, $conn, $auth, $po, $args) = @_;
1255 my $e = new_editor(xact=>1, authtoken=>$auth);
1256 return $e->die_event unless $e->checkauth;
1257 return $e->die_event unless $e->allowed('CREATE_PURCHASE_ORDER', $po->ordering_agency);
1258 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1261 my %pargs = (ordering_agency => $e->requestor->ws_ou);
1262 $pargs{provider} = $po->provider if $po->provider;
1263 $po = create_purchase_order($mgr, %pargs) or return $e->die_event;
1265 my $li_ids = $$args{lineitems};
1269 for my $li_id (@$li_ids) {
1271 my $li = $e->retrieve_acq_lineitem([
1273 {flesh => 1, flesh_fields => {jub => ['attributes']}}
1274 ]) or return $e->die_event;
1276 $li->provider($po->provider);
1277 $li->purchase_order($po->id);
1278 update_lineitem($mgr, $li) or return $e->die_event;
1281 create_lineitem_debits($mgr, $li) or return $e->die_event;
1285 # commit before starting the asset creation
1288 if($li_ids and $$args{create_assets}) {
1289 create_lineitem_list_assets($mgr, $li_ids) or return $e->die_event;
1292 return $mgr->respond_complete;
1296 __PACKAGE__->register_method(
1297 method => 'lineitem_detail_CUD_batch',
1298 api_name => 'open-ils.acq.lineitem_detail.cud.batch',
1301 desc => q/Creates a new purchase order line item detail.
1302 Additionally creates the associated fund_debit/,
1304 {desc => 'Authentication token', type => 'string'},
1305 {desc => 'List of lineitem_details to create', type => 'array'},
1307 return => {desc => 'Streaming response of current position in the array'}
1311 sub lineitem_detail_CUD_batch {
1312 my($self, $conn, $auth, $li_details) = @_;
1314 my $e = new_editor(xact=>1, authtoken=>$auth);
1315 return $e->die_event unless $e->checkauth;
1316 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1320 $mgr->total(scalar(@$li_details));
1324 for my $lid (@$li_details) {
1326 my $li = $li_cache{$lid->lineitem} || $e->retrieve_acq_lineitem($lid->lineitem);
1329 create_lineitem_detail($mgr, %{$lid->to_bare_hash}) or return $e->die_event;
1331 } elsif($lid->ischanged) {
1332 $e->update_acq_lineitem_detail($lid) or return $e->die_event;
1334 } elsif($lid->isdeleted) {
1335 delete_lineitem_detail($mgr, $lid) or return $e->die_event;
1338 $mgr->respond(li => $li);
1339 $li_cache{$lid->lineitem} = $li;
1343 return $mgr->respond_complete;
1347 __PACKAGE__->register_method(
1348 method => 'receive_po_api',
1349 api_name => 'open-ils.acq.purchase_order.receive'
1352 sub receive_po_api {
1353 my($self, $conn, $auth, $po_id) = @_;
1354 my $e = new_editor(xact => 1, authtoken => $auth);
1355 return $e->die_event unless $e->checkauth;
1356 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1358 my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->die_event;
1359 return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency);
1361 my $li_ids = $e->search_acq_lineitem({purchase_order => $po_id}, {idlist => 1});
1363 for my $li_id (@$li_ids) {
1364 receive_lineitem($mgr, $li_id) or return $e->die_event;
1368 $po->state('received');
1369 update_purchase_order($mgr, $po) or return $e->die_event;
1372 return $mgr->respond_complete;
1376 __PACKAGE__->register_method(
1377 method => 'receive_lineitem_detail_api',
1378 api_name => 'open-ils.acq.lineitem_detail.receive',
1380 desc => 'Mark a lineitem_detail as received',
1382 {desc => 'Authentication token', type => 'string'},
1383 {desc => 'lineitem detail ID', type => 'number'}
1385 return => {desc => '1 on success, Event on error'}
1389 sub receive_lineitem_detail_api {
1390 my($self, $conn, $auth, $lid_id) = @_;
1392 my $e = new_editor(xact=>1, authtoken=>$auth);
1393 return $e->die_event unless $e->checkauth;
1394 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1396 my $lid = $e->retrieve_acq_lineitem_detail([
1400 acqlid => ['lineitem'],
1401 jub => ['purchase_order']
1406 return $e->die_event unless $e->allowed(
1407 'RECEIVE_PURCHASE_ORDER', $lid->lineitem->purchase_order->ordering_agency);
1409 receive_lineitem_detail($mgr, $lid_id) or return $e->die_event;
1414 __PACKAGE__->register_method(
1415 method => 'receive_lineitem_api',
1416 api_name => 'open-ils.acq.lineitem.receive',
1418 desc => 'Mark a lineitem as received',
1420 {desc => 'Authentication token', type => 'string'},
1421 {desc => 'lineitem detail ID', type => 'number'}
1423 return => {desc => '1 on success, Event on error'}
1427 sub receive_lineitem_api {
1428 my($self, $conn, $auth, $li_id) = @_;
1430 my $e = new_editor(xact=>1, authtoken=>$auth);
1431 return $e->die_event unless $e->checkauth;
1432 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1434 my $li = $e->retrieve_acq_lineitem_detail([
1438 jub => ['purchase_order']
1443 return $e->die_event unless $e->allowed(
1444 'RECEIVE_PURCHASE_ORDER', $li->purchase_order->ordering_agency);
1446 receive_lineitem($mgr, $li_id) or return $e->die_event;
1452 __PACKAGE__->register_method(
1453 method => 'rollback_receive_po_api',
1454 api_name => 'open-ils.acq.purchase_order.receive.rollback'
1457 sub rollback_receive_po_api {
1458 my($self, $conn, $auth, $po_id) = @_;
1459 my $e = new_editor(xact => 1, authtoken => $auth);
1460 return $e->die_event unless $e->checkauth;
1461 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1463 my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->die_event;
1464 return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency);
1466 my $li_ids = $e->search_acq_lineitem({purchase_order => $po_id}, {idlist => 1});
1468 for my $li_id (@$li_ids) {
1469 rollback_receive_lineitem($mgr, $li_id) or return $e->die_event;
1473 $po->state('on-order');
1474 update_purchase_order($mgr, $po) or return $e->die_event;
1477 return $mgr->respond_complete;
1481 __PACKAGE__->register_method(
1482 method => 'rollback_receive_lineitem_detail_api',
1483 api_name => 'open-ils.acq.lineitem_detail.receive.rollback',
1485 desc => 'Mark a lineitem_detail as received',
1487 {desc => 'Authentication token', type => 'string'},
1488 {desc => 'lineitem detail ID', type => 'number'}
1490 return => {desc => '1 on success, Event on error'}
1494 sub rollback_receive_lineitem_detail_api {
1495 my($self, $conn, $auth, $lid_id) = @_;
1497 my $e = new_editor(xact=>1, authtoken=>$auth);
1498 return $e->die_event unless $e->checkauth;
1499 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1501 my $lid = $e->retrieve_acq_lineitem_detail([
1505 acqlid => ['lineitem'],
1506 jub => ['purchase_order']
1510 my $li = $lid->lineitem;
1511 my $po = $li->purchase_order;
1513 return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency);
1514 rollback_receive_lineitem_detail($mgr, $lid_id) or return $e->die_event;
1516 $li->state('on-order');
1517 $po->state('on-order');
1518 udpate_lineitem($mgr, $li) or return $e->die_event;
1519 udpate_purchase_order($mgr, $po) or return $e->die_event;
1525 __PACKAGE__->register_method(
1526 method => 'rollback_receive_lineitem_api',
1527 api_name => 'open-ils.acq.lineitem.receive.rollback',
1529 desc => 'Mark a lineitem as received',
1531 {desc => 'Authentication token', type => 'string'},
1532 {desc => 'lineitem detail ID', type => 'number'}
1534 return => {desc => '1 on success, Event on error'}
1538 sub rollback_receive_lineitem_api {
1539 my($self, $conn, $auth, $li_id) = @_;
1541 my $e = new_editor(xact=>1, authtoken=>$auth);
1542 return $e->die_event unless $e->checkauth;
1543 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1545 my $li = $e->retrieve_acq_lineitem_detail([
1549 jub => ['purchase_order']
1553 my $po = $li->purchase_order;
1555 return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency);
1557 rollback_receive_lineitem($mgr, $li_id) or return $e->die_event;
1559 $po->state('on-order');
1560 update_purchase_order($mgr, $po) or return $e->die_event;