r8821 - in /scripts/qa/QA: Cache.pm DebBugs.pm DebianArchive.pm
tincho-guest at users.alioth.debian.org
tincho-guest at users.alioth.debian.org
Sun Nov 4 11:08:32 UTC 2007
Author: tincho-guest
Date: Sun Nov 4 11:08:32 2007
New Revision: 8821
URL: http://svn.debian.org/wsvn/?sc=1&rev=8821
Log:
Generalisation of timestamps, now "stamp", to allow to use SVN revision numbers
as stamps.
Modified:
scripts/qa/QA/Cache.pm
scripts/qa/QA/DebBugs.pm
scripts/qa/QA/DebianArchive.pm
Modified: scripts/qa/QA/Cache.pm
URL: http://svn.debian.org/wsvn/scripts/qa/QA/Cache.pm?rev=8821&op=diff
==============================================================================
--- scripts/qa/QA/Cache.pm (original)
+++ scripts/qa/QA/Cache.pm Sun Nov 4 11:08:32 2007
@@ -12,7 +12,7 @@
our @ISA = "Exporter";
our @EXPORT = (qw(
- dump_cache unlock_cache read_cache update_cache find_timestamp ));
+ dump_cache unlock_cache read_cache update_cache find_stamp ));
use QA::Config '$CACHEDIR';
use QA::Common;
@@ -22,7 +22,7 @@
my %fd; # Hash of open FDs, to keep locks.
-sub dump_cache {
+sub dump_cache($;$) {
my($cache, $root) = @_;
$root ||= "";
$root =~ s{/+$}{};
@@ -45,7 +45,7 @@
1;
}
# Releases any pending lock on a cache and closes the file.
-sub unlock_cache {
+sub unlock_cache($) {
my $cache = shift;
return 0 unless($fd{$cache});
debug("Closing $CACHEDIR/$cache");
@@ -53,19 +53,18 @@
$fd{$cache} = undef;
1;
}
-sub read_cache {
+sub read_cache($;$$) {
# * $root specifies a path inside the cache hash.
# * If $keep_lock, file is kept open and write-locked until the next
# operation.
#
# In scalar context returns the data as a hashref. In array context also
- # returns the effective timestamp as a second element. The effective
- # timestamp is the value of a "/timestamp" key at the same level (or up) as
- # $root. If there are single elements with newer timestamps, they will have
- # a "/timestamp" subkey.
+ # returns the effective stamp as a second element. The effective
+ # stamp is the value of a "/stamp" key at the same level (or up) as
+ # $root. If there are single elements with newer stamps, they will have
+ # a "/stamp" subkey.
my($cache, $root, $keep_lock) = @_;
$root ||= "";
- $cache ||= "";
$keep_lock ||= 0;
debug("read_cache($cache, $root, $keep_lock) invoked");
@@ -99,9 +98,9 @@
unlock_cache($cache) unless($keep_lock);
my $rootd = dive_hash($data, $root);
return $rootd if(not wantarray);
- return($rootd, find_timestamp($data, $root));
-}
-sub update_cache($$$$$) {
+ return($rootd, find_stamp($data, $root));
+}
+sub update_cache($$;$$$$) {
# * $root specifies a path inside the cache hash.
# * $data is the data to merge/replace (depending on $replace) in the cache
# starting from $root. Note that it's merged at the first level: so
@@ -109,19 +108,20 @@
# * If $keep_lock, file is kept open and write-locked until the next
# operation.
#
- # A timestamp is added with key "/timestamp", at the $root level if
- # $replace, inside each key if not.
+ # A $stamp is added with key "/stamp", at the $root level if $replace,
+ # inside each key if not. If no $stamp is specified, the current unix time
+ # is used.
#
# Returns the whole cache
- my($cache, $data, $root, $replace, $keep_lock) = @_;
+ my($cache, $data, $root, $replace, $keep_lock, $stamp) = @_;
$root ||= "";
+ $root = "/$root";
+ $root =~ s{/+$}{};
$replace ||= 0;
$keep_lock ||= 0;
- debug("update_cache($cache, $data, $root, $replace, $keep_lock) invoked");
-
- $root = "/$root";
- $root =~ s{/+$}{};
- my $tsmp = time;
+ $stamp = time unless(defined $stamp);
+ debug("update_cache($cache, $data, $root, $replace, $keep_lock, $stamp) ",
+ "invoked");
if(! defined($fd{$cache})) {
debug("Opening $CACHEDIR/$cache in RW mode");
@@ -150,12 +150,12 @@
$root = dive_hash($cdata, $root);
$root = ($root->{$leaf} = $data);
}
- $root->{"/timestamp"} = $tsmp;
+ $root->{"/stamp"} = $stamp;
} else {
$root = dive_hash($cdata, $root);
foreach(keys(%$data)) {
$root->{$_} = $data->{$_};
- $root->{$_}{"/timestamp"} = $tsmp;
+ $root->{$_}{"/stamp"} = $stamp;
}
}
seek($fd, 0, SEEK_SET) or die "Can't seek: $!\n";
@@ -165,8 +165,9 @@
}
# Return a reference into $hash, as specified with $path
# Creates or replaces any component that is not a hashref
-sub dive_hash($$) {
+sub dive_hash($;$) {
my($hash, $path) = @_;
+ $path ||= "";
debug("dive_hash($hash, $path) invoked");
die "Invalid hashref" unless($hash and ref $hash and ref $hash eq "HASH");
my @path = split(m#/+#, $path);
@@ -181,19 +182,20 @@
}
return $ref;
}
-# Search a timestamp in $hash, starting at $path and going upwards until the
+# Search a stamp in $hash, starting at $path and going upwards until the
# root
-sub find_timestamp {
+sub find_stamp {
my($hash, $path) = @_;
- debug("find_timestamp($hash, $path) invoked");
+ $path ||= "";
+ debug("find_stamp($hash, $path) invoked");
die "Invalid hashref" unless($hash and ref $hash and ref $hash eq "HASH");
my $ctsmp = 0;
if($path =~ s{^/*([^/]+)}{}) {
my $root = $1;
- $ctsmp = find_timestamp($hash->{$root}, $path) if($hash->{$root});
- }
- if(not $ctsmp and exists($hash->{"/timestamp"})) {
- $ctsmp = $hash->{"/timestamp"};
+ $ctsmp = find_stamp($hash->{$root}, $path) if($hash->{$root});
+ }
+ if(not $ctsmp and exists($hash->{"/stamp"})) {
+ $ctsmp = $hash->{"/stamp"};
}
return $ctsmp;
}
Modified: scripts/qa/QA/DebBugs.pm
URL: http://svn.debian.org/wsvn/scripts/qa/QA/DebBugs.pm?rev=8821&op=diff
==============================================================================
--- scripts/qa/QA/DebBugs.pm (original)
+++ scripts/qa/QA/DebBugs.pm Sun Nov 4 11:08:32 2007
@@ -42,14 +42,14 @@
# A list of packages to update has been received
unless($force) {
@pkglist = grep( {
- $ttl * 60 < time - find_timestamp($cdata, $_)
+ $ttl * 60 < time - find_stamp($cdata, $_)
} @pkglist);
info("BTS info for @pkglist is stale");
}
info("Downloading list of bugs of (", join(", ", @pkglist),
")");
@list = @{$soap->get_bugs( package => [ @pkglist ] )->result()};
- } elsif($force or $ttl * 60 < time - find_timestamp($cdata, "")) {
+ } elsif($force or $ttl * 60 < time - find_stamp($cdata, "")) {
# No list of packages; forced operation or stale cache
info("BTS info is stale") unless($force);
$replace = 1;
@@ -89,7 +89,7 @@
# keywords/tags, severity, subject, forwarded, date
my %cbugs;
foreach my $pkgname (@pkglist) {
- next if($pkgname eq "/timestamp");
+ next if($pkgname =~ /^\//);
$bugs{$pkgname} ||= {};
my @blist = keys %{ $bugs{$pkgname} };
# Remove done bugs
Modified: scripts/qa/QA/DebianArchive.pm
URL: http://svn.debian.org/wsvn/scripts/qa/QA/DebianArchive.pm?rev=8821&op=diff
==============================================================================
--- scripts/qa/QA/DebianArchive.pm (original)
+++ scripts/qa/QA/DebianArchive.pm Sun Nov 4 11:08:32 2007
@@ -64,7 +64,7 @@
}
my $modified;
foreach my $src (@list) {
- if($force or $ttl{$src} * 60 < time - find_timestamp($data, $src)) {
+ if($force or $ttl{$src} * 60 < time - find_stamp($data, $src)) {
info("$src is stale, getting new version") unless($force);
my $d;
if($src eq "new") {
More information about the Pkg-perl-cvs-commits
mailing list