Permalink
Browse files

more tests and diagnostics, new test option to check a single report

  • Loading branch information...
1 parent 5f5453a commit c01219dd91881bb46c85e1ca43a6549aa50c7674 @barbie barbie committed Aug 10, 2009
Showing with 14,378 additions and 13,824 deletions.
  1. +5 −0 CHANGES
  2. +1 −0 MANIFEST
  3. +2 −2 META.yml
  4. +8 −0 Makefile.PL
  5. +34 −5 lib/CPAN/Testers/WWW/Reports/Mailer.pm
  6. +2 −1 t/20attributes.t
  7. +14,034 −13,796 t/70setup_db-cpanstats.t
  8. +17 −16 t/71daily.t
  9. +1 −0 t/CTWRM_Testing.pm
  10. +18 −0 t/data/01mailrc.txt
  11. +252 −2 t/data/71daily.eml
  12. +2 −1 t/data/preferences-daily.ini
  13. +2 −1 t/data/preferences-reports.ini
View
@@ -1,5 +1,10 @@
Revision history for Perl module CPAN::Testers::WWW::Reports::Mailer.
+0.20 10/08/2009
+ - added many more tests
+ - added more diagnostics in debug mode
+ - added the ability to check a report (automatical sets debug mode)
+
0.19 27/07/2009
- temporary fix on live server made permanent (version.pm bug)
- fixed bad db reference
View
@@ -38,6 +38,7 @@ t/90podtest.t
t/91podcover.t
t/94metatest.t
t/95changedate.t
+t/data/01mailrc.txt
t/data/61daily.eml
t/data/62daily.eml
t/data/63daily.eml
View
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: CPAN-Testers-WWW-Reports-Mailer
-version: 0.19
+version: 0.20
abstract: CPAN Testers Reports Mailer
author:
- Barbie <barbie@cpan.org>
@@ -34,7 +34,7 @@ requires:
provides:
CPAN::Testers::WWW::Reports::Mailer:
file: lib/CPAN/Testers/WWW/Reports/Mailer.pm
- version: 0.19
+ version: 0.20
meta-spec:
version: 1.4
View
@@ -1,4 +1,12 @@
use ExtUtils::MakeMaker;
+
+print <<HERE;
+
+ Please note that the tests within this distribution can take a long time
+ to run. As such, be prepared to wait a little while to get the results.
+
+HERE
+
WriteMakefile(
'NAME' => 'CPAN::Testers::WWW::Reports::Mailer',
'VERSION_FROM' => 'lib/CPAN/Testers/WWW/Reports/Mailer.pm',
@@ -4,7 +4,7 @@ use warnings;
use strict;
use vars qw($VERSION);
-$VERSION = '0.19';
+$VERSION = '0.20';
=head1 NAME
@@ -211,13 +211,15 @@ my %phrasebook = (
'InsertDistPrefs' => "INSERT INTO prefs_distributions (pauseid,distribution,ignored,report,grade,tuple,version,patches,perl,platform) VALUES (?,?,0,1,'FAIL','FIRST','LATEST',0,'ALL','ALL')",
'GetArticle' => "SELECT * FROM articles WHERE id=?",
+
+ 'GetReportTest' => "SELECT id,dist,version,platform,perl,state FROM cpanstats WHERE id = ? AND state IN ('pass','fail','na','unknown') ORDER BY id",
);
#----------------------------------------------------------------------------
# The Application Programming Interface
__PACKAGE__->mk_accessors(
- qw( lastmail debug logfile logclean mode mailrc tt pause ));
+ qw( lastmail debug test logfile logclean mode mailrc tt pause ));
# -------------------------------------
# The Public Interface Functions
@@ -250,6 +252,7 @@ sub new {
'config=s',
'lastmail=s',
'mailrc=s',
+ 'test=i',
'logfile=s',
'logclean',
'debug',
@@ -281,6 +284,9 @@ sub new {
die "Cannot configure $db database\n" unless($self->{$db});
}
+ $self->test( $self->_defined_or( $options{test}, $hash{test}, $cfg->val('SETTINGS','test' ), 0 ) );
+ $options{debug} = 1 if($self->test);
+
$self->debug( $self->_defined_or( $options{debug}, $hash{debug}, $cfg->val('SETTINGS','debug' ), $default{debug}) );
$self->lastmail($self->_defined_or( $options{lastmail}, $hash{lastmail}, $cfg->val('SETTINGS','lastmail' ), $default{lastmail}) );
$self->mailrc( $self->_defined_or( $options{mailrc}, $hash{mailrc}, $cfg->val('SETTINGS','mailrc' ), $default{mailrc} ) );
@@ -344,7 +350,9 @@ sub check_reports {
$self->_log( "INFO: last_id=$last_id\n" );
my $next;
- if($mode ne 'daily') {
+ if($self->test) {
+ $next = $self->{CPANSTATS}->iterator('hash',$phrasebook{'GetReportTest'},$self->test);
+ } elsif($mode ne 'daily') {
my @authors = $self->{CPANPREFS}->get_query('hash',$phrasebook{'FindAuthorType'}, $report_type);
return $self->_set_lastid() unless(@authors);
my $sql = sprintf $phrasebook{'GetReports2'}, join(',',map {"'$_->{pauseid}'"} @authors);
@@ -367,10 +375,12 @@ sub check_reports {
$last_id = $row->{id};
$row->{state} = uc $row->{state};
$self->{counts}{$row->{state}}++;
- my $author = $self->_get_author($row->{dist}, $row->{version}) || next;
$self->_log( "DEBUG: dist: $row->{dist} $row->{version} $row->{state}\n" ) if($self->debug);
+
+ my $author = $self->_get_author($row->{dist}, $row->{version});
$self->_log( "DEBUG: author: $author\n" ) if($self->debug);
+ next unless($author);
unless($author) {
$self->_log( "WARN: author not found for distribution [$row->{dist}], [$row->{version}]\n" );
@@ -393,14 +403,21 @@ sub check_reports {
# get distribution preferences
$prefs = $self->_get_prefs($author, $row->{dist});
+ $self->_log( "DEBUG: dist prefs: " .($prefs ? 'Found' : 'Not Found')."\n" ) if($self->debug);
next unless($prefs);
+ $self->_log( "DEBUG: dist prefs: ignored=" .($prefs->{ignored} || 0)."\n" ) if($self->debug);
next if($prefs->{ignored});
+ $self->_log( "DEBUG: dist prefs: report=$prefs->{report}, report type=$report_type\n" ) if($self->debug);
next if($prefs->{report} != $report_type);
+ $self->_log( "DEBUG: dist prefs: $row->{state}=" .($prefs->{grades}{$row->{state}}||'undef')."\n" ) if($self->debug);
+ $self->_log( "DEBUG: dist prefs: ALL=" .($prefs->{grades}{ALL}||'undef')."\n" ) if($self->debug);
next unless($prefs->{grades}{$row->{state}} || $prefs->{grades}{'ALL'});
+ $self->_log( "DEBUG: dist prefs: CONTINUE\n" ) if($self->debug);
# check whether only first instance required
if($prefs->{tuple} eq 'FIRST') {
my @count = $self->{CPANSTATS}->get_query('array',$phrasebook{'GetReportCount'}, $row->{platform}, $row->{perl}, $row->{state}, $row->{id});
+ $self->_log( "DEBUG: dist prefs: tuple=FIRST, count=".(scalar(@count))."\n" ) if($self->debug);
next if(@count > 1);
}
@@ -412,10 +429,13 @@ sub check_reports {
if($row->{version} && $prefs->{version} && $prefs->{version} ne 'ALL') {
if($prefs->{version} eq 'LATEST') {
my @vers = $self->{CPANSTATS}->get_query('array',$phrasebook{'GetLatestDistVers'},$row->{dist});
+ $self->_log( "DEBUG: dist prefs: vers=".(scalar(@vers))."\n" ) if($self->debug);
+ $self->_log( "DEBUG: dist prefs: version=$vers[0]->[0], $row->{version}\n" ) if($self->debug);
next if(@vers && $vers[0]->[0] ne $row->{version});
} else {
$prefs->{version} =~ s/\s*//g;
my %m = map {$_ => 1} split(',',$prefs->{version});
+ $self->_log( "DEBUG: dist prefs: $row->{version}\n" ) if($self->debug);
next unless($m{$row->{version}});
}
}
@@ -427,8 +447,10 @@ sub check_reports {
$prefs->{platform} =~ s/\./\\./g;
$prefs->{platform} =~ s/^(\w+)\|//;
if($1 && $1 eq 'NOT') {
+ $self->_log( "DEBUG: dist prefs: $row->{platform}, =~ $prefs->{platform}\n" ) if($self->debug);
next if($row->{platform} =~ /$prefs->{platform}/);
} else {
+ $self->_log( "DEBUG: dist prefs: $row->{platform}, !~ $prefs->{platform}\n" ) if($self->debug);
next if($row->{platform} !~ /$prefs->{platform}/);
}
}
@@ -444,15 +466,20 @@ sub check_reports {
my $v = version->new("$perlv")->numify;
$prefs->{platform} =~ s/^(\w+)\|//;
if($1 && $1 eq 'NOT') {
+ $self->_log( "DEBUG: dist prefs: $perlv || $v =~ $prefs->{perl}\n" ) if($self->debug);
next if($perlv =~ /$prefs->{perl}/ && $v =~ /$prefs->{perl}/);
} else {
+ $self->_log( "DEBUG: dist prefs: $perlv || $v !~ $prefs->{perl}\n" ) if($self->debug);
next if($perlv !~ /$prefs->{perl}/ && $v !~ /$prefs->{perl}/);
}
}
+ $self->_log( "DEBUG: dist prefs: patches=$prefs->{patches}, row perl $row->{perl}\n" ) if($self->debug);
# Check whether patches are required.
next if(!$prefs->{patches} && $row->{perl} =~ /patch/);
+ $self->_log( "DEBUG: report is being added to mailshot\n" ) if($self->debug);
+
if($mode eq 'reports') {
$self->_send_report($author,$row);
}
@@ -561,7 +588,8 @@ sub help {
print <<HERE;
Usage: $0 --config=<file> \\
- [--logfile=<file> [--logclean]] [--debug] [--lastmail=<file>]
+ [--logfile=<file> [--logclean]] [--debug] [--test=<id>]
+ [--lastmail=<file>]
[--mode=(daily|weekly|report|monthly|sun|mon|tue|wed|thu|fri|sat)]
[-h] [-v]
@@ -570,6 +598,7 @@ Usage: $0 --config=<file> \\
--logfile=<file> log file (*)
--logclean 0 = append, 1 = overwrite (*)
--debug debug mode, no mail sent (*)
+ --test=<id> test an id in debug mode, no mail sent (*)
--mode run mode (*)
-h this help screen
-v program version
View
@@ -3,7 +3,7 @@
use strict;
use warnings;
-use Test::More tests => 33;
+use Test::More tests => 37;
use CPAN::Testers::WWW::Reports::Mailer;
use lib 't';
@@ -16,6 +16,7 @@ ok( my $obj = CTWRM_Testing::getObj(), "got object" );
# predefined attributes
foreach my $k ( qw/
debug
+ test
logfile
logclean
tt
Oops, something went wrong.

0 comments on commit c01219d

Please sign in to comment.