# 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/;
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.
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;
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
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.
# (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;
$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.
projects / evergreen / equinox.git / commitdiff