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;
192 return $mgr->editor->create_acq_lineitem($li);
195 sub update_lineitem {
197 $li->edit_time('now');
198 $li->editor($mgr->editor->requestor->id);
200 return $li if $mgr->editor->update_acq_lineitem($li);
204 sub delete_lineitem {
206 $li = $mgr->editor->retrieve_acq_lineitem($li) unless ref $li;
208 # delete the attached lineitem_details
209 my $lid_ids = $mgr->editor->search_acq_lineitem_detail({lineitem => $li->id}, {idlist=>1});
210 for my $lid_id (@$lid_ids) {
211 return 0 unless delete_lineitem_detail($mgr, $lid_id);
215 return $mgr->editor->delete_acq_lineitem($li);
218 # begins and commit transactions as it goes
219 sub create_lineitem_list_assets {
220 my($mgr, $li_ids) = @_;
221 return undef if check_import_li_marc_perms($mgr, $li_ids);
223 # create the bibs/volumes/copies and ingest the records
224 for my $li_id (@$li_ids) {
225 $mgr->editor->xact_begin;
226 my $data = create_lineitem_assets($mgr, $li_id) or return undef;
227 $mgr->editor->xact_commit;
228 # XXX ingest is in-db now
229 #$mgr->push_ingest_queue($data->{li}->eg_bib_id) if $data->{new_bib};
232 $mgr->process_ingest_records;
236 # returns event on error, undef on success
237 sub check_import_li_marc_perms {
238 my($mgr, $li_ids) = @_;
240 # if there are any order records that are not linked to
241 # in-db bib records, verify staff has perms to import order records
242 my $order_li = $mgr->editor->search_acq_lineitem(
243 [{id => $li_ids, eg_bib_id => undef}, {limit => 1}], {idlist => 1})->[0];
246 return $mgr->editor->die_event unless
247 $mgr->editor->allowed('IMPORT_ACQ_LINEITEM_BIB_RECORD');
254 # ----------------------------------------------------------------------------
255 # if all of the lineitem details for this lineitem have
256 # been received, mark the lineitem as received
257 # returns 1 on non-received, li on received, 0 on error
258 # ----------------------------------------------------------------------------
259 sub check_lineitem_received {
260 my($mgr, $li_id) = @_;
262 my $non_recv = $mgr->editor->search_acq_lineitem_detail(
263 {recv_time => undef, lineitem => $li_id}, {idlist=>1});
265 return 1 if @$non_recv;
267 my $li = $mgr->editor->retrieve_acq_lineitem($li_id);
268 $li->state('received');
269 return update_lineitem($mgr, $li);
272 sub receive_lineitem {
273 my($mgr, $li_id, $skip_complete_check) = @_;
274 my $li = $mgr->editor->retrieve_acq_lineitem($li_id) or return 0;
276 my $lid_ids = $mgr->editor->search_acq_lineitem_detail(
277 {lineitem => $li_id, recv_time => undef}, {idlist => 1});
279 for my $lid_id (@$lid_ids) {
280 receive_lineitem_detail($mgr, $lid_id, 1) or return 0;
284 $li->state('received');
285 update_lineitem($mgr, $li) or return 0;
286 return 1 if $skip_complete_check;
288 return check_purchase_order_received($mgr, $li->purchase_order);
291 sub rollback_receive_lineitem {
292 my($mgr, $li_id) = @_;
293 my $li = $mgr->editor->retrieve_acq_lineitem($li_id) or return 0;
295 my $lid_ids = $mgr->editor->search_acq_lineitem_detail(
296 {lineitem => $li_id, recv_time => {'!=' => undef}}, {idlist => 1});
298 for my $lid_id (@$lid_ids) {
299 rollback_receive_lineitem_detail($mgr, $lid_id, 1) or return 0;
303 $li->state('on-order');
304 return update_lineitem($mgr, $li);
307 # ----------------------------------------------------------------------------
309 # ----------------------------------------------------------------------------
310 sub create_lineitem_detail {
311 my($mgr, %args) = @_;
312 my $lid = Fieldmapper::acq::lineitem_detail->new;
313 $lid->$_($args{$_}) for keys %args;
316 return $mgr->editor->create_acq_lineitem_detail($lid);
320 # flesh out any required data with default values where appropriate
321 sub complete_lineitem_detail {
323 unless($lid->barcode) {
324 my $pfx = $U->ou_ancestor_setting_value($lid->owning_lib, 'acq.tmp_barcode_prefix') || 'ACQ';
325 $lid->barcode($pfx.$lid->id);
328 unless($lid->cn_label) {
329 my $pfx = $U->ou_ancestor_setting_value($lid->owning_lib, 'acq.tmp_callnumber_prefix') || 'ACQ';
330 $lid->cn_label($pfx.$lid->id);
333 if(!$lid->location and my $loc = $U->ou_ancestor_setting_value($lid->owning_lib, 'acq.default_copy_location')) {
334 $lid->location($loc);
337 if(!$lid->circ_modifier and my $mod = get_default_circ_modifier($mgr, $lid->owning_lib)) {
338 $lid->circ_modifier($mod);
341 $mgr->editor->update_acq_lineitem_detail($lid) or return 0;
345 sub get_default_circ_modifier {
347 my $mod = $mgr->cache($org, 'def_circ_mod');
349 $mod = $U->ou_ancestor_setting_value($org, 'acq.default_circ_modifier');
350 return $mgr->cache($org, 'def_circ_mod', $mod) if $mod;
354 sub delete_lineitem_detail {
356 $lid = $mgr->editor->retrieve_acq_lineitem_detail($lid) unless ref $lid;
357 return $mgr->editor->delete_acq_lineitem_detail($lid);
361 sub receive_lineitem_detail {
362 my($mgr, $lid_id, $skip_complete_check) = @_;
363 my $e = $mgr->editor;
365 my $lid = $e->retrieve_acq_lineitem_detail([
369 acqlid => ['fund_debit']
374 return 1 if $lid->recv_time;
376 $lid->recv_time('now');
377 $e->update_acq_lineitem_detail($lid) or return 0;
379 my $copy = $e->retrieve_asset_copy($lid->eg_copy_id) or return 0;
380 $copy->status(OILS_COPY_STATUS_IN_PROCESS);
381 $copy->edit_date('now');
382 $copy->editor($e->requestor->id);
383 $e->update_asset_copy($copy) or return 0;
385 if($lid->fund_debit) {
386 $lid->fund_debit->encumbrance('f');
387 $e->update_acq_fund_debit($lid->fund_debit) or return 0;
392 return 1 if $skip_complete_check;
394 my $li = check_lineitem_received($mgr, $lid->lineitem) or return 0;
395 return 1 if $li == 1; # li not received
397 return check_purchase_order_received($mgr, $li->purchase_order);
401 sub rollback_receive_lineitem_detail {
402 my($mgr, $lid_id) = @_;
403 my $e = $mgr->editor;
405 my $lid = $e->retrieve_acq_lineitem_detail([
409 acqlid => ['fund_debit']
414 return 1 unless $lid->recv_time;
416 $lid->clear_recv_time;
417 $e->update_acq_lineitem_detail($lid) or return 0;
419 my $copy = $e->retrieve_asset_copy($lid->eg_copy_id) or return 0;
420 $copy->status(OILS_COPY_STATUS_ON_ORDER);
421 $copy->edit_date('now');
422 $copy->editor($e->requestor->id);
423 $e->update_asset_copy($copy) or return 0;
425 if($lid->fund_debit) {
426 $lid->fund_debit->encumbrance('t');
427 $e->update_acq_fund_debit($lid->fund_debit) or return 0;
434 # ----------------------------------------------------------------------------
436 # ----------------------------------------------------------------------------
437 sub set_lineitem_attr {
438 my($mgr, %args) = @_;
439 my $attr_type = $args{attr_type};
441 # first, see if it's already set. May just need to overwrite it
442 my $attr = $mgr->editor->search_acq_lineitem_attr({
443 lineitem => $args{lineitem},
444 attr_type => $args{attr_type},
445 attr_name => $args{attr_name}
449 $attr->attr_value($args{attr_value});
450 return $attr if $mgr->editor->update_acq_lineitem_attr($attr);
455 $attr = Fieldmapper::acq::lineitem_attr->new;
456 $attr->$_($args{$_}) for keys %args;
458 unless($attr->definition) {
459 my $find = "search_acq_$attr_type";
460 my $attr_def_id = $mgr->editor->$find({code => $attr->attr_name}, {idlist=>1})->[0] or return 0;
461 $attr->definition($attr_def_id);
463 return $mgr->editor->create_acq_lineitem_attr($attr);
469 my $attrs = $li->attributes;
470 my ($marc_estimated, $local_estimated, $local_actual, $prov_estimated, $prov_actual);
472 for my $attr (@$attrs) {
473 if($attr->attr_name eq 'estimated_price') {
474 $local_estimated = $attr->attr_value
475 if $attr->attr_type eq 'lineitem_local_attr_definition';
476 $prov_estimated = $attr->attr_value
477 if $attr->attr_type eq 'lineitem_prov_attr_definition';
478 $marc_estimated = $attr->attr_value
479 if $attr->attr_type eq 'lineitem_marc_attr_definition';
481 } elsif($attr->attr_name eq 'actual_price') {
482 $local_actual = $attr->attr_value
483 if $attr->attr_type eq 'lineitem_local_attr_definition';
484 $prov_actual = $attr->attr_value
485 if $attr->attr_type eq 'lineitem_prov_attr_definition';
489 return ($local_actual, 1) if $local_actual;
490 return ($prov_actual, 2) if $prov_actual;
491 return ($local_estimated, 1) if $local_estimated;
492 return ($prov_estimated, 2) if $prov_estimated;
493 return ($marc_estimated, 3);
497 # ----------------------------------------------------------------------------
499 # ----------------------------------------------------------------------------
500 sub create_lineitem_debits {
501 my($mgr, $li, $price, $ptype) = @_;
503 ($price, $ptype) = get_li_price($li) unless $price;
506 $mgr->editor->event(OpenILS::Event->new('ACQ_LINEITEM_NO_PRICE', payload => $li->id));
507 $mgr->editor->rollback;
511 unless($li->provider) {
512 $mgr->editor->event(OpenILS::Event->new('ACQ_LINEITEM_NO_PROVIDER', payload => $li->id));
513 $mgr->editor->rollback;
517 my $lid_ids = $mgr->editor->search_acq_lineitem_detail(
518 {lineitem => $li->id},
522 for my $lid_id (@$lid_ids) {
524 my $lid = $mgr->editor->retrieve_acq_lineitem_detail([
527 flesh_fields => {acqlid => ['fund']}
531 create_lineitem_detail_debit($mgr, $li, $lid, $price, $ptype) or return 0;
540 # ptype 1=local, 2=provider, 3=marc
541 sub create_lineitem_detail_debit {
542 my($mgr, $li, $lid, $price, $ptype) = @_;
544 unless(ref $li and ref $li->provider) {
545 $li = $mgr->editor->retrieve_acq_lineitem([
548 flesh_fields => {jub => ['provider']},
553 unless(ref $lid and ref $lid->fund) {
554 $lid = $mgr->editor->retrieve_acq_lineitem_detail([
557 flesh_fields => {acqlid => ['fund']}
562 my $ctype = $lid->fund->currency_type;
565 if($ptype == 2) { # price from vendor
566 $ctype = $li->provider->currency_type;
567 $amount = currency_conversion($mgr, $ctype, $lid->fund->currency_type, $price);
570 my $debit = create_fund_debit(
572 fund => $lid->fund->id,
573 origin_amount => $price,
574 origin_currency_type => $ctype,
578 $lid->fund_debit($debit->id);
579 $lid->fund($lid->fund->id);
580 $mgr->editor->update_acq_lineitem_detail($lid) or return 0;
585 # ----------------------------------------------------------------------------
587 # ----------------------------------------------------------------------------
588 sub create_fund_debit {
589 my($mgr, %args) = @_;
590 my $debit = Fieldmapper::acq::fund_debit->new;
591 $debit->debit_type('purchase');
592 $debit->encumbrance('t');
593 $debit->$_($args{$_}) for keys %args;
595 $mgr->add_debit($debit->amount);
596 return $mgr->editor->create_acq_fund_debit($debit);
599 sub currency_conversion {
600 my($mgr, $src_currency, $dest_currency, $amount) = @_;
601 my $result = $mgr->editor->json_query(
602 {from => ['acq.exchange_ratio', $src_currency, $dest_currency, $amount]});
603 return $result->[0]->{'acq.exchange_ratio'};
607 # ----------------------------------------------------------------------------
609 # ----------------------------------------------------------------------------
610 sub create_picklist {
611 my($mgr, %args) = @_;
612 my $picklist = Fieldmapper::acq::picklist->new;
613 $picklist->creator($mgr->editor->requestor->id);
614 $picklist->owner($picklist->creator);
615 $picklist->editor($picklist->creator);
616 $picklist->create_time('now');
617 $picklist->edit_time('now');
618 $picklist->org_unit($mgr->editor->requestor->ws_ou);
619 $picklist->owner($mgr->editor->requestor->id);
620 $picklist->$_($args{$_}) for keys %args;
622 $mgr->picklist($picklist);
623 return $mgr->editor->create_acq_picklist($picklist);
626 sub update_picklist {
627 my($mgr, $picklist) = @_;
628 $picklist = $mgr->editor->retrieve_acq_picklist($picklist) unless ref $picklist;
629 $picklist->edit_time('now');
630 $picklist->editor($mgr->editor->requestor->id);
631 $mgr->picklist($picklist);
632 return $picklist if $mgr->editor->update_acq_picklist($picklist);
636 sub delete_picklist {
637 my($mgr, $picklist) = @_;
638 $picklist = $mgr->editor->retrieve_acq_picklist($picklist) unless ref $picklist;
640 # delete all 'new' lineitems
641 my $li_ids = $mgr->editor->search_acq_lineitem({picklist => $picklist->id, state => 'new'}, {idlist => 1});
642 for my $li_id (@$li_ids) {
643 my $li = $mgr->editor->retrieve_acq_lineitem($li_id);
644 return 0 unless delete_lineitem($mgr, $li);
648 # detach all non-'new' lineitems
649 $li_ids = $mgr->editor->search_acq_lineitem({picklist => $picklist->id, state => {'!=' => 'new'}}, {idlist => 1});
650 for my $li_id (@$li_ids) {
651 my $li = $mgr->editor->retrieve_acq_lineitem($li_id);
653 return 0 unless update_lineitem($mgr, $li);
657 # remove any picklist-specific object perms
658 my $ops = $mgr->editor->search_permission_usr_object_perm_map({object_type => 'acqpl', object_id => ''.$picklist->id});
660 return 0 unless $mgr->editor->delete_usr_object_perm_map($op);
663 return $mgr->editor->delete_acq_picklist($picklist);
666 # ----------------------------------------------------------------------------
668 # ----------------------------------------------------------------------------
669 sub update_purchase_order {
671 $po = $mgr->editor->retrieve_acq_purchase_order($po) unless ref $po;
672 $po->editor($mgr->editor->requestor->id);
673 $po->edit_time('now');
674 $mgr->purchase_order($po);
675 return $po if $mgr->editor->update_acq_purchase_order($po);
679 sub create_purchase_order {
680 my($mgr, %args) = @_;
681 my $po = Fieldmapper::acq::purchase_order->new;
682 $po->creator($mgr->editor->requestor->id);
683 $po->editor($mgr->editor->requestor->id);
684 $po->owner($mgr->editor->requestor->id);
685 $po->edit_time('now');
686 $po->create_time('now');
687 $po->state('pending');
688 $po->ordering_agency($mgr->editor->requestor->ws_ou);
689 $po->$_($args{$_}) for keys %args;
691 $mgr->purchase_order($po);
692 return $mgr->editor->create_acq_purchase_order($po);
695 # ----------------------------------------------------------------------------
696 # if all of the lineitems for this PO are received,
697 # mark the PO as received
698 # ----------------------------------------------------------------------------
699 sub check_purchase_order_received {
700 my($mgr, $po_id) = @_;
702 my $non_recv_li = $mgr->editor->search_acq_lineitem(
703 { purchase_order => $po_id,
704 state => {'!=' => 'received'}
707 return 1 if @$non_recv_li;
709 my $po = $mgr->editor->retrieve_acq_purchase_order($po_id);
710 $po->state('received');
711 return update_purchase_order($mgr, $po);
715 # ----------------------------------------------------------------------------
716 # Bib, Callnumber, and Copy data
717 # ----------------------------------------------------------------------------
719 sub create_lineitem_assets {
720 my($mgr, $li_id) = @_;
723 my $li = $mgr->editor->retrieve_acq_lineitem([
726 flesh_fields => {jub => ['purchase_order', 'attributes']}
730 # -----------------------------------------------------------------
731 # first, create the bib record if necessary
732 # -----------------------------------------------------------------
734 unless($li->eg_bib_id) {
735 create_bib($mgr, $li) or return 0;
739 my $li_details = $mgr->editor->search_acq_lineitem_detail({lineitem => $li_id}, {idlist=>1});
741 # -----------------------------------------------------------------
742 # for each lineitem_detail, create the volume if necessary, create
743 # a copy, and link them all together.
744 # -----------------------------------------------------------------
746 for my $lid_id (@{$li_details}) {
748 my $lid = $mgr->editor->retrieve_acq_lineitem_detail($lid_id) or return 0;
749 next if $lid->eg_copy_id;
751 # use the same callnumber label for all items within this lineitem
752 $lid->cn_label($first_cn) if $first_cn and not $lid->cn_label;
754 # apply defaults if necessary
755 return 0 unless complete_lineitem_detail($mgr, $lid);
757 $first_cn = $lid->cn_label unless $first_cn;
759 my $org = $lid->owning_lib;
760 my $label = $lid->cn_label;
761 my $bibid = $li->eg_bib_id;
763 my $volume = $mgr->cache($org, "cn.$bibid.$label");
765 $volume = create_volume($mgr, $li, $lid) or return 0;
766 $mgr->cache($org, "cn.$bibid.$label", $volume);
768 create_copy($mgr, $volume, $lid) or return 0;
771 return { li => $li, new_bib => $new_bib };
777 my $record = OpenILS::Application::Cat::BibCommon->biblio_record_xml_import(
782 1, # override tcn collisions
785 if($U->event_code($record)) {
786 $mgr->editor->event($record);
787 $mgr->editor->rollback;
791 $li->eg_bib_id($record->id);
793 return update_lineitem($mgr, $li);
797 my($mgr, $li, $lid) = @_;
800 OpenILS::Application::Cat::AssetCommon->find_or_create_volume(
808 $mgr->editor->event($evt);
816 my($mgr, $volume, $lid) = @_;
817 my $copy = Fieldmapper::asset::copy->new;
819 $copy->loan_duration(2);
820 $copy->fine_level(2);
821 $copy->status(OILS_COPY_STATUS_ON_ORDER);
822 $copy->barcode($lid->barcode);
823 $copy->location($lid->location);
824 $copy->call_number($volume->id);
825 $copy->circ_lib($volume->owning_lib);
826 $copy->circ_modifier($lid->circ_modifier);
828 my $evt = OpenILS::Application::Cat::AssetCommon->create_copy($mgr->editor, $volume, $copy);
830 $mgr->editor->event($evt);
835 $lid->eg_copy_id($copy->id);
836 $mgr->editor->update_acq_lineitem_detail($lid) or return 0;
844 # ----------------------------------------------------------------------------
845 # Workflow: Build a selection list from a Z39.50 search
846 # ----------------------------------------------------------------------------
848 __PACKAGE__->register_method(
850 api_name => 'open-ils.acq.picklist.search.z3950',
853 desc => 'Performs a z3950 federated search and creates a picklist and associated lineitems',
855 {desc => 'Authentication token', type => 'string'},
856 {desc => 'Search definition', type => 'object'},
857 {desc => 'Picklist name, optional', type => 'string'},
863 my($self, $conn, $auth, $search, $name, $options) = @_;
864 my $e = new_editor(authtoken=>$auth);
865 return $e->event unless $e->checkauth;
866 return $e->event unless $e->allowed('CREATE_PICKLIST');
868 $search->{limit} ||= 10;
871 my $ses = OpenSRF::AppSession->create('open-ils.search');
872 my $req = $ses->request('open-ils.search.z3950.search_class', $auth, $search);
877 while(my $resp = $req->recv(timeout=>60)) {
880 my $e = new_editor(requestor=>$e->requestor, xact=>1);
881 $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
882 $picklist = zsearch_build_pl($mgr, $name);
886 my $result = $resp->content;
887 my $count = $result->{count};
888 $mgr->total( (($count < $search->{limit}) ? $count : $search->{limit})+1 );
890 for my $rec (@{$result->{records}}) {
892 my $li = create_lineitem($mgr,
893 picklist => $picklist->id,
894 source_label => $result->{service},
895 marc => $rec->{marcxml},
896 eg_bib_id => $rec->{bibid}
899 if($$options{respond_li}) {
900 $li->attributes($mgr->editor->search_acq_lineitem_attr({lineitem => $li->id}))
901 if $$options{flesh_attrs};
902 $li->clear_marc if $$options{clear_marc};
903 $mgr->respond(lineitem => $li);
910 $mgr->editor->commit;
911 return $mgr->respond_complete;
914 sub zsearch_build_pl {
915 my($mgr, $name) = @_;
918 my $picklist = $mgr->editor->search_acq_picklist({
919 owner => $mgr->editor->requestor->id,
923 if($name eq '' and $picklist) {
924 return 0 unless delete_picklist($mgr, $picklist);
928 return update_picklist($mgr, $picklist) if $picklist;
929 return create_picklist($mgr, name => $name);
933 # ----------------------------------------------------------------------------
934 # Workflow: Build a selection list / PO by importing a batch of MARC records
935 # ----------------------------------------------------------------------------
937 __PACKAGE__->register_method(
938 method => 'upload_records',
939 api_name => 'open-ils.acq.process_upload_records',
944 my($self, $conn, $auth, $key) = @_;
946 my $e = new_editor(authtoken => $auth, xact => 1);
947 return $e->die_event unless $e->checkauth;
948 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
950 my $cache = OpenSRF::Utils::Cache->new;
952 my $data = $cache->get_cache("vandelay_import_spool_$key");
953 my $purpose = $data->{purpose};
954 my $filename = $data->{path};
955 my $provider = $data->{provider};
956 my $picklist = $data->{picklist};
957 my $create_po = $data->{create_po};
958 my $ordering_agency = $data->{ordering_agency};
959 my $create_assets = $data->{create_assets};
963 unless(-r $filename) {
964 $logger->error("unable to read MARC file $filename");
966 return OpenILS::Event->new('FILE_UPLOAD_ERROR', payload => {filename => $filename});
969 $provider = $e->retrieve_acq_provider($provider) or return $e->die_event;
972 $picklist = $e->retrieve_acq_picklist($picklist) or return $e->die_event;
973 if($picklist->owner != $e->requestor->id) {
974 return $e->die_event unless
975 $e->allowed('CREATE_PICKLIST', $picklist->org_unit, $picklist);
977 $mgr->picklist($picklist);
981 $po = create_purchase_order($mgr,
982 ordering_agency => $ordering_agency,
983 provider => $provider->id,
985 ) or return $mgr->editor->die_event;
988 $logger->info("acq processing MARC file=$filename");
990 my $marctype = 'USMARC'; # ?
991 my $batch = new MARC::Batch ($marctype, $filename);
1006 } catch Error with {
1008 $logger->warn("Proccessing of record $count in set $key failed with error $err. Skipping this record");
1015 ($xml = $r->as_xml_record()) =~ s/\n//sog;
1016 $xml =~ s/^<\?xml.+\?\s*>//go;
1017 $xml =~ s/>\s+</></go;
1018 $xml =~ s/\p{Cc}//go;
1019 $xml = $U->entityize($xml);
1020 $xml =~ s/[\x00-\x1f]//go;
1022 } catch Error with {
1024 $logger->warn("Proccessing XML of record $count in set $key failed with error $err. Skipping this record");
1027 next if $err or not $xml;
1030 source_label => $provider->code,
1031 provider => $provider->id,
1035 $args{picklist} = $picklist->id if $picklist;
1037 $args{purchase_order} = $po->id;
1038 $args{state} = 'on-order';
1041 my $li = create_lineitem($mgr, %args) or return $mgr->editor->die_event;
1043 $li->provider($provider); # flesh it, we'll need it later
1045 import_lineitem_details($mgr, $ordering_agency, $li) or return $mgr->editor->die_event;
1048 push(@li_list, $li->id);
1054 $cache->delete_cache('vandelay_import_spool_' . $key);
1056 if($create_assets) {
1057 create_lineitem_list_assets($mgr, \@li_list) or return $e->die_event;
1060 return $mgr->respond_complete;
1063 sub import_lineitem_details {
1064 my($mgr, $ordering_agency, $li) = @_;
1066 my $holdings = $mgr->editor->json_query({from => ['acq.extract_provider_holding_data', $li->id]});
1067 return 1 unless @$holdings;
1068 my $org_path = $U->get_org_ancestors($ordering_agency);
1069 $org_path = [ reverse (@$org_path) ];
1074 # create a lineitem detail for each copy in the data
1076 my $compiled = extract_lineitem_detail_data($mgr, $org_path, $holdings, $idx);
1077 last unless defined $compiled;
1078 return 0 unless $compiled;
1080 # this takes the price of the last copy and uses it as the lineitem price
1081 # need to determine if a given record would include different prices for the same item
1082 $price = $$compiled{price};
1084 for(1..$$compiled{quantity}) {
1085 my $lid = create_lineitem_detail($mgr,
1086 lineitem => $li->id,
1087 owning_lib => $$compiled{owning_lib},
1088 cn_label => $$compiled{call_number},
1089 fund => $$compiled{fund},
1090 circ_modifier => $$compiled{circ_modifier},
1091 note => $$compiled{note},
1092 location => $$compiled{copy_location},
1093 collection_code => $$compiled{collection_code}
1101 # set the price attr so we'll know the source of the price
1104 attr_name => 'estimated_price',
1105 attr_type => 'lineitem_local_attr_definition',
1106 attr_value => $price,
1110 # if we're creating a purchase order, create the debits
1111 if($li->purchase_order) {
1112 create_lineitem_debits($mgr, $li, $price, 2) or return 0;
1119 # return hash on success, 0 on error, undef on no more holdings
1120 sub extract_lineitem_detail_data {
1121 my($mgr, $org_path, $holdings, $index) = @_;
1123 my @data_list = grep { $_->{holding} eq $index } @$holdings;
1124 return undef unless @data_list;
1126 my %compiled = map { $_->{attr} => $_->{data} } @data_list;
1127 my $base_org = $$org_path[0];
1131 $logger->error("Item import extraction error: $msg");
1132 $logger->error('Holdings Data: ' . OpenSRF::Utils::JSON->perl2JSON(\%compiled));
1133 $mgr->editor->rollback;
1134 $mgr->editor->event(OpenILS::Event->new('ACQ_IMPORT_ERROR', payload => $msg));
1138 $compiled{quantity} ||= 1;
1140 # ---------------------------------------------------------------------
1142 my $code = $compiled{fund_code};
1143 return $killme->('no fund code provided') unless $code;
1145 my $fund = $mgr->cache($base_org, "fund.$code");
1147 # search up the org tree for the most appropriate fund
1148 for my $org (@$org_path) {
1149 $fund = $mgr->editor->search_acq_fund(
1150 {org => $org, code => $code, year => DateTime->now->year}, {idlist => 1})->[0];
1154 return $killme->("no fund with code $code at orgs [@$org_path]") unless $fund;
1155 $compiled{fund} = $fund;
1156 $mgr->cache($base_org, "fund.$code", $fund);
1159 # ---------------------------------------------------------------------
1161 my $sn = $compiled{owning_lib};
1162 return $killme->('no owning_lib defined') unless $sn;
1164 $mgr->cache($base_org, "orgsn.$sn") ||
1165 $mgr->editor->search_actor_org_unit({shortname => $sn}, {idlist => 1})->[0];
1166 return $killme->("invalid owning_lib defined: $sn") unless $org_id;
1167 $compiled{owning_lib} = $org_id;
1168 $mgr->cache($$org_path[0], "orgsn.$sn", $org_id);
1171 # ---------------------------------------------------------------------
1174 $code = $compiled{circ_modifier};
1178 $mod = $mgr->cache($base_org, "mod.$code") ||
1179 $mgr->editor->retrieve_config_circ_modifier($code);
1180 return $killme->("invlalid circ_modifier $code") unless $mod;
1181 $mgr->cache($base_org, "mod.$code", $mod);
1185 $mod = get_default_circ_modifier($mgr, $base_org)
1186 or return $killme->('no circ_modifier defined');
1189 $compiled{circ_modifier} = $mod;
1192 # ---------------------------------------------------------------------
1194 my $name = $compiled{copy_location};
1196 my $loc = $mgr->cache($base_org, "copy_loc.$name");
1198 for my $org (@$org_path) {
1199 $loc = $mgr->editor->search_asset_copy_location(
1200 {owning_lib => $org, name => $name}, {idlist => 1})->[0];
1204 return $killme->("Invalid copy location $name") unless $loc;
1205 $compiled{copy_location} = $loc;
1206 $mgr->cache($base_org, "copy_loc.$name", $loc);
1214 # ----------------------------------------------------------------------------
1215 # Workflow: Given an existing purchase order, import/create the bibs,
1216 # callnumber and copy objects
1217 # ----------------------------------------------------------------------------
1219 __PACKAGE__->register_method(
1220 method => 'create_po_assets',
1221 api_name => 'open-ils.acq.purchase_order.assets.create',
1223 desc => q/Creates assets for each lineitem in the purchase order/,
1225 {desc => 'Authentication token', type => 'string'},
1226 {desc => 'The purchase order id', type => 'number'},
1228 return => {desc => 'Streams a total versus completed counts object, event on error'}
1232 sub create_po_assets {
1233 my($self, $conn, $auth, $po_id) = @_;
1235 my $e = new_editor(authtoken=>$auth, xact=>1);
1236 return $e->die_event unless $e->checkauth;
1237 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1239 my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->die_event;
1241 my $li_ids = $e->search_acq_lineitem({purchase_order => $po_id}, {idlist => 1});
1243 # it's ugly, but it's fast. Get the total count of lineitem detail objects to process
1244 my $lid_total = $e->json_query({
1245 select => { acqlid => [{aggregate => 1, transform => 'count', column => 'id'}] },
1251 join => {acqpo => {fkey => 'purchase_order', field => 'id'}}
1255 where => {'+acqpo' => {id => $po_id}}
1258 $mgr->total(scalar(@$li_ids) + $lid_total);
1260 create_lineitem_list_assets($mgr, $li_ids) or return $e->die_event;
1263 update_purchase_order($mgr, $po) or return $e->die_event;
1266 return $mgr->respond_complete;
1271 __PACKAGE__->register_method(
1272 method => 'create_purchase_order_api',
1273 api_name => 'open-ils.acq.purchase_order.create',
1275 desc => 'Creates a new purchase order',
1277 {desc => 'Authentication token', type => 'string'},
1278 {desc => 'purchase_order to create', type => 'object'}
1280 return => {desc => 'The purchase order id, Event on failure'}
1284 sub create_purchase_order_api {
1285 my($self, $conn, $auth, $po, $args) = @_;
1288 my $e = new_editor(xact=>1, authtoken=>$auth);
1289 return $e->die_event unless $e->checkauth;
1290 return $e->die_event unless $e->allowed('CREATE_PURCHASE_ORDER', $po->ordering_agency);
1291 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1294 my %pargs = (ordering_agency => $e->requestor->ws_ou); # default
1295 $pargs{provider} = $po->provider if $po->provider;
1296 $pargs{ordering_agency} = $po->ordering_agency if $po->ordering_agency;
1297 $po = create_purchase_order($mgr, %pargs) or return $e->die_event;
1299 my $li_ids = $$args{lineitems};
1303 for my $li_id (@$li_ids) {
1305 my $li = $e->retrieve_acq_lineitem([
1307 {flesh => 1, flesh_fields => {jub => ['attributes']}}
1308 ]) or return $e->die_event;
1310 $li->provider($po->provider);
1311 $li->purchase_order($po->id);
1312 $li->state('pending-order');
1313 update_lineitem($mgr, $li) or return $e->die_event;
1316 create_lineitem_debits($mgr, $li) or return $e->die_event;
1320 # commit before starting the asset creation
1323 if($li_ids and $$args{create_assets}) {
1324 create_lineitem_list_assets($mgr, $li_ids) or return $e->die_event;
1327 return $mgr->respond_complete;
1331 __PACKAGE__->register_method(
1332 method => 'lineitem_detail_CUD_batch',
1333 api_name => 'open-ils.acq.lineitem_detail.cud.batch',
1336 desc => q/Creates a new purchase order line item detail.
1337 Additionally creates the associated fund_debit/,
1339 {desc => 'Authentication token', type => 'string'},
1340 {desc => 'List of lineitem_details to create', type => 'array'},
1342 return => {desc => 'Streaming response of current position in the array'}
1346 sub lineitem_detail_CUD_batch {
1347 my($self, $conn, $auth, $li_details) = @_;
1349 my $e = new_editor(xact=>1, authtoken=>$auth);
1350 return $e->die_event unless $e->checkauth;
1351 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1355 $mgr->total(scalar(@$li_details));
1359 for my $lid (@$li_details) {
1361 my $li = $li_cache{$lid->lineitem} || $e->retrieve_acq_lineitem($lid->lineitem);
1364 create_lineitem_detail($mgr, %{$lid->to_bare_hash}) or return $e->die_event;
1366 } elsif($lid->ischanged) {
1367 $e->update_acq_lineitem_detail($lid) or return $e->die_event;
1369 } elsif($lid->isdeleted) {
1370 delete_lineitem_detail($mgr, $lid) or return $e->die_event;
1373 $mgr->respond(li => $li);
1374 $li_cache{$lid->lineitem} = $li;
1378 return $mgr->respond_complete;
1382 __PACKAGE__->register_method(
1383 method => 'receive_po_api',
1384 api_name => 'open-ils.acq.purchase_order.receive'
1387 sub receive_po_api {
1388 my($self, $conn, $auth, $po_id) = @_;
1389 my $e = new_editor(xact => 1, authtoken => $auth);
1390 return $e->die_event unless $e->checkauth;
1391 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1393 my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->die_event;
1394 return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency);
1396 my $li_ids = $e->search_acq_lineitem({purchase_order => $po_id}, {idlist => 1});
1398 for my $li_id (@$li_ids) {
1399 receive_lineitem($mgr, $li_id) or return $e->die_event;
1403 $po->state('received');
1404 update_purchase_order($mgr, $po) or return $e->die_event;
1407 return $mgr->respond_complete;
1411 __PACKAGE__->register_method(
1412 method => 'receive_lineitem_detail_api',
1413 api_name => 'open-ils.acq.lineitem_detail.receive',
1415 desc => 'Mark a lineitem_detail as received',
1417 {desc => 'Authentication token', type => 'string'},
1418 {desc => 'lineitem detail ID', type => 'number'}
1420 return => {desc => '1 on success, Event on error'}
1424 sub receive_lineitem_detail_api {
1425 my($self, $conn, $auth, $lid_id) = @_;
1427 my $e = new_editor(xact=>1, authtoken=>$auth);
1428 return $e->die_event unless $e->checkauth;
1429 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1431 my $lid = $e->retrieve_acq_lineitem_detail([
1435 acqlid => ['lineitem'],
1436 jub => ['purchase_order']
1441 return $e->die_event unless $e->allowed(
1442 'RECEIVE_PURCHASE_ORDER', $lid->lineitem->purchase_order->ordering_agency);
1444 receive_lineitem_detail($mgr, $lid_id) or return $e->die_event;
1449 __PACKAGE__->register_method(
1450 method => 'receive_lineitem_api',
1451 api_name => 'open-ils.acq.lineitem.receive',
1453 desc => 'Mark a lineitem as received',
1455 {desc => 'Authentication token', type => 'string'},
1456 {desc => 'lineitem detail ID', type => 'number'}
1458 return => {desc => '1 on success, Event on error'}
1462 sub receive_lineitem_api {
1463 my($self, $conn, $auth, $li_id) = @_;
1465 my $e = new_editor(xact=>1, authtoken=>$auth);
1466 return $e->die_event unless $e->checkauth;
1467 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1469 my $li = $e->retrieve_acq_lineitem([
1473 jub => ['purchase_order']
1476 ]) or return $e->die_event;
1478 return $e->die_event unless $e->allowed(
1479 'RECEIVE_PURCHASE_ORDER', $li->purchase_order->ordering_agency);
1481 receive_lineitem($mgr, $li_id) or return $e->die_event;
1487 __PACKAGE__->register_method(
1488 method => 'rollback_receive_po_api',
1489 api_name => 'open-ils.acq.purchase_order.receive.rollback'
1492 sub rollback_receive_po_api {
1493 my($self, $conn, $auth, $po_id) = @_;
1494 my $e = new_editor(xact => 1, authtoken => $auth);
1495 return $e->die_event unless $e->checkauth;
1496 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1498 my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->die_event;
1499 return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency);
1501 my $li_ids = $e->search_acq_lineitem({purchase_order => $po_id}, {idlist => 1});
1503 for my $li_id (@$li_ids) {
1504 rollback_receive_lineitem($mgr, $li_id) or return $e->die_event;
1508 $po->state('on-order');
1509 update_purchase_order($mgr, $po) or return $e->die_event;
1512 return $mgr->respond_complete;
1516 __PACKAGE__->register_method(
1517 method => 'rollback_receive_lineitem_detail_api',
1518 api_name => 'open-ils.acq.lineitem_detail.receive.rollback',
1520 desc => 'Mark a lineitem_detail as received',
1522 {desc => 'Authentication token', type => 'string'},
1523 {desc => 'lineitem detail ID', type => 'number'}
1525 return => {desc => '1 on success, Event on error'}
1529 sub rollback_receive_lineitem_detail_api {
1530 my($self, $conn, $auth, $lid_id) = @_;
1532 my $e = new_editor(xact=>1, authtoken=>$auth);
1533 return $e->die_event unless $e->checkauth;
1534 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1536 my $lid = $e->retrieve_acq_lineitem_detail([
1540 acqlid => ['lineitem'],
1541 jub => ['purchase_order']
1545 my $li = $lid->lineitem;
1546 my $po = $li->purchase_order;
1548 return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency);
1549 rollback_receive_lineitem_detail($mgr, $lid_id) or return $e->die_event;
1551 $li->state('on-order');
1552 $po->state('on-order');
1553 udpate_lineitem($mgr, $li) or return $e->die_event;
1554 udpate_purchase_order($mgr, $po) or return $e->die_event;
1560 __PACKAGE__->register_method(
1561 method => 'rollback_receive_lineitem_api',
1562 api_name => 'open-ils.acq.lineitem.receive.rollback',
1564 desc => 'Mark a lineitem as received',
1566 {desc => 'Authentication token', type => 'string'},
1567 {desc => 'lineitem detail ID', type => 'number'}
1569 return => {desc => '1 on success, Event on error'}
1573 sub rollback_receive_lineitem_api {
1574 my($self, $conn, $auth, $li_id) = @_;
1576 my $e = new_editor(xact=>1, authtoken=>$auth);
1577 return $e->die_event unless $e->checkauth;
1578 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1580 my $li = $e->retrieve_acq_lineitem_detail([
1584 jub => ['purchase_order']
1588 my $po = $li->purchase_order;
1590 return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency);
1592 rollback_receive_lineitem($mgr, $li_id) or return $e->die_event;
1594 $po->state('on-order');
1595 update_purchase_order($mgr, $po) or return $e->die_event;
1602 __PACKAGE__->register_method(
1603 method => 'set_lineitem_price_api',
1604 api_name => 'open-ils.acq.lineitem.price.set',
1606 desc => 'Set lineitem price. If debits already exist, update them as well',
1608 {desc => 'Authentication token', type => 'string'},
1609 {desc => 'lineitem ID', type => 'number'}
1611 return => {desc => 'status blob, Event on error'}
1615 sub set_lineitem_price_api {
1616 my($self, $conn, $auth, $li_id, $price, $currency) = @_;
1618 my $e = new_editor(xact=>1, authtoken=>$auth);
1619 return $e->die_event unless $e->checkauth;
1620 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1624 my $li = $e->retrieve_acq_lineitem($li_id) or return $e->die_event;
1626 # update the local attr for estimated price
1629 attr_name => 'estimated_price',
1630 attr_type => 'lineitem_local_attr_definition',
1631 attr_value => $price,
1633 ) or return $e->die_event;
1635 my $lid_ids = $e->search_acq_lineitem_detail(
1636 {lineitem => $li_id, fund_debit => {'!=' => undef}},
1640 for my $lid_id (@$lid_ids) {
1642 my $lid = $e->retrieve_acq_lineitem_detail([
1644 flesh => 1, flesh_fields => {acqlid => ['fund', 'fund_debit']}}
1647 # onless otherwise specified, assume currency of new price is same as currency type of the fund
1648 $currency ||= $lid->fund->currency_type;
1649 my $amount = $price;
1651 if($lid->fund->currency_type ne $currency) {
1652 $amount = currency_conversion($mgr, $currency, $lid->fund->currency_type, $price);
1655 $lid->fund_debit->origin_currency_type($currency);
1656 $lid->fund_debit->origin_amount($price);
1657 $lid->fund_debit->amount($amount);
1659 $e->update_acq_fund_debit($lid->fund_debit) or return $e->die_event;
1665 return $mgr->respond_complete;
1669 __PACKAGE__->register_method(
1670 method => 'clone_picklist_api',
1671 api_name => 'open-ils.acq.picklist.clone',
1673 desc => 'Clones a picklist, including lineitem and lineitem details',
1675 {desc => 'Authentication token', type => 'string'},
1676 {desc => 'Picklist ID', type => 'number'},
1677 {desc => 'New Picklist Name', type => 'string'}
1679 return => {desc => 'status blob, Event on error'}
1683 sub clone_picklist_api {
1684 my($self, $conn, $auth, $pl_id, $name) = @_;
1686 my $e = new_editor(xact=>1, authtoken=>$auth);
1687 return $e->die_event unless $e->checkauth;
1688 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1690 my $old_pl = $e->retrieve_acq_picklist($pl_id);
1691 my $new_pl = create_picklist($mgr, %{$old_pl->to_bare_hash}, name => $name) or return $e->die_event;
1693 my $li_ids = $e->search_acq_lineitem({picklist => $pl_id}, {idlist => 1});
1695 for my $li_id (@$li_ids) {
1697 # copy the lineitems
1698 my $li = $e->retrieve_acq_lineitem($li_id);
1699 my $new_li = create_lineitem($mgr, %{$li->to_bare_hash}, picklist => $new_pl->id) or return $e->die_event;
1701 my $lid_ids = $e->search_acq_lineitem_detail({lineitem => $li_id}, {idlist => 1});
1702 for my $lid_id (@$lid_ids) {
1704 # copy the lineitem details
1705 my $lid = $e->retrieve_acq_lineitem_detail($lid_id);
1706 create_lineitem_detail($mgr, %{$lid->to_bare_hash}, lineitem => $new_li->id) or return $e->die_event;
1713 return $mgr->respond_complete;
1717 __PACKAGE__->register_method(
1718 method => 'merge_picklist_api',
1719 api_name => 'open-ils.acq.picklist.merge',
1721 desc => 'Merges 2 or more picklists into a single list',
1723 {desc => 'Authentication token', type => 'string'},
1724 {desc => 'Lead Picklist ID', type => 'number'},
1725 {desc => 'List of subordinate picklist IDs', type => 'array'}
1727 return => {desc => 'status blob, Event on error'}
1731 sub merge_picklist_api {
1732 my($self, $conn, $auth, $lead_pl, $pl_list) = @_;
1734 my $e = new_editor(xact=>1, authtoken=>$auth);
1735 return $e->die_event unless $e->checkauth;
1736 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1738 # XXX perms on each picklist modified
1740 # point all of the lineitems at the lead picklist
1741 my $li_ids = $e->search_acq_lineitem({picklist => $pl_list}, {idlist => 1});
1743 for my $li_id (@$li_ids) {
1744 my $li = $e->retrieve_acq_lineitem($li_id);
1745 $li->picklist($lead_pl);
1746 update_lineitem($mgr, $li) or return $e->die_event;
1750 # now delete the subordinate lists
1751 for my $pl_id (@$pl_list) {
1752 my $pl = $e->retrieve_acq_picklist($pl_id);
1753 $e->delete_acq_picklist($pl) or return $e->die_event;
1757 return $mgr->respond_complete;
1761 __PACKAGE__->register_method(
1762 method => 'delete_picklist_api',
1763 api_name => 'open-ils.acq.picklist.delete',
1765 desc => q/Deletes a picklist. It also deletes any lineitems in the "new" state.
1766 Other attached lineitems are detached'/,
1768 {desc => 'Authentication token', type => 'string'},
1769 {desc => 'Picklist ID to delete', type => 'number'}
1771 return => {desc => '1 on success, Event on error'}
1775 sub delete_picklist_api {
1776 my($self, $conn, $auth, $picklist_id) = @_;
1777 my $e = new_editor(xact=>1, authtoken=>$auth);
1778 return $e->die_event unless $e->checkauth;
1779 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1780 my $pl = $e->retrieve_acq_picklist($picklist_id) or return $e->die_event;
1781 delete_picklist($mgr, $pl) or return $e->die_event;
1783 return $mgr->respond_complete;
1788 __PACKAGE__->register_method(
1789 method => 'activate_purchase_order',
1790 api_name => 'open-ils.acq.purchase_order.activate',
1792 desc => q/Activates a purchase order. This updates the status of the PO
1793 and Lineitems to 'on-order'. Activated PO's are ready for EDI delivery
1796 {desc => 'Authentication token', type => 'string'},
1797 {desc => 'Purchase ID', type => 'number'}
1799 return => {desc => '1 on success, Event on error'}
1803 sub activate_purchase_order {
1804 my($self, $conn, $auth, $po_id) = @_;
1805 my $e = new_editor(xact=>1, authtoken=>$auth);
1806 return $e->die_event unless $e->checkauth;
1807 my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1809 my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->die_event;
1810 return $e->die_event unless $e->allowed('CREATE_PURCHASE_ORDER', $po->ordering_agency);
1812 $po->state('on-order');
1813 update_purchase_order($mgr, $po) or return $e->die_event;
1816 {purchase_order => $po_id, state => 'pending-order'},
1820 while( my $li = $e->search_acq_lineitem($query)->[0] ) {
1821 $li->state('on-order');
1822 update_lineitem($mgr, $li) or return $e->die_event;
1831 __PACKAGE__->register_method(
1832 method => 'split_purchase_order_by_lineitems',
1833 api_name => 'open-ils.acq.purchase_order.split_by_lineitems',
1835 desc => q/Splits a PO into many POs, 1 per lineitem. Only works for
1836 POs a) with more than one lineitems, and b) in the "pending" state./,
1838 {desc => 'Authentication token', type => 'string'},
1839 {desc => 'Purchase order ID', type => 'number'}
1841 return => {desc => 'list of new PO IDs on success, Event on error'}
1845 sub split_purchase_order_by_lineitems {
1846 my ($self, $conn, $auth, $po_id) = @_;
1848 my $e = new_editor("xact" => 1, "authtoken" => $auth);
1849 return $e->die_event unless $e->checkauth;
1851 my $po = $e->retrieve_acq_purchase_order([
1854 "flesh_fields" => {"acqpo" => [qw/lineitems notes/]}
1856 ]) or return $e->die_event;
1858 return $e->die_event
1859 unless $e->allowed("CREATE_PURCHASE_ORDER", $po->ordering_agency);
1861 unless ($po->state eq "pending") {
1863 return new OpenILS::Event("ACQ_PURCHASE_ORDER_TOO_LATE");
1866 unless (@{$po->lineitems} > 1) {
1868 return new OpenILS::Event("ACQ_PURCHASE_ORDER_TOO_SHORT");
1871 # To split an existing PO into many, it seems unwise to just delete the
1872 # original PO, so we'll instead detach all of the original POs' lineitems
1873 # but the first, then create new POs for each of the remaining LIs, and
1874 # then attach the LIs to their new POs.
1876 my @po_ids = ($po->id);
1877 my @moving_li = @{$po->lineitems};
1878 shift @moving_li; # discard first LI
1880 foreach my $li (@moving_li) {
1881 my $new_po = $po->clone;
1883 $new_po->clear_name;
1884 $new_po->creator($e->requestor->id);
1885 $new_po->editor($e->requestor->id);
1886 $new_po->owner($e->requestor->id);
1887 $new_po->edit_time("now");
1888 $new_po->create_time("now");
1890 $new_po = $e->create_acq_purchase_order($new_po);
1892 # Clone any notes attached to the old PO and attach to the new one.
1893 foreach my $note (@{$po->notes}) {
1894 my $new_note = $note->clone;
1895 $new_note->clear_id;
1896 $new_note->edit_time("now");
1897 $new_note->purchase_order($new_po->id);
1898 $e->create_acq_po_note($new_note);
1901 $li->edit_time("now");
1902 $li->purchase_order($new_po->id);
1903 $e->update_acq_lineitem($li);
1905 push @po_ids, $new_po->id;
1908 $po->edit_time("now");
1909 $e->update_acq_purchase_order($po);
1911 return \@po_ids if $e->commit;
1912 return $e->die_event;