From: Lebbeous Fogle-Weekley Date: Thu, 21 Feb 2013 22:15:13 +0000 (-0500) Subject: Acq batch updater - apply distribution formulas too (with added fields) X-Git-Url: https://old-git.evergreen-ils.org/?a=commitdiff_plain;h=4f72c97d12890b886a113a25009046d14f91b1ef;p=evergreen%2Fequinox.git Acq batch updater - apply distribution formulas too (with added fields) Also fixed incorrect description of ACQ_LINEITEM_NOT_FOUND event. Now the REAL testing begins. Signed-off-by: Lebbeous Fogle-Weekley --- diff --git a/Open-ILS/examples/fm_IDL.xml b/Open-ILS/examples/fm_IDL.xml index ce64b5fb9b..5deb8525af 100644 --- a/Open-ILS/examples/fm_IDL.xml +++ b/Open-ILS/examples/fm_IDL.xml @@ -8432,11 +8432,16 @@ SELECT usr, + + + + + diff --git a/Open-ILS/src/extras/ils_events.xml b/Open-ILS/src/extras/ils_events.xml index c37226beb7..3a4c65035b 100644 --- a/Open-ILS/src/extras/ils_events.xml +++ b/Open-ILS/src/extras/ils_events.xml @@ -652,7 +652,7 @@ The requested acq.funding_source_balance was not found - The requested acq.po_lineitem was not found + The requested acq.lineitem was not found The requested acq.purchase_order was not found diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/Lineitem/BatchUpdate.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/Lineitem/BatchUpdate.pm index a501701083..2c63139e82 100644 --- a/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/Lineitem/BatchUpdate.pm +++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/Lineitem/BatchUpdate.pm @@ -9,6 +9,7 @@ use base qw/OpenILS::Application/; # OpenILS::Application::Acq::Lineitem. Only those that export symbols # need to be mentioned explicitly here. +use List::Util qw/reduce/; use OpenSRF::Utils::Logger qw/:logger/; use OpenILS::Utils::CStoreEditor q/:funcs/; @@ -64,9 +65,7 @@ sub lineitem_batch_update_perm_test { my %present = map { $_->{id} => 1 } @$li_rows; my @missing = grep { not exists $present{$_} } @{$target->{lineitems}}; return $e->die_event( - new OpenILS::Event( - "ACQ_LINEITEM_NOT_FOUND", payload => \@missing - ) + new OpenILS::Event("ACQ_LINEITEM_NOT_FOUND", payload => \@missing) ) if @missing; # To avoid repetition of perm tests, track them here. @@ -128,109 +127,221 @@ sub lineitem_batch_update_perm_test { return; # perm check pass } + +# $changes->{item_count} wins over distribution formula if both are present. +# It's also ok for neither to be present. +sub pick_winning_item_count { + my ($changes, $dist_formula) = @_; + + if (exists $changes->{item_count}) { + return $changes->{item_count}; + } elsif ($dist_formula) { + return reduce { $a + $b->item_count } 0, @{$dist_formula->entries}; + } + + return; +} + + +# pick_winning_change() should be called in list context, so the caller can +# distinguish between empty result (no change at all) and undef result (clear +# field). +sub pick_winning_change { + my ($changes, $dist_formula, $field, $position) = @_; + + if (exists $changes->{$field}) { + # Remember: in $changes, not exists means no change, while undef + # means clear. + + return $changes->{$field} if $position >= $changes->{position}; + } + + if ($dist_formula) { + my $hit; + + my $count_over_entries = 0; + foreach my $entry (@{$dist_formula->entries}) { + $count_over_entries += $entry->item_count; + + if ($count_over_entries > $position) { + # Abuse this virtual field on the distribution formula + # to let the caller know we actually used it. + + $dist_formula->use_count(($dist_formula->use_count || 0) + 1); + $hit = $entry->$field; + last; + } + } + + # The database doesn't give us a way to distinguish between "not exists" + # and undef like a hash does, so for dist formulas, undef (null) has + # to mean no change, and so if we come up with nothing defined, we + # don't return anything, not even the undef, since that would be + # misunderstood by the caller. + return $hit if defined $hit; + } + + return; # return nothing, not even undef (in list context, anyway) +} + + +# adjust_lineitem_copy_counts() directly changes contents of @$lineitems +sub adjust_lineitem_copy_counts { + my ($lineitems, $item_count) = @_; + + # Count how many lineitem details we have per lineitem, and for + # each lineitem add or remove lineitems to match $item_count, as needed. + + my %counts; + + foreach my $jub (@$lineitems) { + $counts{$jub->id} = scalar @{$jub->lineitem_details}; + + if ($counts{$jub->id} > $item_count) { + # Take care of excess lineitem details. + + for (my $i = $item_count; $i < $counts{$jub->id}; $i++) { + $jub->lineitem_details->[$i]->isdeleted(1); + } + } elsif ($counts{$jub->id} < $item_count) { + # Add missing lineitem details. + + for (my $i = $counts{$jub->id}; $i < $item_count; $i++) { + my $lid = new Fieldmapper::acq::lineitem_detail; + $lid->isnew(1); + $lid->lineitem($jub->id); + + push @{$jub->lineitem_details}, $lid; + } + } + } +} + + # lineitem_batch_update_impl() should be handed everything pre-perm-checked # and ready-to-go. $e is in a transaction. sub lineitem_batch_update_impl { my ($conn, $e, $dry_run, $target, $changes, $dist_formula) = @_; - # Keep client's attention + # Keep client's attention. $conn->status(new OpenSRF::DomainObject::oilsContinueStatus); - # First, retrieve existing lineitem details. + # First, retrieve existing lineitems with lineitem details. We could do + # with the lineitem details only if not for having to catch lineitems + # with zero current lineitem details, so that we can augment those if + # requested by the user via $changes->{item_count}. # The right ordering is important for adjusting lineitem detail counts. my %order_by = (order_by => [ - {class => "acqlid", field => "lineitem"}, + {class => "jub", field => "id"}, {class => "acqlid", field => "id"} ]); - my $lineitem_details; + # XXX The following could be refactored only to retrieve one lineitem at a + # time, since the list of fleshed lineitem_details could conceivably be + # very long for each one. We'd then update each lineitem_detail on that + # lineitem before proceeding to the next. + + my $lineitems; if ($target->{lineitems}) { - $lineitem_details = $e->search_acq_lineitem_detail( - {lineitem => $target->{lineitems}}, \%order_by - ) or return $e->die_event; + $lineitems = $e->search_acq_lineitem([ + {id => $target->{lineitems}}, + {flesh => 1, + flesh_fields => {"jub" => ["lineitem_details"]}, %order_by} + ]) or return $e->die_event; } else { my $where; if ($target->{purchase_order}) { - $where = {"+jub" => {purchase_order => $target->{purchase_order}}}; - } else { # picklist - $where = {"+jub" => {picklist => $target->{picklist}}}; + $where = {purchase_order => $target->{purchase_order}}; + } else { + $where = {picklist => $target->{picklist}}; } - $lineitem_details = $e->search_acq_lineitem_detail([ - $where, {join => "jub", %order_by} + $lineitems = $e->search_acq_lineitem([ + $where, + {flesh => 1, + flesh_fields => {"jub" => ["lineitem_details"]}, %order_by} ]) or return $e->die_event; } # XXX Is this the best way to tell the client not to get bored at this # point? Or substream on previous search_*()? Ask berick. $conn->status(new OpenSRF::DomainObject::oilsContinueStatus); + $logger->info( + "lineitem_batch_update_impl() working with " . + scalar(@$lineitems) . " lineitems" + ); - # [Part 1] Count how many lineitem details we have per lineitem, and for - # each lineitem add or remove lineitems to match $changes->{count}, as - # needed. + my $item_count = pick_winning_item_count($changes, $dist_formula); + adjust_lineitem_copy_counts($lineitems, $item_count) if defined $item_count; - my %counts; - foreach my $lid (@$lineitem_details) { - $counts{$lid->lineitem} ||= 0; - $counts{$lid->lineitem}++; - - # [Part 1a] Take care of excess lineitem details. - if ($counts{$lid->lineitem} > $changes->{count}) { - $e->delete_acq_lineitem_detail($lid) or return $e->die_event; - $counts{$lid->lineitem}--; - } - } + # Now, going through all our lineitem details, make the updates + # called for in $changes, other than the 'item_count' field (handled above). - # [Part 1b] Add missing lineitem details. - foreach my $lineitem_id (grep { $_ < $changes->{count} } (keys %counts)) { - for (my $i = $counts{$lineitem_id}; $i < $changes->{count}; $i++) { - my $lid = new Fieldmapper::acq::lineitem_detail; - $lid->isnew(1); - $lid->lineitem($lineitem_id); + my @fields = qw/owning_lib fund location collection_code circ_modifer/; + foreach my $jub (@$lineitems) { + # We use the counting style of loop below because we need to know our + # position for dist_formula application. - push @$lineitem_details, $lid; - } - } + my $starting_use_count = + $dist_formula ? $dist_formula->use_count : undef; - # [Part 1c] Sort lineitem details again so that we can send responses in - # grouped together when we create/update them. - $lineitem_details = [ - sort { $a->lineitem <=> $b->lineitem } @$lineitem_details - ]; + for (my $i = 0; $i < scalar @{$jub->lineitem_details}; $i++) { + my $lid = $jub->lineitem_details->[$i]; - # [Pass 2] Now, going through all our lineitem details, make the updates - # called for in $changes, other than the 'count' field (handled above). + # Handle copies needing a delete. + if ($lid->isdeleted) { + $e->delete_acq_lineitem_detail($lid) or return $e->die_event; + next; + } - my $last_jub_id_sent = 0; + # Handle existing and new copies. + foreach my $field (@fields) { + # Calling pick_winning_change() in list context gets us an + # empty list for "no change to make", (undef) for "clear the + # field", and ($value) for "set the field to $value". - foreach my $lid (@$lineitem_details) { - foreach my $field (qw/owning_lib fund location collection_code circ_modifer/) { - # undef value in $changes should clear a field. - # Absence of value should do nothing to a field. + my @change = + pick_winning_change($changes, $dist_formula, $field, $i); - if (exists $changes->{$field}) { - if (not defined $changes->{$field}) { - my $meth = "clear_$field"; - $lid->$meth; - } else { - $lid->$field($changes->{$field}); + if (scalar @change) { + my $change = pop @change; + + if (not defined $change) { + my $meth = "clear_$field"; + $lid->$meth; + } else { + $lid->$field($change); + } } } + + my $method = ($lid->isnew ? "create" : "update") . + "_acq_lineitem_detail"; + + $e->$method($lid) or return $e->die_event; } - my $method = ($lid->isnew ? "create":"update") . "_acq_lineitem_detail"; - $e->$method($lid) or return $e->die_event; + if (defined $starting_use_count and + $dist_formula->use_count > $starting_use_count) { + + # Record the application of the distribution formula. + my $dfa = new Fieldmapper::acq::distribution_formula_application; - if ($lid->lineitem != $last_jub_id_sent) { - $conn->respond($lid->lineitem); - $last_jub_id_sent = $lid->lineitem; + $dfa->lineitem($jub->id); + $dfa->formula($dist_formula->id); + $dfa->creator($e->requestor->id); + + $e->create_acq_distribution_formula_application($dfa) or + return $e->die_event; } + + $conn->respond($jub->id); } - # Explicit bare return statements below avoid sending client extra data. + # Explicit bare return statements below avoid sending extra data to client. if ($dry_run) { $e->rollback; return; @@ -245,12 +356,12 @@ __PACKAGE__->register_method( method => "lineitem_batch_update_api", api_name => "open-ils.acq.lineitem.batch_update", signature => { - desc => "Apply changes to lineitems in batch", + desc => "Apply changes to the lineitem details realted to specified lineitems in batch", params => [ {desc => "Authentication token", type => "string"}, {desc => "Target. Object key must be one of lineitems, purchase_order or picklist. The value for 'lineitems' must be an array of IDs, and the values for either of the other two must be single IDs.", type => "object"}, {desc => "Changes (optional). If these changes conflict with distribution formula, these changes win.", type => "object"}, - {desc => "Distribution formula ID (optional)", type => "number"} + {desc => "Distribution formula ID (optional). Note that a distribution formula's 'skip_count' field does nothing, but the 'position' and 'item_count' fields of distribution formula *entries* do what they ought to. ", type => "number"} ], return => { desc => q/A stream of lineitem IDs affected upon success. Events @@ -275,14 +386,14 @@ __PACKAGE__->register_method( sub lineitem_batch_update_api { my ($self, $conn, $auth, $target, $changes, $dist_formula) = @_; - # Make sure that $changes->{count}, if it exists, is a natural number. + # Make sure that $changes->{item_count}, if it exists, is a natural number. # Other things in $change are safe to treat somewhat more casually, # except fund, which is handled later. $changes ||= {}; - if (exists $changes->{count}) { - $changes->{count} = int($changes->{count}); - return new OpenILS::Event("BAD_PARAMS", note => "changes (count)") - unless $changes->{count} >= 0; + if (exists $changes->{item_count}) { + $changes->{item_count} = int($changes->{item_count}); + return new OpenILS::Event("BAD_PARAMS", note => "changes (item_count)") + unless $changes->{item_count} >= 0; } # We want to do our perm tests and everything within a transaction. @@ -293,6 +404,10 @@ sub lineitem_batch_update_api { # (with entries fleshed) early so we can get a quick permission check # out of the way. if ($dist_formula) { + + # It's important that we NOT flesh use_count here, if that [ever] + # does anything. We're going to abuse that field internally. + $dist_formula = $e->acq->retrieve_acq_dist_formula([ int($dist_formula), {flesh=>1, flesh_fields=>["entries","fund"]} ]) or return $e->die_event; @@ -308,6 +423,11 @@ sub lineitem_batch_update_api { $dist_formula->fund->org, $dist_formula->fund ); } + + # The following sort is crucial later. + $dist_formula->entries([ + sort { $a->position cmp $b->position } @{$dist_formula->entries} + ]); } # Next, test permissions on fund to set, if any, from $changes. diff --git a/Open-ILS/src/sql/Pg/200.schema.acq.sql b/Open-ILS/src/sql/Pg/200.schema.acq.sql index aad60a4c2f..fa7be9e5aa 100644 --- a/Open-ILS/src/sql/Pg/200.schema.acq.sql +++ b/Open-ILS/src/sql/Pg/200.schema.acq.sql @@ -629,6 +629,9 @@ CREATE TABLE acq.distribution_formula_entry ( owning_lib INTEGER REFERENCES actor.org_unit(id) DEFERRABLE INITIALLY DEFERRED, location INTEGER REFERENCES asset.copy_location(id), + fund INTEGER REFERENCES acq.fund (id), + circ_mod TEXT REFERENCES config.circ_modifier (code), + collection_code TEXT, CONSTRAINT acqdfe_lib_once_per_formula UNIQUE( formula, position ), CONSTRAINT acqdfe_must_be_somewhere CHECK( owning_lib IS NOT NULL OR location IS NOT NULL ) diff --git a/Open-ILS/src/sql/Pg/upgrade/XXXX.schema.acq.distribution_formula.expansion.sql b/Open-ILS/src/sql/Pg/upgrade/XXXX.schema.acq.distribution_formula.expansion.sql new file mode 100644 index 0000000000..0d92162137 --- /dev/null +++ b/Open-ILS/src/sql/Pg/upgrade/XXXX.schema.acq.distribution_formula.expansion.sql @@ -0,0 +1,10 @@ +BEGIN; + +--SELECT evergreen.upgrade_deps_block_check('XXXX', :eg_version); + +ALTER TABLE acq.distribution_formula_entry + ADD COLUMN fund INT REFERENCES acq.fund (id), + ADD COLUMN circ_mod TEXT REFERENCES config.circ_modifier (code), + ADD COLUMN collection_code TEXT ; + +COMMIT;