From: Lebbeous Fogle-Weekley Date: Tue, 19 Feb 2013 22:34:51 +0000 (-0500) Subject: Acq: move batch update stuff to new file, fix some errors, still testing X-Git-Url: https://old-git.evergreen-ils.org/?a=commitdiff_plain;h=0dc4d210409f6fe0c03fb0d6829a99748c46f479;p=evergreen%2Fequinox.git Acq: move batch update stuff to new file, fix some errors, still testing Signed-off-by: Lebbeous Fogle-Weekley --- diff --git a/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/Lineitem.pm b/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/Lineitem.pm index c221e74d8f..852a561ce2 100644 --- a/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/Lineitem.pm +++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/Lineitem.pm @@ -12,6 +12,7 @@ use OpenILS::Application::AppUtils; 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'; @@ -941,291 +942,4 @@ sub retrieve_lineitem_by_copy_id { 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; 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 new file mode 100644 index 0000000000..a501701083 --- /dev/null +++ b/Open-ILS/src/perlmods/lib/OpenILS/Application/Acq/Lineitem/BatchUpdate.pm @@ -0,0 +1,335 @@ +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;