r5985 - /scripts/qa/versioncheck.pl
dmn at users.alioth.debian.org
dmn at users.alioth.debian.org
Thu Jul 26 10:37:00 UTC 2007
Author: dmn
Date: Thu Jul 26 10:36:59 2007
New Revision: 5985
URL: http://svn.debian.org/wsvn/?sc=1&rev=5985
Log:
Make archive version link to the PTS and add BTS link. Add support to experimental. Show also coult of all group packages
Modified:
scripts/qa/versioncheck.pl
Modified: scripts/qa/versioncheck.pl
URL: http://svn.debian.org/wsvn/scripts/qa/versioncheck.pl?rev=5985&op=diff
==============================================================================
--- scripts/qa/versioncheck.pl (original)
+++ scripts/qa/versioncheck.pl Thu Jul 26 10:36:59 2007
@@ -14,9 +14,6 @@
# so 0.2200 (cpan) gets equal to 0.22 (debian) when this is described
#
# Add support for checking list of packages, given on the command line
-#
-# Also look in experimental. Do not consider it sufficient, i.e. still show the
-# package even if upstream version matches experimental.
our $THIS_REVISION = '$Id$';
@@ -60,18 +57,19 @@
debugmsg( "HOME=$ENV{HOME}\n" );
debugmsg( "CPAN home=".$CPAN::Config->{cpan_home}."\n" );
-my %packages; # contains {package => version} pairs
-foreach my $section ( qw(main contrib non-free) )
-{
+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/unstable/$section/source/Sources.gz";
+ 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> )
{
@@ -84,12 +82,25 @@
if( s/^Version: // )
{
- $packages{$pkg} = $_;
+ $hash->{$pkg} = $_;
}
}
}
+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))) );
+
+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))) );
+
my %incoming; # contains {package => version} pairs
do {
@@ -265,6 +276,7 @@
_EOF
my $total = 0;
+my $total_shown = 0;
my $svn = SVN::Client->new();
# loop over packages
@@ -280,9 +292,11 @@
),
);
- foreach my $pkg( keys %$svn_packages )
+ foreach my $pkg( sort(keys %$svn_packages) )
{
next if $pkg eq 'attic';
+
+ $total++;
debugmsg( "Examining $pkg\n" );
@@ -337,6 +351,8 @@
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 = '';
@@ -412,7 +428,8 @@
? ' class="upload"'
: ''
).">$in_svn</td>\n";
- print "<td>".join(
+
+ my $archive_text = join(
"\n",
$in_archive||' ',
(
@@ -425,7 +442,16 @@
? "NEW: $in_new"
: ()
),
- )."</td>\n";
+ (
+ ($in_experimental)
+ ? "experimental: $in_experimental"
+ : ()
+ ),
+ );
+
+ $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;
+
+ print "<td>$archive_text</td>\n";
print(
($up_svn ne $upstream)
? "<td class=\"upgrade\">".join(
@@ -437,14 +463,14 @@
);
print "</tr>\n";
- $total++;
+ $total_shown++;
}
}
}
my $date = gmtime;
print <<_EOF;
-<tr><td colspan=\"4\"><b>TOTAL: $total</b></td></tr>
+<tr><td colspan=\"4\"><b>TOTAL: $total_shown/$total</b></td></tr>
</table>
<hr>
$date UTC<br>
More information about the Pkg-perl-cvs-commits
mailing list