r8857 - /scripts/qa/QA/Cache.pm

[tincho-guest at users.alioth.debian.org]

Author: tincho-guest
Date: Sun Nov  4 19:26:42 2007
New Revision: 8857

URL: http://svn.debian.org/wsvn/?sc=1&rev=8857
Log:
Added in-memory cache to avoid repeated retrieves

Modified:
    scripts/qa/QA/Cache.pm

Modified: scripts/qa/QA/Cache.pm
URL: http://svn.debian.org/wsvn/scripts/qa/QA/Cache.pm?rev=8857&op=diff
==============================================================================
--- scripts/qa/QA/Cache.pm (original)
+++ scripts/qa/QA/Cache.pm Sun Nov  4 19:26:42 2007
@@ -20,7 +20,8 @@
 use Fcntl qw(:seek :flock);
 use File::Path;
 
-my %fd; # Hash of open FDs, to keep locks.
+my %fd;         # Hash of open FDs, to keep locks.
+my %memcache;   # Memory cache for repeated requests
 
 sub dump_cache($;$) {
     my($cache, $root) = @_;
@@ -71,31 +72,43 @@
     $root = "/$root";
     $root =~ s{/+$}{};
     
-    unless(-e "$CACHEDIR/$cache") {
+    my $file = "$CACHEDIR/$cache";
+    unless(-e $file) {
         return({}, 0) if(wantarray);
         return {};
     }
+    my $use_memcache = 0;
     if(! defined($fd{$cache})) {
         mkpath $CACHEDIR;
         if($keep_lock) {
-            debug("Opening $CACHEDIR/$cache in RW mode");
-            open $fd{$cache}, "+<", "$CACHEDIR/$cache"
-                or die "Error opening cache: $!\n";
+            debug("Opening $file in RW mode");
+            open $fd{$cache}, "+<", $file or die "Error opening cache: $!\n";
             flock($fd{$cache}, LOCK_EX) or die "Error locking cache: $!\n";
         } else {
-            debug("Opening $CACHEDIR/$cache in R mode");
-            open $fd{$cache}, "<", "$CACHEDIR/$cache"
-                or die "Error opening cache: $!\n";
-            flock($fd{$cache}, LOCK_SH) or die "Error locking cache: $!\n";
-        }
-    }
-    my $fd = $fd{$cache};
-    seek($fd, 0, SEEK_SET) or die "Can't seek: $!\n";
+            if($memcache{$cache} and $memcache{$cache}{mtime} == -M $file) {
+                $use_memcache = 1;
+            } else {
+                debug("Opening $file in R mode");
+                open $fd{$cache}, "<", $file or die "Error opening cache: $!\n";
+                flock($fd{$cache}, LOCK_SH) or die "Error locking cache: $!\n";
+            }
+        }
+    }
     my $data = {};
-    if(-s $fd) {
-        $data = fd_retrieve($fd) or die "Can't read cache: $!\n";
-    }
-    unlock_cache($cache) unless($keep_lock);
+    if($use_memcache) {
+        $data = $memcache{$cache}{data};
+    } else {
+        my $fd = $fd{$cache};
+        seek($fd, 0, SEEK_SET) or die "Can't seek: $!\n";
+        if(-s $fd) {
+            $data = fd_retrieve($fd) or die "Can't read cache: $!\n";
+        }
+        unlock_cache($cache) unless($keep_lock);
+        $memcache{$cache} = {
+            data => $data,
+            mtime => -M $file
+        };
+    }
     my $rootd = dive_hash($data, $root);
     return $rootd if(not wantarray);
     return($rootd, find_stamp($data, $root));
@@ -123,15 +136,14 @@
     debug("update_cache($cache, $data, $root, $replace, $keep_lock, $stamp) ",
         "invoked");
 
+    my $file = "$CACHEDIR/$cache";
     if(! defined($fd{$cache})) {
-        debug("Opening $CACHEDIR/$cache in RW mode");
-        if(-e "$CACHEDIR/$cache") {
-            open($fd{$cache}, "+<", "$CACHEDIR/$cache")
-                or die "Error opening cache: $!\n";
+        debug("Opening $file in RW mode");
+        if(-e $file) {
+            open($fd{$cache}, "+<", $file) or die "Error opening cache: $!\n";
         } else {
             mkpath $CACHEDIR;
-            open($fd{$cache}, "+>", "$CACHEDIR/$cache")
-                or die "Error opening cache: $!\n";
+            open($fd{$cache}, "+>", $file) or die "Error opening cache: $!\n";
         }
         flock($fd{$cache}, LOCK_EX) or die "Error locking cache: $!\n";
     }
@@ -160,7 +172,13 @@
     }
     seek($fd, 0, SEEK_SET) or die "Can't seek: $!\n";
     store_fd($cdata, $fd) or die "Can't save cache: $!\n";
-    unlock_cache($cache) unless($keep_lock);
+    unless($keep_lock) {
+        unlock_cache($cache);
+        $memcache{$cache} = {
+            data => $cdata,
+            mtime => -M $file
+        };
+    }
     return $cdata;
 }
 # Return a reference into $hash, as specified with $path