[open-ils-commits] r17629 - trunk/Open-ILS/src/perlmods/OpenILS/Application (miker)

[svn at svn.open-ils.org]

Author: miker
Date: 2010-09-13 11:17:44 -0400 (Mon, 13 Sep 2010)
New Revision: 17629

Modified:
   trunk/Open-ILS/src/perlmods/OpenILS/Application/Fielder.pm
Log:
teach fielder to cache (off by default), with a default timeout of 5min

Modified: trunk/Open-ILS/src/perlmods/OpenILS/Application/Fielder.pm
===================================================================
--- trunk/Open-ILS/src/perlmods/OpenILS/Application/Fielder.pm	2010-09-13 14:49:32 UTC (rev 17628)
+++ trunk/Open-ILS/src/perlmods/OpenILS/Application/Fielder.pm	2010-09-13 15:17:44 UTC (rev 17629)
@@ -9,6 +9,7 @@
 
 use OpenSRF::AppSession;
 use OpenSRF::Utils::SettingsClient;
+use OpenSRF::Utils::Cache;
 use OpenSRF::Utils::Logger qw/:level/;
 
 use OpenILS::Utils::Fieldmapper;
@@ -16,6 +17,8 @@
 
 use OpenILS::Utils::CStoreEditor qw/:funcs/;
 
+use Digest::MD5 qw(md5_hex);
+
 use XML::LibXML;
 use XML::LibXML::XPathContext;
 use XML::LibXSLT;
@@ -31,6 +34,8 @@
 
 my $log = 'OpenSRF::Utils::Logger';
 
+my $cache;
+my $cache_timeout;
 my $parser = XML::LibXML->new();
 my $xslt = XML::LibXSLT->new();
 
@@ -48,10 +53,15 @@
 
     $log->debug( 'IDL XML file loaded' );
 
+    $cache_timeout = $conf->config_value(
+            "apps", "open-ils.fielder", "app_settings", "cache_timeout" ) || 300;
+
     generate_methods();
 
 }
-sub child_init {}
+sub child_init {
+    $cache = OpenSRF::Utils::Cache->new('global');
+}
 
 sub fielder_fetch {
     my $self = shift;
@@ -59,9 +69,12 @@
     my $obj = shift;
 
     my $query = $obj->{query};
+    my $nocache = $obj->{cache} ? 0 : 1;
     my $fields = $obj->{fields};
     my $distinct = $obj->{distinct} ? 1 : 0;
 
+    return undef unless $query;
+
     my $obj_class = $self->{class_hint};
     my $fm_class = $self->{class_name};
 
@@ -69,18 +82,34 @@
         $fields = [ $fm_class->real_fields ];
     }
 
-    $log->debug( 'Field list: '. OpenSRF::Utils::JSON->perl2JSON( $fields ) );
-    $log->debug( 'Query: '. OpenSRF::Utils::JSON->perl2JSON( $query ) );
-
-    return undef unless $fields;
-    return undef unless $query;
-
     $fields = [$fields] if (!ref($fields));
 
+    my $qstring = OpenSRF::Utils::JSON->perl2JSON( $query );
+    my $fstring = OpenSRF::Utils::JSON->perl2JSON( [ sort { $a cmp $b } @$fields ] );
 
     $log->debug( 'Query Class: '. $obj_class );
+    $log->debug( 'Field list: '. $fstring );
+    $log->debug( 'Query: '. $qstring );
 
-    my $res = new_editor()->json_query({
+    my ($key,$res);
+    unless ($nocache) {
+        $key = 'open-ils.fielder_' . md5_hex(
+            $self->api_name . 
+            $qstring .
+            $fstring .
+            $distinct .
+            $obj_class
+        );
+
+        $res = $cache->get_cache( $key );
+
+        if ($res) {
+            $client->respond($_) for (@$res);
+            return undef;
+        }
+    }
+
+    $res = new_editor()->json_query({
         select  => { $obj_class => $fields },
         from    => $obj_class,
         where   => $query,
@@ -91,8 +120,10 @@
         $client->respond($value);
     }
 
+    $client->respond_complete();
+
+    $cache->put_cache( $key => $res => $cache_timeout ) unless ($nocache);
     return undef;
-
 }
 
 sub generate_methods {