use OpenILS::Application::Acq::Financials;
use OpenILS::Application::Cat::BibCommon;
use OpenILS::Application::Cat::AssetCommon;
+use OpenILS::Application::Acq::Lineitem::BatchUpdate;
my $U = 'OpenILS::Application::AppUtils';
return $li;
}
-# lineitem_batch_update_perm_test(), helper for lineitem_batch_update_api()
-#
-# Tests permissions on targeted lineitems, purchase orders, and picklists.
-# Returns undef on success, event on perm failure.
-# Responsible for calling $e->die_event.
-# Also sanitizes values in $target.
-#
-sub lineitem_batch_update_perm_test {
- my ($e, $target) = @_;
-
- return $e->die_event(new OpenILS::Event("BAD_PARAMS", note => "target"))
- unless ref $target eq "HASH";
-
- my $perm_for = {
- ordering_agency => "CREATE_PURCHASE_ORDER",
- org_unit => "UPDATE_PICKLIST"
- };
-
- if (ref $target->{lineitems} eq "ARRAY") {
- # Sanitization
- $target->{lineitems} = [ map { int $_ } @{$target->{lineitems}} ];
-
- return $e->die_event(
- new OpenILS::Event(
- "BAD_PARAMS", note => "target (lineitems list empty)"
- )
- ) unless @{$target->{lineitems}};
-
- # Get all PO & picklist linkings from lineitems in question.
- my $li_rows = $e->json_query({
- select => {
- jub => ["id"],
- acqpo => ["ordering_agency"],
- acqpl => ["org_unit"]
- },
- from => {
- jub => {acqpl => {type => "left"}, acqpo => {type => "left"}}
- },
- where => {
- "+jub" => {id => $target->{lineitems}}
- }
- }) or return $e->die_event;
-
- # Fail loudly rather than giving user any surprises if they asked to
- # update lineitems that don't exist. This is an asymmetric difference
- # calculation.
- 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
- )
- ) if @missing;
-
- # To avoid repetition of perm tests, track them here.
- my $already_done = {
- ordering_agency => {},
- org_unit => {}
- };
-
- # Test all lineitems based on the context OU of all linked POs AND PLs.
- foreach my $row (@$li_rows) {
- foreach my $field (keys %$already_done) {
- if ($row->{$field}) {
- if (not $already_done->{$row}{$field}) {
- my $perm = $perm_for->{$field};
- my $context = $row->{$field};
-
- if (not $e->allowed($perm, $context)) {
- my $evt = $e->die_event;
-
- # Take the PERM_FAILURE event and annotate it with
- # a list of the targeted lineitems that would fail
- # the same permission check (i.e. that have the
- # same context).
- $evt->{payload} = [
- map { $_->{id} } (
- grep { $_->{$field} == $context } @$li_rows
- )
- ];
- return $evt;
- } else {
- $already_done->{$row}{$field} = 1;
- }
- }
- }
- }
- }
- } elsif ($target->{purchase_order}) {
- $target->{purchase_order} = int($target->{purchase_order});
-
- my $po = $e->retrieve_acq_purchase_order($target->{purchase_order}) or
- return $e->die_event;
-
- return $e->die_event unless
- $e->allowed($perm_for->{ordering_agency}, $po->ordering_agency);
- } elsif ($target->{picklist}) {
- $target->{picklist} = int($target->{picklist});
-
- my $pl = $e->retrieve_acq_picklist($target->{picklist}) or
- return $e->die_event;
-
- return $e->die_event unless
- $e->allowed($perm_for->{org_unit}, $pl->org_unit);
- } else {
- return $e->die_event(
- new OpenILS::Event("BAD_PARAMS", note => "target")
- );
- }
-
- return; # perm check pass
-}
-
-# 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, $target, $changes, $dist_formula) = @_;
-
- # First, retrieve existing lineitem details.
-
- # The right ordering is important for adjusting lineitem detail counts.
- my %order_by = (order_by => [
- {class => "acqlid", field => "lineitem"},
- {class => "acqlid", field => "id"}
- ]);
-
- my $lineitem_details;
-
- if ($target->{lineitems}) {
- $lineitem_details = $e->search_acq_lineitem_detail(
- {lineitem => $target->{lineitems}}, \%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}}};
- }
-
- $lineitem_details = $e->search_acq_lineitem_detail(
- $where, {join => "jub", %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);
-
- # [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 %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}--;
- }
- }
-
- # [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);
-
- push @$lineitem_details, $lid;
- }
- }
-
- # [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
- ];
-
- # [Pass 2] Now, going through all our lineitem details, make the updates
- # called for in $changes, other than the 'count' field (handled above).
-
- my $last_jub_id_sent = 0;
-
- 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.
-
- if (exists $changes->{$field}) {
- if (not defined $changes->{$field}) {
- my $meth = "clear_$field";
- $lid->$meth;
- } else {
- $lid->$field($changes->{$field});
- }
- }
- }
-
- my $method = ($lid->isnew ? "create":"update") . "_acq_lineitem_detail";
- $e->$method($lid) or return $e->die_event;
-
- if ($lid->lineitem != $last_jub_id_sent) {
- $conn->respond($lid->lineitem);
- $last_jub_id_sent = $lid->lineitem;
- }
- }
-
- $e->commit;
-}
-
-
-__PACKAGE__->register_method(
- method => "lineitem_batch_update_api",
- api_name => "open-ils.acq.lineitem.batch_update",
- signature => {
- desc => "Apply changes to 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"}
- ],
- return => {
- # XXX TODO
- }
- }
-);
-
-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.
- # 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;
- }
-
- # We want to do our perm tests and everything within a transaction.
-
- my $e = new_editor(authtoken => $auth, xact => 1);
- return $e->die_event unless $e->checkauth;
-
- # If any distribution formula ID is given, fetch distribution formula
- # (with entries fleshed) early so we can get a quick permission check
- # out of the way.
- if ($dist_formula) {
- $dist_formula = $e->acq->retrieve_acq_dist_formula([
- int($dist_formula), {flesh=>1, flesh_fields=>["entries","fund"]}
- ]) or return $e->die_event;
-
- return $e->die_event unless
- $e->allowed("ADMIN_ACQ_DISTRIB_FORMULA", $dist_formula->owner);
-
- # If the distribution formula has a fund, there's an additional perm
- # test to do before proceeding.
- if ($dist_formula->fund) {
- return $e->die_event unless $e->allowed(
- ["ADMIN_FUND", "MANAGE_FUND"],
- $dist_formula->fund->org, $dist_formula->fund
- );
- }
- }
-
- # Next, test permissions on fund to set, if any, from $changes.
- # XXX TODO
-
- # Now test permissions on the targets. lineitem_batch_update_perm_test()
- # calls die_event() for us if needed. Has side-effect of target
- # sanitization.
- my $evt = lineitem_batch_update_perm_test($e, $target);
- return $evt if $U->event_code($evt);
-
- # Now do the actual work.
- return lineitem_batch_update_impl(
- $conn, $e, $target, $changes, $dist_formula
- );
-}
-
1;
--- /dev/null
+package OpenILS::Application::Acq::Lineitem::BatchUpdate;
+
+use strict;
+use warnings;
+
+use base qw/OpenILS::Application/;
+
+# All of the packages we might 'use' are already imported in
+# OpenILS::Application::Acq::Lineitem. Only those that export symbols
+# need to be mentioned explicitly here.
+
+use OpenSRF::Utils::Logger qw/:logger/;
+use OpenILS::Utils::CStoreEditor q/:funcs/;
+
+my $U = "OpenILS::Application::AppUtils";
+
+
+# lineitem_batch_update_perm_test(), helper for lineitem_batch_update_api()
+#
+# Tests permissions on targeted lineitems, purchase orders, and picklists.
+# Returns undef on success, event on perm failure.
+# Responsible for calling $e->die_event.
+# Also sanitizes values in $target.
+#
+sub lineitem_batch_update_perm_test {
+ my ($e, $target) = @_;
+
+ return $e->die_event(new OpenILS::Event("BAD_PARAMS", note => "target"))
+ unless ref $target eq "HASH";
+
+ my $perm_for = {
+ ordering_agency => "CREATE_PURCHASE_ORDER",
+ org_unit => "UPDATE_PICKLIST"
+ };
+
+ if (ref $target->{lineitems} eq "ARRAY") {
+ # Sanitization
+ $target->{lineitems} = [ map { int $_ } @{$target->{lineitems}} ];
+
+ return $e->die_event(
+ new OpenILS::Event(
+ "BAD_PARAMS", note => "target (lineitems list empty)"
+ )
+ ) unless @{$target->{lineitems}};
+
+ # Get all PO & picklist linkings from lineitems in question.
+ my $li_rows = $e->json_query({
+ select => {
+ jub => ["id"],
+ acqpo => ["ordering_agency"],
+ acqpl => ["org_unit"]
+ },
+ from => {
+ jub => {acqpl => {type => "left"}, acqpo => {type => "left"}}
+ },
+ where => {
+ "+jub" => {id => $target->{lineitems}}
+ }
+ }) or return $e->die_event;
+
+ # Fail loudly rather than giving user any surprises if they asked to
+ # update lineitems that don't exist. This is an asymmetric difference
+ # calculation.
+ 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
+ )
+ ) if @missing;
+
+ # To avoid repetition of perm tests, track them here.
+ my $already_done = {
+ ordering_agency => {},
+ org_unit => {}
+ };
+
+ # Test all lineitems based on the context OU of all linked POs AND PLs.
+ foreach my $row (@$li_rows) {
+ foreach my $field (keys %$already_done) {
+ if ($row->{$field}) {
+ if (not $already_done->{$row}{$field}) {
+ my $perm = $perm_for->{$field};
+ my $context = $row->{$field};
+
+ if (not $e->allowed($perm, $context)) {
+ my $evt = $e->die_event;
+
+ # Take the PERM_FAILURE event and annotate it with
+ # a list of the targeted lineitems that would fail
+ # the same permission check (i.e. that have the
+ # same context).
+ $evt->{payload} = [
+ map { $_->{id} } (
+ grep { $_->{$field} == $context } @$li_rows
+ )
+ ];
+ return $evt;
+ } else {
+ $already_done->{$row}{$field} = 1;
+ }
+ }
+ }
+ }
+ }
+ } elsif ($target->{purchase_order}) {
+ $target->{purchase_order} = int($target->{purchase_order});
+
+ my $po = $e->retrieve_acq_purchase_order($target->{purchase_order}) or
+ return $e->die_event;
+
+ return $e->die_event unless
+ $e->allowed($perm_for->{ordering_agency}, $po->ordering_agency);
+ } elsif ($target->{picklist}) {
+ $target->{picklist} = int($target->{picklist});
+
+ my $pl = $e->retrieve_acq_picklist($target->{picklist}) or
+ return $e->die_event;
+
+ return $e->die_event unless
+ $e->allowed($perm_for->{org_unit}, $pl->org_unit);
+ } else {
+ return $e->die_event(
+ new OpenILS::Event("BAD_PARAMS", note => "target")
+ );
+ }
+
+ return; # perm check pass
+}
+
+# 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
+ $conn->status(new OpenSRF::DomainObject::oilsContinueStatus);
+
+ # First, retrieve existing lineitem details.
+
+ # The right ordering is important for adjusting lineitem detail counts.
+ my %order_by = (order_by => [
+ {class => "acqlid", field => "lineitem"},
+ {class => "acqlid", field => "id"}
+ ]);
+
+ my $lineitem_details;
+
+ if ($target->{lineitems}) {
+ $lineitem_details = $e->search_acq_lineitem_detail(
+ {lineitem => $target->{lineitems}}, \%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}}};
+ }
+
+ $lineitem_details = $e->search_acq_lineitem_detail([
+ $where, {join => "jub", %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);
+
+ # [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 %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}--;
+ }
+ }
+
+ # [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);
+
+ push @$lineitem_details, $lid;
+ }
+ }
+
+ # [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
+ ];
+
+ # [Pass 2] Now, going through all our lineitem details, make the updates
+ # called for in $changes, other than the 'count' field (handled above).
+
+ my $last_jub_id_sent = 0;
+
+ 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.
+
+ if (exists $changes->{$field}) {
+ if (not defined $changes->{$field}) {
+ my $meth = "clear_$field";
+ $lid->$meth;
+ } else {
+ $lid->$field($changes->{$field});
+ }
+ }
+ }
+
+ my $method = ($lid->isnew ? "create":"update") . "_acq_lineitem_detail";
+ $e->$method($lid) or return $e->die_event;
+
+ if ($lid->lineitem != $last_jub_id_sent) {
+ $conn->respond($lid->lineitem);
+ $last_jub_id_sent = $lid->lineitem;
+ }
+ }
+
+ # Explicit bare return statements below avoid sending client extra data.
+ if ($dry_run) {
+ $e->rollback;
+ return;
+ } else {
+ $e->commit or return $e->die_event;
+ return;
+ }
+}
+
+
+__PACKAGE__->register_method(
+ method => "lineitem_batch_update_api",
+ api_name => "open-ils.acq.lineitem.batch_update",
+ signature => {
+ desc => "Apply changes to 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"}
+ ],
+ return => {
+ desc => q/A stream of lineitem IDs affected upon success. Events
+ on failure. ANY events in the results, even after any number
+ of lineitem IDs, should be interpreted by the client to mean
+ that a rollback has happened and nothing has changed./,
+ type => "mixed"
+ }
+ }
+);
+
+__PACKAGE__->register_method(
+ method => "lineitem_batch_update_api",
+ api_name => "open-ils.acq.lineitem.batch_update.dry_run",
+ signature => {
+ desc => "Impotent version of open-ils.acq.lineitem.batch_update that always ends in a rollback",
+ params => "See open-ils.acq.lineitem.batch_update",
+ return => "See open-ils.acq.lineitem.batch_update"
+ }
+);
+
+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.
+ # 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;
+ }
+
+ # We want to do our perm tests and everything within a transaction.
+ my $e = new_editor(authtoken => $auth, xact => 1);
+ return $e->die_event unless $e->checkauth;
+
+ # If any distribution formula ID is given, fetch distribution formula
+ # (with entries fleshed) early so we can get a quick permission check
+ # out of the way.
+ if ($dist_formula) {
+ $dist_formula = $e->acq->retrieve_acq_dist_formula([
+ int($dist_formula), {flesh=>1, flesh_fields=>["entries","fund"]}
+ ]) or return $e->die_event;
+
+ return $e->die_event unless
+ $e->allowed("ADMIN_ACQ_DISTRIB_FORMULA", $dist_formula->owner);
+
+ # If the distribution formula has a fund, there's an additional perm
+ # test to do before proceeding.
+ if ($dist_formula->fund) {
+ return $e->die_event unless $e->allowed(
+ ["ADMIN_FUND", "MANAGE_FUND"],
+ $dist_formula->fund->org, $dist_formula->fund
+ );
+ }
+ }
+
+ # Next, test permissions on fund to set, if any, from $changes.
+ if ($changes->{fund}) {
+ my $fund = $e->retrieve_acq_fund($changes->{fund}) or
+ return $e->die_event;
+
+ return $e->die_event unless
+ $e->allowed(["ADMIN_FUND", "MANAGE_FUND"], $fund->org, $fund);
+ }
+
+ # Now test permissions on the targets. lineitem_batch_update_perm_test()
+ # calls die_event() for us if needed. Has side-effect of target
+ # sanitization.
+ my $evt = lineitem_batch_update_perm_test($e, $target);
+ return $evt if $U->event_code($evt);
+
+ # Finally do the actual work.
+ return lineitem_batch_update_impl(
+ $conn, $e, scalar($self->api_name =~ /dry_run/),
+ $target, $changes, $dist_formula
+ );
+}
+
+1;
projects / evergreen / equinox.git / commitdiff