r8814 - in /scripts/qa/QA: Cache.pm DebianArchive.pm

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

Author: tincho-guest
Date: Sun Nov  4 07:30:43 2007
New Revision: 8814

URL: http://svn.debian.org/wsvn/?sc=1&rev=8814
Log:
* Found a bug in cache handling which prevented the cache from being saved (RO files)
* Added code to save the consolidated cache of debian archive in a different cache, as to reduce memory consumption in the upcoming stats generator script.

Modified:
    scripts/qa/QA/Cache.pm
    scripts/qa/QA/DebianArchive.pm

Modified: scripts/qa/QA/Cache.pm
URL: http://svn.debian.org/wsvn/scripts/qa/QA/Cache.pm?rev=8814&op=diff
==============================================================================
--- scripts/qa/QA/Cache.pm (original)
+++ scripts/qa/QA/Cache.pm Sun Nov  4 07:30:43 2007
@@ -11,7 +11,8 @@
 use warnings;
 
 our @ISA = "Exporter";
-our @EXPORT = qw(dump_cache read_cache update_cache find_timestamp);
+our @EXPORT = (qw(
+    dump_cache unlock_cache read_cache update_cache find_timestamp ));
 
 use QA::Config;
 use Storable qw(store_fd fd_retrieve);
@@ -37,9 +38,18 @@
     if(-s $fd) {
         $data = fd_retrieve($fd) or die "Can't read cache: $!\n";
     }
-    close $fd;
+    unlock_cache($cache);
     require Data::Dumper;
     print Data::Dumper::Dumper(dive_hash($data, $root));
+    1;
+}
+# Releases any pending lock on a cache and closes the file.
+sub unlock_cache {
+    my $cache = shift;
+    return 0 unless($fd{$cache});
+    warn("Closing $CACHEDIR/$cache\n") if($DEBUG);
+    close($fd{$cache});
+    $fd{$cache} = undef;
     1;
 }
 sub read_cache {
@@ -68,10 +78,12 @@
     if(! defined($fd{$cache})) {
         mkpath $CACHEDIR;
         if($keep_lock) {
+            warn("Opening $CACHEDIR/$cache in RW mode\n") if($DEBUG);
             open $fd{$cache}, "+<", "$CACHEDIR/$cache"
                 or die "Error opening cache: $!\n";
             flock($fd{$cache}, LOCK_EX) or die "Error locking cache: $!\n";
         } else {
+            warn("Opening $CACHEDIR/$cache in R mode\n") if($DEBUG);
             open $fd{$cache}, "<", "$CACHEDIR/$cache"
                 or die "Error opening cache: $!\n";
             flock($fd{$cache}, LOCK_SH) or die "Error locking cache: $!\n";
@@ -83,10 +95,7 @@
     if(-s $fd) {
         $data = fd_retrieve($fd) or die "Can't read cache: $!\n";
     }
-    unless($keep_lock) {
-        close($fd);
-        $fd{$cache} = undef;
-    }
+    unlock_cache($cache) unless($keep_lock);
     my $rootd = dive_hash($data, $root);
     return $rootd if(not wantarray);
     return($rootd, find_timestamp($data, $root));
@@ -115,9 +124,10 @@
     my $tsmp = time;
 
     if(! defined($fd{$cache})) {
+        warn("Opening $CACHEDIR/$cache in RW mode\n") if($DEBUG);
         mkpath $CACHEDIR;
-        open($fd{$cache}, (-e "$CACHEDIR/$cache" ? "+<" : "+>"),
-            "$CACHEDIR/$cache") or die "Error opening cache: $!\n";
+        open($fd{$cache}, "+<", "$CACHEDIR/$cache")
+            or die "Error opening cache: $!\n";
         flock($fd{$cache}, LOCK_EX) or die "Error locking cache: $!\n";
     }
     my $fd = $fd{$cache};
@@ -126,13 +136,15 @@
     if(-s $fd) {
         $cdata = fd_retrieve($fd) or die "Can't read cache: $!\n";
     }
-    if($replace and $root eq "") {
-        $root = $cdata = {};
-    } elsif($replace) {
-        $root =~ s{/+([^/]+)$}{};
-        my $leaf = $1;
-        $root = dive_hash($cdata, $root);
-        $root = $root->{$leaf} = $data;
+    if($replace) {
+        if($root =~ m{^/*$}) {
+            $root = $cdata = $data;
+        } else {
+            $root =~ s{/+([^/]+)$}{};
+            my $leaf = $1;
+            $root = dive_hash($cdata, $root);
+            $root = ($root->{$leaf} = $data);
+        }
         $root->{"/timestamp"} = $tsmp;
     } else {
         $root = dive_hash($cdata, $root);
@@ -143,10 +155,7 @@
     }
     seek($fd, 0, SEEK_SET) or die "Can't seek: $!\n";
     store_fd($cdata, $fd) or die "Can't save cache: $!\n";
-    unless($keep_lock) {
-        close($fd);
-        $fd{$cache} = undef;
-    }
+    unlock_cache($cache) unless($keep_lock);
     return $cdata;
 }
 # Return a reference into $hash, as specified with $path

Modified: scripts/qa/QA/DebianArchive.pm
URL: http://svn.debian.org/wsvn/scripts/qa/QA/DebianArchive.pm?rev=8814&op=diff
==============================================================================
--- scripts/qa/QA/DebianArchive.pm (original)
+++ scripts/qa/QA/DebianArchive.pm Sun Nov  4 07:30:43 2007
@@ -44,7 +44,7 @@
 # necessary. If @list is empty, checks all seven suites.
 # * If $force, current cache is ignored.
 #
-# Re-generates and returns the hash of consolidated versions (key "global"),
+# Re-generates and returns the cache of consolidated versions (key "archive"),
 # which is keyed on package name and contains:
 #  {
 #     most_recent => $most_recent_version,
@@ -82,11 +82,13 @@
     return $data->{global} unless($modified);
     # retain lock, we need consistency
     warn("Re-generating consolidated hash\n") if($DEBUG);
+    my $pkgs = read_cache("consolidated", "svn", 0);
     $data = read_cache("archive", "", 1);
     my $g = {};
     foreach my $suite (keys(%$data)) {
         next unless($ttl{$suite});
         foreach my $pkg (keys(%{$data->{$suite}})) {
+            next if(%$pkgs and not $pkgs->{$pkg});
             $g->{$pkg}{$suite} = $data->{$suite}{$pkg};
         }
     }
@@ -95,12 +97,13 @@
                     deb_compare($b, $a)
                 } values( %{$g->{$_}} )) )[0];
     }
-    $data = update_cache("archive", $g, "global", 1, 0);
-    return $data->{global};
+    $data = update_cache("consolidated", $g, "archive", 1, 0);
+    unlock_cache("archive");
+    return $data;
 }
 # Returns the consolidated hash of versions. Doesn't download anything.
 sub deb_get {
-    return read_cache("archive", "global", 0);
+    return read_cache("consolidated", "archive", 0);
 }
 sub get_sources {
     my($suite) = shift;