Leon,
Attached are patches against CPAN::WWW::Testers::Generator and
CPAN::WWW::Testers for hiding test reports for which the tester submits
an updated report.
The missing element to implement this feature was the email address of
the tester. Since that does not currently exist in testers.db, the
hiding feature will not affect existing reports. In the future, if a
report is added to the DB and then later followed by another with all
the same matching criteria (i.e., distribution + version, Perl version,
OS name + version, architecture name, and tester's email address), the
older report(s) will not show up on the 'show' pages generated by
CPAN::WWW::Testers (i.e., http://cpantesters.perl.org/).
Here is an explanation of the changes:
* CPAN::WWW::Testers::Generator::Article.pm
- Adds a new accessor called 'tester' to the article object.
- Extracts the 'From' field from a test report and adds it to the
'tester' field.
* CPAN::WWW::Testers::Generator.pm
- Adds a new column 'tester' to the 'CREATE TABLE reports' command.
- For existing databases, alters the 'reports' table to add the 'tester'
column. The DB is then 'VACUUM'ed which only takes a couple of minutes.
As with CREATE TABLE, this is a one-time only operation.
- The 'tester' field from the 'article' object is stored in the new
'tester' field.
* CPAN::WWW::Testers
- The new 'tester' column is also retrieved for each report.
- Reports are extracted in descending ID order so that updates are
encountered first.
- If all fields for uniqueness are present ($version, $perl, $osname,
$osvers, $archname, $tester), then the report is skipped if
exists($unique{$version}{$perl}{$osname}{$osvers}{$archname}{$tester}).
Otherwise,
$unique{$version}{$perl}{$osname}{$osvers}{$archname}{$tester} is set
to the report ID (arbitrary).
- The report order is reversed (i.e., lowest ID to highest) by changing
"push @reports, $report" to "unshift @reports, $report".
Entries have been added to the CHANGES files for both modules, and
version numbers have been incremented.
Thank you,
Jerry D. Hedden
diff -ur CPAN-WWW-Testers-0.29/CHANGES CPAN-WWW-Testers-0.30/CHANGES
--- CPAN-WWW-Testers-0.29/CHANGES 2006-01-31 05:11:04.000000000 -0500
+++ CPAN-WWW-Testers-0.30/CHANGES 2006-03-16 12:44:58.000000000 -0500
@@ -1,5 +1,8 @@
Revision history for Perl module CPAN::WWW::Testers.
+0.30 Thu Mar 16 12:45:00 EST 2006
+ - Suppress older reports when an updated exists
+
0.29 Tue Jan 31 10:03:37 GMT 2006
- update the URL we download the database from
diff -ur CPAN-WWW-Testers-0.29/lib/CPAN/WWW/Testers.pm
CPAN-WWW-Testers-0.30/lib/CPAN/WWW/Testers.pm
--- CPAN-WWW-Testers-0.29/lib/CPAN/WWW/Testers.pm 2006-01-31
05:11:04.000000000 -0500
+++ CPAN-WWW-Testers-0.30/lib/CPAN/WWW/Testers.pm 2006-03-16
12:45:40.000000000 -0500
@@ -16,7 +16,7 @@
use version;
use base qw(Class::Accessor::Chained::Fast);
__PACKAGE__->mk_accessors(qw(directory database dbh tt last_id backpan));
-$VERSION = "0.29";
+$VERSION = '0.30';
sub generate {
my $self = shift;
@@ -287,16 +287,21 @@
next unless $distribution =~ /^[A-Za-z0-9][A-Za-z0-9-_]+$/;
my $action_sth = $dbh->prepare("
-SELECT id, status, version, perl, osname, osvers, archname FROM reports
-WHERE distribution = ? order by id
+SELECT id, status, version, perl, osname, osvers, archname, tester FROM
reports
+WHERE distribution = ? order by id desc
");
$action_sth->execute($distribution);
- my ($id, $status, $version, $perl, $osname, $osvers, $archname);
+ my ($id, $status, $version, $perl, $osname, $osvers, $archname, $tester);
$action_sth->bind_columns(\$id, \$status, \$version, \$perl, \$osname,
- \$osvers, \$archname);
- my @reports;
+ \$osvers, \$archname, \$tester);
+ my (@reports, %unique);
while ($action_sth->fetch) {
next unless $version;
+ # Suppress older reports if an update exists
+ if ($perl && $osname && $osvers && $archname && $tester) {
+ next if
exists($unique{$version}{$perl}{$osname}{$osvers}{$archname}{$tester});
+ $unique{$version}{$perl}{$osname}{$osvers}{$archname}{$tester} = $id;
+ }
my $report = {
id => $id,
distribution => $distribution,
@@ -308,7 +313,7 @@
archname => $archname,
url => "http://nntp.x.perl.org/group/perl.cpan.testers/$id";,
};
- push @reports, $report;
+ unshift @reports, $report;
}
my ($summary, $byversion);
diff -ur CPAN-WWW-Testers-Generator-0.22/CHANGES
CPAN-WWW-Testers-Generator-0.23/CHANGES
--- CPAN-WWW-Testers-Generator-0.22/CHANGES 2006-03-16 12:48:02.000000000
-0500
+++ CPAN-WWW-Testers-Generator-0.23/CHANGES 2006-03-16 12:47:58.000000000
-0500
@@ -1,5 +1,8 @@
Revision history for Perl module CPAN::WWW::Testers::Generator.
+0.23 Thu Mar 16 12:45:00 EST 2006
+ - Added 'tester' column to 'reports' table
+
0.22 Thu Feb 3 15:27:41 GMT 2005
- now includes perl + OS version in the testers.db
- use SQLite 3.0
diff -ur
CPAN-WWW-Testers-Generator-0.22/lib/CPAN/WWW/Testers/Generator/Article.pm
CPAN-WWW-Testers-Generator-0.23/lib/CPAN/WWW/Testers/Generator/Article.pm
--- CPAN-WWW-Testers-Generator-0.22/lib/CPAN/WWW/Testers/Generator/Article.pm
2005-02-03 10:58:06.000000000 -0500
+++ CPAN-WWW-Testers-Generator-0.23/lib/CPAN/WWW/Testers/Generator/Article.pm
2006-03-16 12:51:32.000000000 -0500
@@ -6,7 +6,7 @@
use base qw( Class::Accessor::Fast );
__PACKAGE__->mk_accessors(qw(
date status distribution version
-perl osname osvers archname
+perl osname osvers archname tester
));
sub new {
@@ -16,6 +16,7 @@
my $mail = Email::Simple->new($$article);
return if $mail->header("In-Reply-To");
+ my $tester = $mail->header("From");
my $subject = $mail->header("Subject");
return unless $subject;
return if $subject =~ /::/; # it's supposed to be distribution
@@ -48,6 +49,7 @@
$self->osname($osname || "");
$self->osvers($osvers || "");
$self->archname($archname || "");
+ $self->tester($tester || "");
return $self;
}
diff -ur CPAN-WWW-Testers-Generator-0.22/lib/CPAN/WWW/Testers/Generator.pm
CPAN-WWW-Testers-Generator-0.23/lib/CPAN/WWW/Testers/Generator.pm
--- CPAN-WWW-Testers-Generator-0.22/lib/CPAN/WWW/Testers/Generator.pm
2005-02-03 10:58:06.000000000 -0500
+++ CPAN-WWW-Testers-Generator-0.23/lib/CPAN/WWW/Testers/Generator.pm
2006-03-16 12:48:30.000000000 -0500
@@ -3,15 +3,13 @@
use CPAN::DistnameInfo;
use CPAN::WWW::Testers::Generator::Article;
use DBI;
-use Email::Simple;
use File::Spec::Functions;
-use Mail::Address;
use Net::NNTP;
use base qw(Class::Accessor::Fast);
__PACKAGE__->mk_accessors(qw(directory));
use vars qw($VERSION);
use version;
-$VERSION = "0.22";
+$VERSION = '0.23';
sub new {
my $class = shift;
@@ -84,7 +82,7 @@
my $self = shift;
my $dbh = $self->_dbh("testers");
- my @fields = qw(status distribution version perl osname osvers archname);
+ my @fields = qw(status distribution version perl osname osvers archname
tester);
eval {
$dbh->do("
@@ -96,15 +94,32 @@
perl TEXT,
osname TEXT,
osvers TEXT,
- archname TEXT
+ archname TEXT,
+ tester TEXT
)");
foreach my $field (@fields) {
$dbh->do("CREATE INDEX ${field}_idx on reports (${field})");
}
+ $dbh->commit;
};
die $@ if $@ && $@ !~ /table reports already exists/;
+ # Upgrade to add tester column
+ if ($@ && $@ =~ /table reports already exists/) {
+ eval {
+ $dbh->do("ALTER TABLE reports ADD COLUMN tester TEXT");
+ $dbh->do("CREATE INDEX tester_idx on reports (tester)");
+
+ print("Reorganizing 'testers.db' after adding 'tester' column to
'reports'.\n");
+ print("This will take a couple of minutes. Please wait...\n");
+ $dbh->{AutoCommit} = 1;
+ $dbh->do("VACUUM");
+ $dbh->{AutoCommit} = 0;
+ };
+ die $@ if $@ && $@ !~ /duplicate colunm name/;
+ }
+
my $sth = $dbh->prepare("SELECT max(id) from reports");
$sth->execute;
my($max_id) = $sth->fetchrow_array || 0;
@@ -113,7 +128,7 @@
my $article_sth = $news_dbh->prepare("SELECT id, article from articles WHERE
id > ?");
$article_sth->execute($max_id);
- $sth = $dbh->prepare("REPLACE INTO reports VALUES (?, ?, ?, ?, ?, ?, ?, ?)");
+ $sth = $dbh->prepare("REPLACE INTO reports VALUES (?, ?, ?, ?, ?, ?, ?, ?,
?)");
my $count = $max_id;
while (my($id, $content) = $article_sth->fetchrow_array) {
