Permalink
Browse files

ALL fix and tons of tests and samples

  • Loading branch information...
1 parent b343de9 commit 2f0c7f3c815b5db6c440c2c2b04820cc76c00765 @barbie barbie committed Jul 27, 2009
View
@@ -1,5 +1,9 @@
Revision history for Perl module CPAN::Testers::WWW::Reports::Mailer.
+0.18 27/07/2009
+ - fix for ALL grades.
+ - expanded test suite and samples considerably
+
0.17 06/06/2009
- fixed email subject bug. Thanks to TONYC & RCAPUTO for spotting it.
- changed the way _get_lastid() works.
View
@@ -19,12 +19,36 @@ t/33prefs.t
t/50logging.ini
t/50logging.t
t/51init.t
-t/59cleanup.t
+t/60setup_db-articles.t
+t/60setup_db-cpanstats.t
+t/60setup_db-ixlatest.t
+t/61daily.t
+t/62daily.t
+t/63daily.t
+t/64daily.t
+t/65daily.t
+t/66daily.t
+t/67reports.t
+t/70setup_db-cpanstats.t
+t/70setup_db-ixlatest.t
+t/71daily.t
+t/89cleanup.t
t/CTWRM_Testing.pm
t/90podtest.t
t/91podcover.t
t/94metatest.t
t/95changedate.t
+t/data/61daily.eml
+t/data/62daily.eml
+t/data/63daily.eml
+t/data/64daily.eml
+t/data/67reports.eml
+t/data/71daily.eml
+t/data/preferences-daily.ini
+t/data/preferences-reports.ini
+t/samples/4766103
+t/samples/4766403
+t/samples/4766801
templates/mailer.eml
templates/notification.eml
templates/report.eml
View
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: CPAN-Testers-WWW-Reports-Mailer
-version: 0.17
+version: 0.18
abstract: CPAN Testers Reports Mailer
author:
- Barbie <barbie@cpan.org>
@@ -12,7 +12,7 @@ installdirs: site
requires:
Compress::Zlib: 0
Config::IniFiles: 0
- Class::Accessor::Chained::Fast: 0
+ Class::Accessor::Fast: 0
CPAN::Testers::Common::DBUtils: 0.03
Email::Address: 0
Email::Simple: 0
@@ -34,7 +34,7 @@ requires:
provides:
CPAN::Testers::WWW::Reports::Mailer:
file: lib/CPAN/Testers/WWW/Reports/Mailer.pm
- version: 0.17
+ version: 0.18
meta-spec:
version: 1.4
View
@@ -6,7 +6,7 @@ WriteMakefile(
'Compress::Zlib' => 0,
'Config::IniFiles' => 0,
- 'Class::Accessor::Chained::Fast' => 0,
+ 'Class::Accessor::Fast' => 0,
'CPAN::Testers::Common::DBUtils' => 0.03,
'Email::Address' => 0,
'Email::Simple' => 0,
@@ -4,7 +4,7 @@ use warnings;
use strict;
use vars qw($VERSION);
-$VERSION = '0.17';
+$VERSION = '0.18';
=head1 NAME
@@ -135,7 +135,7 @@ use Template;
use Time::Piece;
use version;
-use base qw(Class::Accessor::Chained::Fast);
+use base qw(Class::Accessor::Fast);
# -------------------------------------
# Variables
@@ -298,7 +298,7 @@ sub new {
die "mode can MUST be 'daily', 'weekly', 'monthly', 'reports', or a day of the week.\n";
}
- $self->pause ($self->_download_mailrc());
+ $self->pause($self->_download_mailrc());
# set up API to Template Toolkit
$self->tt( Template->new(
@@ -369,6 +369,9 @@ sub check_reports {
$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);
+ $self->_log( "DEBUG: author: $author\n" ) if($self->debug);
+
unless($author) {
$self->_log( "WARN: author not found for distribution [$row->{dist}], [$row->{version}]\n" );
next;
@@ -384,14 +387,16 @@ sub check_reports {
# do we need to worry about this author?
if($prefs->{active} == 2) {
$self->{counts}{NOMAIL}++;
+ $self->_log( "DEBUG: author: $author - not active\n" ) if($self->debug);
next;
}
# get distribution preferences
- $prefs = $self->_get_prefs($author, $row->{dist}) || next;
+ $prefs = $self->_get_prefs($author, $row->{dist});
+ next unless($prefs);
next if($prefs->{ignored});
next if($prefs->{report} != $report_type);
- next unless($prefs->{grades}{$row->{state}});
+ next unless($prefs->{grades}{$row->{state}} || $prefs->{grades}{'ALL'});
# check whether only first instance required
if($prefs->{tuple} eq 'FIRST') {
@@ -490,19 +495,19 @@ sub check_reports {
$self->_log( "DEBUG: $author - distributions = ".(scalar(keys %{$reports{$author}->{dists}}))."\n" ) if($self->debug);
my ($reports,@e);
- for my $dist (keys %{$reports{$author}->{dists}}) {
+ for my $dist (sort keys %{$reports{$author}->{dists}}) {
my $v = $reports{$author}->{dists}{$dist};
my @d;
- for my $version (keys %{$v->{versions}}) {
+ for my $version (sort keys %{$v->{versions}}) {
my $w = $v->{versions}{$version};
my @c;
- for my $platform (keys %{$w->{platforms}}) {
+ for my $platform (sort keys %{$w->{platforms}}) {
my $x = $w->{platforms}{$platform};
my @b;
- for my $perl (keys %{$x->{perls}}) {
+ for my $perl (sort keys %{$x->{perls}}) {
my $y = $x->{perls}{$perl};
my @a;
- for my $state (keys %{$y->{states}}) {
+ for my $state (sort keys %{$y->{states}}) {
my $z = $y->{states}{$state};
push @a, {state => $state, ids => $z->{value}};
$reports++;
@@ -607,7 +612,10 @@ sub _get_lastid {
my ($self,$id) = @_;
my $mode = $self->mode;
- overwrite_file( $self->lastmail, 'daily=0,weekly=0,reports=0' ) unless -f $self->lastmail;
+ unless( -f $self->lastmail ) {
+ mkpath(dirname($self->lastmail));
+ overwrite_file( $self->lastmail, 'daily=0,weekly=0,reports=0' );
+ }
if (defined $id) {
my $text = read_file($self->lastmail);
@@ -783,6 +791,8 @@ sub _send_report {
# get article
my @rows = $self->{ARTICLES}->get_query('hash',$phrasebook{'GetArticle'}, $row->{id});
+ #$self->_log( "ARTICLE: $row->{id}: $rows[0]->{article}\n" );
+
# disassemble article
$rows[0]->{article} = decode_qp($rows[0]->{article}) if($rows[0]->{article} =~ /=3D/);
my $mail = Email::Simple->new($rows[0]->{article});
@@ -926,10 +936,11 @@ __END__
=head1 SEE ALSO
-L<CPAN::WWW::Testers::Generator>
+L<CPAN::Testers::Data::Generator>
L<CPAN::WWW::Testers>
L<CPAN::Testers::WWW::Statistics>
+F<http://blog.cpantesters.org/>,
F<http://www.cpantesters.org/>,
F<http://stats.cpantesters.org/>,
F<http://wiki.cpantesters.org/>
@@ -5,12 +5,12 @@ use warnings;
$|=1;
use Test::More tests => 1;
use DBI;
-use DBD::SQLite;
+#use DBD::SQLite;
use File::Spec;
use File::Path;
use File::Basename;
-my $f = File::Spec->catfile('t','_DBDIR','test2.db');
+my $f = File::Spec->catfile('t','_DBDIR','test3.db');
unlink $f if -f $f;
mkpath( dirname($f) );
@@ -35,4 +35,4 @@ is($ct, 2, "row count for articles");
__DATA__
3000001|This is a FAIL
-3000002|This is a PASS
+3000002|This is a PASS
@@ -5,7 +5,7 @@ use warnings;
$|=1;
use Test::More tests => 2;
use DBI;
-use DBD::SQLite;
+#use DBD::SQLite;
use File::Spec;
use File::Path;
use File::Basename;
@@ -5,7 +5,7 @@ use warnings;
$|=1;
use Test::More tests => 1;
use DBI;
-use DBD::SQLite;
+#use DBD::SQLite;
use File::Spec;
use File::Path;
use File::Basename;
View
@@ -11,7 +11,7 @@ use CTWRM_Testing;
ok( my $obj = CTWRM_Testing::getObj(), "got object" );
-# test the attributes generated by Class::Accessor::Chained::Fast
+# test the attributes generated by Class::Accessor::Fast
# predefined attributes
foreach my $k ( qw/
@@ -29,25 +29,8 @@ foreach my $k ( qw/
ok( $obj->can($k), "$label can" )
or skip "'$k' attribute missing", 3;
isnt( $obj->$k(), undef, "$label has default" );
- is( $obj->$k(123), $obj, "$label set" ); # chained, so returns object, not value.
+ is( $obj->$k(123), 123, "$label set" );
is( $obj->$k, 123, "$label get" );
};
}
-# undefined attributes
-#foreach my $k ( qw/
-# authors
-# perls
-# logfile
-# mode
-#/ ){
-# my $label = "[$k]";
-# SKIP: {
-# ok( $obj->can($k), "$label can" )
-# or skip "'$k' attribute missing", 3;
-# is( $obj->$k(), undef, "$label has no default" );
-# is( $obj->$k(123), $obj, "$label set" ); # chained, so returns object, not value.
-# is( $obj->$k, 123, "$label get" );
-# };
-#}
-
@@ -0,0 +1,42 @@
+#!perl
+
+use strict;
+use warnings;
+$|=1;
+
+use lib 't';
+use lib qw(./lib ../lib);
+
+use Test::More tests => 1;
+use DBI;
+#use DBD::SQLite;
+use File::Spec;
+use File::Path;
+use File::Basename;
+use File::Slurp;
+
+my @articles = qw(4766103 4766403 4766801);
+
+my $f = File::Spec->catfile('t','_DBDIR','test3.db');
+unlink $f if -f $f;
+mkpath( dirname($f) );
+
+my $dbh = DBI->connect("dbi:SQLite:dbname=$f", '', '', {AutoCommit=>1});
+$dbh->do(q{
+ CREATE TABLE articles (
+ id INTEGER PRIMARY KEY,
+ article TEXT
+ )
+});
+
+for my $id (@articles) {
+ my $text = read_file('t/samples/'.$id);
+ $dbh->do('INSERT INTO articles ( id, article ) VALUES ( ?, ? )', {}, $id, $text );
+}
+
+my ($ct) = $dbh->selectrow_array('select count(*) from articles');
+
+$dbh->disconnect;
+
+is($ct, 3, "row count for articles");
+
Oops, something went wrong.

0 comments on commit 2f0c7f3

Please sign in to comment.