r6896 - /scripts/qa/versioncheck2.pl

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

Author: tincho-guest
Date: Fri Aug 17 20:56:23 2007
New Revision: 6896

URL: http://svn.debian.org/wsvn/?sc=1&rev=6896
Log:
Added fallback to cache when the mirrors are down

Modified:
    scripts/qa/versioncheck2.pl

Modified: scripts/qa/versioncheck2.pl
URL: http://svn.debian.org/wsvn/scripts/qa/versioncheck2.pl?rev=6896&op=diff
==============================================================================
--- scripts/qa/versioncheck2.pl (original)
+++ scripts/qa/versioncheck2.pl Fri Aug 17 20:56:23 2007
@@ -128,7 +128,10 @@
         # Should be made incremental using reasonable-sized buffer
         my $url = "$MIRROR/debian/dists/$suite/$section/source/Sources.gz";
         my $sources_gz = LWP::Simple::get($url);
-        $sources_gz or die "Can't download $url";
+        unless($sources_gz) {
+            warn "Can't download $url";
+            return 0;
+        }
         my $sources = Compress::Zlib::memGunzip(\$sources_gz);
         my $src_io = IO::Scalar->new(\$sources);
 
@@ -157,44 +160,55 @@
         ),
     );
     to_cache($hash, $suite);
+    1;
 }
 
 my %packages;   # contains {package => version} pairs
-scan_packages(
-    'unstable', \%packages,
-) unless from_cache(\%packages, 'unstable', 6);
+unless(from_cache(\%packages, 'unstable', 6)) {
+    scan_packages('unstable', \%packages)
+        or from_cache(\%packages, 'unstable', 999) or die;
+}
 
 my %experimental;   # contains {package => version} pairs
-scan_packages(
-    'experimental', \%experimental,
-) unless from_cache(\%experimental, 'experimental', 6);
+unless(from_cache(\%experimental, 'experimental', 6)) {
+    scan_packages('experimental', \%experimental)
+        or from_cache(\%experimental, 'experimental', 999) or die;
+}
 
 my %stable;   # contains {package => version} pairs
-scan_packages(
-    'stable', \%stable,
-) unless from_cache(\%stable, 'stable', 168);   # 1 week
+unless(from_cache(\%stable, 'stable', 168)) {
+    scan_packages('stable', \%stable)
+        or from_cache(\%stable, 'stable', 999) or die;
+}
 
 my %oldstable;   # contains {package => version} pairs
-scan_packages(
-    'oldstable', \%oldstable,
-) unless from_cache(\%oldstable, 'oldstable', 168); # 1 week
+unless(from_cache(\%oldstable, 'oldstable', 168)) {
+    scan_packages('oldstable', \%oldstable)
+        or from_cache(\%oldstable, 'oldstable', 999) or die;
+}
 
 my %incoming;   # contains {package => version} pairs
-scan_incoming(
-    \%incoming,
-) unless from_cache(\%incoming, 'incoming', 1);
+unless(from_cache(\%incoming, 'incoming', 1)) {
+    scan_packages('incoming', \%incoming)
+        or from_cache(\%incoming, 'incoming', 999) or die;
+}
 
 my %new;   # contains {package => version} pairs
-scan_new(
-    \%new,
-) unless from_cache(\%new, 'new', 1);
+unless(from_cache(\%new, 'new', 1)) {
+    scan_packages('new', \%new)
+        or from_cache(\%new, 'new', 999) or die;
+}
 
 my( %cpan_authors, %cpan_modules, $cpan_updated );
 unless(not $force_cpan and from_cache(\%cpan_authors, 'cpan_authors', 12)
         and from_cache(\%cpan_modules, 'cpan_modules', 12))
 {
-    scan_cpan(\%cpan_authors, \%cpan_modules);
-    $cpan_updated = 1;
+    if(scan_cpan(\%cpan_authors, \%cpan_modules)) {
+        $cpan_updated = 1;
+    } else {
+        from_cache(\%cpan_authors, 'cpan_authors', 999) or die;
+        from_cache(\%cpan_modules, 'cpan_modules', 999) or die;
+    }
 }
 
 sub scan_incoming {
@@ -245,6 +259,10 @@
     open(TMP, '+>', undef) or die "Unable to open anonymous temporary file";
     my $old = select(TMP);
     my $lslr = LWP::Simple::getprint("$CPAN_MIRROR/ls-lR.gz");
+    unless(-s TMP) {
+        close TMP;
+        return 0;
+    }
     select($old);
     seek(TMP, 0, 0);
     my $gz = Compress::Zlib::gzopen(\*TMP, 'rb') or die $Compress::Zlib::gzerrno;
@@ -284,6 +302,7 @@
     close(TMP);
     to_cache($cpauth, 'cpan_authors');
     to_cache($cpmod, 'cpan_modules');
+    1;
 }
 
 # RETURNS