r20109 - /scripts/qa/DebianQA/Cache.pm

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

Author: tincho-guest
Date: Sun May 18 19:40:58 2008
New Revision: 20109

URL: http://svn.debian.org/wsvn/?sc=1&rev=20109
Log:
Added function prototypes. Added clean_hash subroutine to wipe magic tags when replacing a cache tree; solves the ever growing svn problem in fetchdata

Modified:
    scripts/qa/DebianQA/Cache.pm

Modified: scripts/qa/DebianQA/Cache.pm
URL: http://svn.debian.org/wsvn/scripts/qa/DebianQA/Cache.pm?rev=20109&op=diff
==============================================================================
--- scripts/qa/DebianQA/Cache.pm (original)
+++ scripts/qa/DebianQA/Cache.pm Sun May 18 19:40:58 2008
@@ -22,6 +22,16 @@
 
 my %fd;         # Hash of open FDs, to keep locks.
 my %memcache;   # Memory cache for repeated requests
+
+sub dump_cache($;$);
+sub unlock_cache($);
+sub read_cache($;$$);
+sub update_cache($$;$$$$);
+sub clean_hash($);
+sub clean_hash_recurse($);
+sub dive_hash($;$);
+sub find_stamp($;$);
+sub find_stamp_recurse($$);
 
 sub dump_cache($;$) {
     my($cache, $root) = @_;
@@ -162,6 +172,7 @@
             $root = dive_hash($cdata, $root);
             $root = ($root->{$leaf} = $data);
         }
+        clean_hash($root);
         $root->{"/stamp"} = $stamp;
         $root->{"/version"} = $VERSION;
     } else {
@@ -182,6 +193,22 @@
         };
     }
     return $cdata;
+}
+# Deep-greps a hash looking for "magic" keys and removes them
+sub clean_hash($) {
+    my($hash) = @_;
+    debug("clean_hash($hash) invoked");
+    die "Invalid hashref" unless($hash and ref $hash and ref $hash eq "HASH");
+    clean_hash_recurse($hash);
+}
+sub clean_hash_recurse($) {
+    my($hash) = @_;
+    foreach(keys %$hash) {
+        delete $hash->{$_} if(m#^/#);
+    }
+    foreach(values %$hash) {
+        clean_hash_recurse($_) if($_ and ref $_ and ref $_ eq "HASH");
+    }
 }
 # Return a reference into $hash, as specified with $path
 # Creates or replaces any component that is not a hashref
@@ -206,7 +233,7 @@
 # root. Returns 0 if not found.
 # Remember to call it with the root of the cache, to have proper stamp and
 # version handling.
-sub find_stamp {
+sub find_stamp($;$) {
     my($hash, $path) = @_;
     $path ||= "";
     debug("find_stamp($hash, $path) invoked");
@@ -218,7 +245,7 @@
     }
     return find_stamp_recurse($hash, $path);
 }
-sub find_stamp_recurse {
+sub find_stamp_recurse($$) {
     my($hash, $path) = @_;
     my $ctsmp = 0;
     if($path =~ s{^/*([^/]+)}{}) {