r5986 - /scripts/qa/versioncheck.pl

[dmn at users.alioth.debian.org]

Author: dmn
Date: Thu Jul 26 10:53:45 2007
New Revision: 5986

URL: http://svn.debian.org/wsvn/?sc=1&rev=5986
Log:
Also scan stable and oldstable

Modified:
    scripts/qa/versioncheck.pl

Modified: scripts/qa/versioncheck.pl
URL: http://svn.debian.org/wsvn/scripts/qa/versioncheck.pl?rev=5986&op=diff
==============================================================================
--- scripts/qa/versioncheck.pl (original)
+++ scripts/qa/versioncheck.pl Thu Jul 26 10:53:45 2007
@@ -57,49 +57,65 @@
 debugmsg( "HOME=$ENV{HOME}\n" );
 debugmsg( "CPAN home=".$CPAN::Config->{cpan_home}."\n" );
 
-sub scan_packages($$$)
+sub scan_packages($$)
 {
-    my( $suite, $section, $hash ) = @_;
-    # TODO This is somewhat brute-force, reading the whole sources into
-    # memory, then de-compressing them also in memory.
-    # 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";
-    my $sources = Compress::Zlib::memGunzip(\$sources_gz);
-    my $src_io = IO::Scalar->new(\$sources);
-
-    local($_);
-    my $pkg;
-    while( <$src_io> )
+    my( $suite, $hash ) = @_;
+    foreach my $section ( qw( main contrib non-free ) )
     {
-        chomp;
-        if( s/^Package: // )
-        {
-            $pkg = $_;
-            next;
-        }
-
-        if( s/^Version: // )
-        {
-            $hash->{$pkg} = $_;
+        # TODO This is somewhat brute-force, reading the whole sources into
+        # memory, then de-compressing them also in memory.
+        # 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";
+        my $sources = Compress::Zlib::memGunzip(\$sources_gz);
+        my $src_io = IO::Scalar->new(\$sources);
+
+        my $pkg;
+        while( <$src_io> )
+        {
+            chomp;
+            if( s/^Package: // )
+            {
+                $pkg = $_;
+                next;
+            }
+
+            if( s/^Version: // )
+            {
+                $hash->{$pkg} = $_;
+            }
         }
     }
+
+    debugmsg(
+        sprintf(
+            "Information about %d %s packages loaded\n",
+            scalar(keys(%$hash)),
+            $suite,
+        ),
+    );
 }
 
 my %packages;   # contains {package => version} pairs
 scan_packages(
-    'unstable', $_, \%packages,
-) foreach( qw(main contrib non-free) );
-
-debugmsg( sprintf("Information about %d packages loaded\n", scalar(keys(%packages))) );
+    'unstable', \%packages,
+);
 
 my %experimental;   # contains {package => version} pairs
 scan_packages(
-    'experimental', $_, \%experimental,
-) foreach( qw( main contrib non-free) );
-
-debugmsg( sprintf("Information about %d experimental packages loaded\n", scalar(keys(%experimental))) );
+    'experimental', \%experimental,
+);
+
+my %stable;   # contains {package => version} pairs
+scan_packages(
+    'stable', \%stable,
+);
+
+my %oldstable;   # contains {package => version} pairs
+scan_packages(
+    'oldstable', \%oldstable,
+);
 
 
 my %incoming;   # contains {package => version} pairs
@@ -301,8 +317,17 @@
         debugmsg( "Examining $pkg\n" );
 
         my $in_archive = $packages{$pkg} || '';
-
         debugmsg( sprintf(" - Archive has %s\n", $in_archive||'none') );
+
+        my $in_experimental = $experimental{$pkg};
+        debugmsg( sprintf( " - experimental has %s\n", $in_experimental||'none' ) );
+
+        my $in_stable = $stable{$pkg};
+        debugmsg( sprintf( " - stable has %s\n", $in_stable||'none' ) );
+
+        my $in_oldstable = $oldstable{$pkg};
+        debugmsg( sprintf( " - oldstable has %s\n", $in_oldstable||'none' ) );
+
 
         my $changelog;
         my $changelog_fh = IO::Scalar->new( \$changelog );
@@ -351,8 +376,6 @@
         debugmsg( sprintf( " - incoming has %s\n", $in_incoming||'none' ) );
         my $in_new = $new{$pkg}||'';
         debugmsg( sprintf( " - NEW has %s\n", $in_new||'none' ) );
-        my $in_experimental = $experimental{$pkg};
-        debugmsg( sprintf( " - experimental has %s\n", $in_experimental||'none' ) );
 
         my $upstream = '';
         my $in_cpan = '';
@@ -447,6 +470,16 @@
                     ? "experimental:&nbsp;$in_experimental"
                     : ()
                 ),
+                (
+                    ($in_stable and not $in_archive and not $in_experimental)
+                    ? "stable:&nbsp;$in_stable"
+                    : ()
+                ),
+                (
+                    ($in_oldstable and not $in_stable and not $in_archive and not $in_experimental)
+                    ? "oldstable:&nbsp;$in_oldstable"
+                    : ()
+                ),
             );
 
             $archive_text = qq(<a href="http://packages.qa.debian.org/$pkg">$archive_text</a> <a style="font-size:smaller" href="http://bugs.debian.org/src:$pkg">bts</a>) if $in_archive or $in_experimental;