[open-ils-commits] r15679 - in trunk/Open-ILS/src/perlmods/OpenILS/Application: . Acq (senator)
svn at svn.open-ils.org
svn at svn.open-ils.org
Wed Mar 3 14:18:59 EST 2010
Author: senator
Date: 2010-03-03 14:18:55 -0500 (Wed, 03 Mar 2010)
New Revision: 15679
Added:
trunk/Open-ILS/src/perlmods/OpenILS/Application/Acq/Search.pm
Modified:
trunk/Open-ILS/src/perlmods/OpenILS/Application/Acq.pm
trunk/Open-ILS/src/perlmods/OpenILS/Application/Acq/Lineitem.pm
trunk/Open-ILS/src/perlmods/OpenILS/Application/Acq/Picklist.pm
Log:
Acq: middle-layer support for unified lineitem/purchase order/picklist search
Modified: trunk/Open-ILS/src/perlmods/OpenILS/Application/Acq/Lineitem.pm
===================================================================
--- trunk/Open-ILS/src/perlmods/OpenILS/Application/Acq/Lineitem.pm 2010-03-03 17:44:54 UTC (rev 15678)
+++ trunk/Open-ILS/src/perlmods/OpenILS/Application/Acq/Lineitem.pm 2010-03-03 19:18:55 UTC (rev 15679)
@@ -84,12 +84,15 @@
my($self, $conn, $auth, $li_id, $options) = @_;
my $e = new_editor(authtoken=>$auth);
return $e->die_event unless $e->checkauth;
+ return retrieve_lineitem_impl($e, $li_id, $options);
+}
+
+sub retrieve_lineitem_impl {
+ my ($e, $li_id, $options) = @_;
$options ||= {};
# XXX finer grained perms...
- my $li;
-
my $flesh = {};
if($$options{flesh_attrs} or $$options{flesh_notes}) {
$flesh = {flesh => 2, flesh_fields => {jub => []}};
@@ -100,7 +103,7 @@
push(@{$flesh->{flesh_fields}->{jub}}, 'attributes') if $$options{flesh_attrs};
}
- $li = $e->retrieve_acq_lineitem([$li_id, $flesh]);
+ my $li = $e->retrieve_acq_lineitem([$li_id, $flesh]);
if($$options{flesh_li_details}) {
my $ops = {
@@ -117,7 +120,16 @@
$li->item_count(scalar(@$details));
}
- if($li->picklist) {
+ if($li->purchase_order) {
+ my $purchase_order =
+ $e->retrieve_acq_purchase_order($li->purchase_order)
+ or return $e->event;
+
+ if($purchase_order->owner != $e->requestor->id) {
+ return $e->event unless
+ $e->allowed('VIEW_PURCHASE_ORDER', undef, $purchase_order);
+ }
+ } elsif($li->picklist) {
my $picklist = $e->retrieve_acq_picklist($li->picklist)
or return $e->event;
Modified: trunk/Open-ILS/src/perlmods/OpenILS/Application/Acq/Picklist.pm
===================================================================
--- trunk/Open-ILS/src/perlmods/OpenILS/Application/Acq/Picklist.pm 2010-03-03 17:44:54 UTC (rev 15678)
+++ trunk/Open-ILS/src/perlmods/OpenILS/Application/Acq/Picklist.pm 2010-03-03 19:18:55 UTC (rev 15679)
@@ -104,6 +104,13 @@
my $e = new_editor(authtoken=>$auth);
return $e->event unless $e->checkauth;
+ return retrieve_picklist_impl($e, $picklist_id, $options);
+}
+
+sub retrieve_picklist_impl {
+ my ($e, $picklist_id, $options) = @_;
+ $options ||= {};
+
my $picklist = $e->retrieve_acq_picklist($picklist_id)
or return $e->event;
Added: trunk/Open-ILS/src/perlmods/OpenILS/Application/Acq/Search.pm
===================================================================
--- trunk/Open-ILS/src/perlmods/OpenILS/Application/Acq/Search.pm (rev 0)
+++ trunk/Open-ILS/src/perlmods/OpenILS/Application/Acq/Search.pm 2010-03-03 19:18:55 UTC (rev 15679)
@@ -0,0 +1,251 @@
+package OpenILS::Application::Acq::Search;
+use base "OpenILS::Application";
+
+use strict;
+use warnings;
+
+use OpenILS::Event;
+use OpenILS::Utils::CStoreEditor q/:funcs/;
+use OpenILS::Utils::Fieldmapper;
+use OpenILS::Application::Acq::Lineitem;
+use OpenILS::Application::Acq::Financials;
+use OpenILS::Application::Acq::Picklist;
+
+my %RETRIEVERS = (
+ "lineitem" =>
+ \&{"OpenILS::Application::Acq::Lineitem::retrieve_lineitem_impl"},
+ "picklist" =>
+ \&{"OpenILS::Application::Acq::Picklist::retrieve_picklist_impl"},
+ "purchase_order" => \&{
+ "OpenILS::Application::Acq::Financials::retrieve_purchase_order_impl"
+ }
+);
+
+sub F { $Fieldmapper::fieldmap->{"Fieldmapper::" . $_[0]}; }
+
+# This subroutine returns 1 if the argument is a) a scalar OR
+# b) an array of ONLY scalars. Otherwise it returns 0.
+sub check_1d_max {
+ my ($o) = @_;
+ return 1 unless ref $o;
+ if (ref($o) eq "ARRAY") {
+ foreach (@$o) { return 0 if ref $_; }
+ return 1;
+ }
+ 0;
+}
+
+# Returns 1 if and only if argument is an array of exactly two scalars.
+sub could_be_range {
+ my ($o) = @_;
+ if (ref $o eq "ARRAY") {
+ return 1 if (scalar(@$o) == 2 && (!ref $o->[0] && !ref $o->[1]));
+ }
+ 0;
+}
+
+sub prepare_acqlia_search_and {
+ my ($acqlia) = @_;
+
+ my @phrases = ();
+ foreach my $unit (@{$acqlia}) {
+ my $something = 0;
+ my $subquery = {
+ "select" => {"acqlia" => ["id"]},
+ "from" => "acqlia",
+ "where" => {"-and" => [{"lineitem" => {"=" => {"+jub" => "id"}}}]}
+ };
+
+ while (my ($k, $v) = each %$unit) {
+ my $point = $subquery->{"where"}->{"-and"};
+ if ($k !~ /^__/) {
+ push @$point, {"definition" => $k};
+ $something++;
+
+ if ($unit->{"__fuzzy"} and not ref $v) {
+ push @$point, {"attr_value" => {"ilike" => "%" . $v . "%"}};
+ } elsif ($unit->{"__between"} and could_be_range($v)) {
+ push @$point, {"attr_value" => {"between" => $v}};
+ } elsif (check_1d_max($v)) {
+ push @$point, {"attr_value" => $v};
+ } else {
+ $something--;
+ }
+ }
+ }
+ push @phrases, {"-exists" => $subquery} if $something;
+ }
+ @phrases;
+}
+
+sub prepare_acqlia_search_or {
+ my ($acqlia) = @_;
+
+ my $point = [];
+ my $result = {"+acqlia" => {"-or" => $point}};
+
+ foreach my $unit (@$acqlia) {
+ while (my ($k, $v) = each %$unit) {
+ if ($k !~ /^__/) {
+ if ($unit->{"__fuzzy"} and not ref $v) {
+ push @$point, {
+ "-and" => {
+ "definition" => $k,
+ "attr_value" => {"ilike" => "%" . $v . "%"}
+ }
+ };
+ } elsif ($unit->{"__between"} and could_be_range($v)) {
+ push @$point, {
+ "-and" => {
+ "definition" => $k,
+ "attr_value" => {"between" => $v}
+ }
+ };
+ } elsif (check_1d_max($v)) {
+ push @$point, {
+ "-and" => {"definition" => $k, "attr_value" => $v}
+ };
+ } else {
+ next;
+ }
+ last;
+ }
+ }
+ }
+ $result;
+}
+
+sub prepare_terms {
+ my ($terms, $is_and) = @_;
+
+ my $conj = $is_and ? "-and" : "-or";
+ my $outer_clause = {};
+
+ foreach my $class (qw/acqpo acqpl jub/) {
+ next if not exists $terms->{$class};
+
+ my $clause = [];
+ $outer_clause->{$conj} = [] unless $outer_clause->{$conj};
+ foreach my $unit (@{$terms->{$class}}) {
+ while (my ($k, $v) = each %$unit) {
+ if ($k !~ /^__/) {
+ if ($unit->{"__fuzzy"} and not ref $v) {
+ push @$clause, {$k => {"ilike" => "%" . $v . "%"}};
+ } elsif ($unit->{"__between"} and could_be_range($v)) {
+ push @$clause, {$k => {"between" => $v}};
+ } elsif (check_1d_max($v)) {
+ push @$clause, {$k => $v};
+ }
+ }
+ }
+ }
+ push @{$outer_clause->{$conj}}, {"+" . $class => $clause};
+ }
+
+ if ($terms->{"acqlia"}) {
+ push @{$outer_clause->{$conj}},
+ $is_and ? prepare_acqlia_search_and($terms->{"acqlia"}) :
+ prepare_acqlia_search_or($terms->{"acqlia"});
+ }
+
+ return undef unless scalar keys %$outer_clause;
+ $outer_clause;
+}
+
+__PACKAGE__->register_method(
+ method => "grand_search",
+ api_name => "open-ils.acq.lineitem.grand_search",
+ signature => {
+ desc => q/Returns lineitems based on flexible search terms./,
+ params => [
+ {desc => "Authentication token", type => "string"},
+ {desc => "Field/value pairs for AND'ing", type => "object"},
+ {desc => "Field/value pairs for OR'ing", type => "object"},
+ {desc => "Conjunction between AND pairs and OR pairs " .
+ "(can be 'and' or 'or')", type => "string"},
+ {desc => "Retrieval options (clear_marc, flesh_notes, etc) " .
+ "- XXX detail all the options",
+ type => "object"}
+ ],
+ return => {desc => "A stream of LIs on success, Event on failure"}
+ }
+);
+
+__PACKAGE__->register_method(
+ method => "grand_search",
+ api_name => "open-ils.acq.purchase_order.grand_search",
+ signature => {
+ desc => q/Returns purchase orders based on flexible search terms.
+ See open-ils.acq.lineitem.grand_search/,
+ return => {desc => "A stream of POs on success, Event on failure"}
+ }
+);
+
+__PACKAGE__->register_method(
+ method => "grand_search",
+ api_name => "open-ils.acq.picklist.grand_search",
+ signature => {
+ desc => q/Returns pick lists based on flexible search terms.
+ See open-ils.acq.lineitem.grand_search/,
+ return => {desc => "A stream of PLs on success, Event on failure"}
+ }
+);
+
+sub grand_search {
+ my ($self, $conn, $auth, $and_terms, $or_terms, $conj, $options) = @_;
+ my $e = new_editor("authtoken" => $auth);
+ return $e->die_event unless $e->checkauth;
+
+ # What kind of object are we returning? Important: (\w+) had better be
+ # a legit acq classname particle, so don't register any crazy api_names.
+ my $ret_type = ($self->api_name =~ /cq.(\w+).gr/)[0];
+ my $retriever = $RETRIEVERS{$ret_type};
+
+ my $query = {
+ "select" => {
+ F("acq::$ret_type")->{"hint"} =>
+ [{"column" => "id", "transform" => "distinct"}]
+ },
+ "from" => {
+ "jub" => {
+ "acqpo" => {
+ "type" => "full",
+ "field" => "id",
+ "fkey" => "purchase_order"
+ },
+ "acqpl" => {
+ "type" => "full",
+ "field" => "id",
+ "fkey" => "picklist"
+ }
+ }
+ }
+ };
+
+ $and_terms = prepare_terms($and_terms, 1);
+ $or_terms = prepare_terms($or_terms, 0) and do {
+ $query->{"from"}->{"jub"}->{"acqlia"} = {
+ "type" => "left", "field" => "lineitem", "fkey" => "id",
+ };
+ };
+
+ if ($and_terms and $or_terms) {
+ $query->{"where"} = {
+ "-" . (lc $conj eq "or" ? "or" : "and") => [$and_terms, $or_terms]
+ };
+ } elsif ($and_terms) {
+ $query->{"where"} = $and_terms;
+ } elsif ($or_terms) {
+ $query->{"where"} = $or_terms;
+ } else {
+ $e->disconnect;
+ return new OpenILS::Event("BAD_PARAMS", "desc" => "No usable terms");
+ }
+
+ my $results = $e->json_query($query) or return $e->die_event;
+ $conn->respond($retriever->($e, $_->{"id"}, $options)) foreach (@$results);
+ $e->disconnect;
+ undef;
+}
+
+1;
Modified: trunk/Open-ILS/src/perlmods/OpenILS/Application/Acq.pm
===================================================================
--- trunk/Open-ILS/src/perlmods/OpenILS/Application/Acq.pm 2010-03-03 17:44:54 UTC (rev 15678)
+++ trunk/Open-ILS/src/perlmods/OpenILS/Application/Acq.pm 2010-03-03 19:18:55 UTC (rev 15679)
@@ -8,5 +8,6 @@
use OpenILS::Application::Acq::Lineitem;
use OpenILS::Application::Acq::Order;
use OpenILS::Application::Acq::EDI;
+use OpenILS::Application::Acq::Search;
1;
More information about the open-ils-commits
mailing list