Permalink
Browse files

lastmail now configurable, plus lots of tests

  • Loading branch information...
1 parent 88fc2b2 commit 111541691077bb418019ea0ab40f22312d16bdba barbie committed Jan 19, 2009
Showing with 483 additions and 27 deletions.
  1. +4 −0 CHANGES
  2. +10 −0 MANIFEST
  3. +2 −2 META.yml
  4. +33 −25 lib/CPAN/Testers/WWW/Reports/Mailer.pm
  5. +54 −0 t/20attributes.t
  6. +40 −0 t/30counts.t
  7. +28 −0 t/31lastid.t
  8. +19 −0 t/32get_author.t
  9. +99 −0 t/33prefs.t
  10. +11 −0 t/50logging.ini
  11. +73 −0 t/50logging.t
  12. +27 −0 t/51init.t
  13. +24 −0 t/59cleanup.t
  14. +59 −0 t/CTWRM_Testing.pm
View
@@ -1,5 +1,9 @@
Revision history for Perl module CPAN::Testers::WWW::Reports::Mailer.
+0.13 19/01/2009
+ - added more tests (now up to 43.4% coverage).
+ - enabled lastmail to be a configurable setting.
+
0.12 19/01/2009
- moved to OO style of API.
- updated cpanreps-mailer (0.05) to use new OO API.
View
@@ -8,6 +8,16 @@ MANIFEST
META.yml
README
t/01base.t
+t/20attributes.t
+t/30counts.t
+t/31lastid.t
+t/32get_author.t
+t/33prefs.t
+t/50logging.ini
+t/50logging.t
+t/51init.t
+t/59cleanup.t
+t/CTWRM_Testing.pm
t/90podtest.t
t/91podcover.t
t/94metatest.t
View
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: CPAN-Testers-WWW-Reports-Mailer
-version: 0.12
+version: 0.13
abstract: CPAN Testers Reports Mailer
author:
- Barbie <barbie@cpan.org>
@@ -30,7 +30,7 @@ requires:
provides:
CPAN::Testers::WWW::Reports::Mailer:
file: lib/CPAN/Testers/WWW/Reports/Mailer.pm
- version: 0.12
+ version: 0.13
meta-spec:
version: 1.4
@@ -4,7 +4,7 @@ use warnings;
use strict;
use vars qw($VERSION);
-$VERSION = '0.12';
+$VERSION = '0.13';
=head1 NAME
@@ -14,7 +14,12 @@ CPAN::Testers::WWW::Reports::Mailer - CPAN Testers Reports Mailer
use CPAN::Testers::WWW::Reports::Mailer;
- # TO BE COMPLETED
+ my $mailer = CPAN::Testers::WWW::Reports::Mailer->new(
+ config => 'myconfig.ini'
+ );
+
+ $mailer->check_reports();
+ $mailer->check_counts();
=head1 DESCRIPTION
@@ -57,13 +62,13 @@ use base qw(Class::Accessor::Chained::Fast);
# default configuration settings
my %default = (
+ LASTMAIL => '_lastmail',
DEBUG => 1,
logclean => 0
);
my (%AUTHORS,%PREFS);
-use constant LASTMAIL => '_lastmail';
use constant DAILY_SUMMARY => 1;
use constant WEEKLY_SUMMARY => 2;
use constant INDIVIDUAL_REPORTS => 3;
@@ -113,7 +118,7 @@ my %phrasebook = (
# The Application Programming Interface
__PACKAGE__->mk_accessors(
- qw( debug logfile logclean tt pause ));
+ qw( lastmail debug logfile logclean tt pause ));
# -------------------------------------
# The Public Interface Functions
@@ -144,6 +149,7 @@ sub new {
my %options;
GetOptions( \%options,
'config=s',
+ 'lastmail=s',
'logfile=s',
'logclean',
'debug',
@@ -170,7 +176,8 @@ sub new {
die "Cannot configure $db database\n" unless($self->{$db});
}
- $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->debug( $self->_defined_or( $options{debug}, $hash{debug}, $cfg->val('SETTINGS','DEBUG' ), $default{DEBUG}) );
$self->logfile( $self->_defined_or( $options{logfile}, $hash{logfile}, $cfg->val('SETTINGS','logfile' ) ) );
$self->logclean($self->_defined_or( $options{logclean}, $hash{logclean}, $cfg->val('SETTINGS','logclean' ), $default{logclean} ) );
@@ -388,22 +395,25 @@ sub check_counts {
}
sub help {
- my $self = shift;
- my $full = shift;
+ my ($self,$full) = @_;
if($full) {
print <<HERE;
Usage: $0 --config=<file> \\
- [--logfile=<file> [--logclean]] [--debug] [-h] [-v]
+ [--logfile=<file> [--logclean]] [--debug] [--lastmail=<file>]
+ [-h] [-v]
--config=<file> database configuration file
- --logfile=<file> log file
- --logclean 0 = append, 1 = overwrite
- --debug debug mode, no mail sent
+ --lastmail=<file> lastmail counter file (*)
+ --logfile=<file> log file (*)
+ --logclean 0 = append, 1 = overwrite (*)
+ --debug debug mode, no mail sent (*)
-h this help screen
-v program version
+ NOTES:
+ * - these will override any settings within the configuration file.
HERE
}
@@ -438,15 +448,14 @@ HERE
=cut
sub _get_lastid {
- my $self = shift;
- my $id = shift;
+ my ($self,$id) = @_;
- overwrite_file( LASTMAIL, 0 ) unless -f LASTMAIL;
+ overwrite_file( $self->lastmail, 0 ) unless -f $self->lastmail;
if ($id) {
- overwrite_file( LASTMAIL, $id );
+ overwrite_file( $self->lastmail, $id );
} else {
- my $id = read_file(LASTMAIL);
+ my $id = read_file($self->lastmail);
return $id;
}
}
@@ -525,21 +534,20 @@ sub _get_prefs {
}
sub _parse_prefs {
- my $self = shift;
- my $row = shift;
+ my ($self,$row) = @_;
my %hash;
$row->{grade} ||= 'FAIL';
my %grades = map {$_ => 1} split(',',$row->{grade});
$hash{grades} = \%grades;
- $hash{ignored} = $row->{ignored} || 0;
- $hash{report} = $row->{report} || 1;
- $hash{tuple} = $row->{tuple} || 'FIRST';
- $hash{version} = $row->{version} || 'LATEST';
- $hash{patches} = $row->{patches} || 0;
- $hash{perl} = $row->{perl} || 'ALL';
- $hash{platform} = $row->{platform} || 'ALL';
+ $hash{ignored} = $self->_defined_or($row->{ignored}, 0);
+ $hash{report} = $self->_defined_or($row->{report}, 1);
+ $hash{tuple} = $self->_defined_or($row->{tuple}, 'FIRST');
+ $hash{version} = $self->_defined_or($row->{version}, 'LATEST');
+ $hash{patches} = $self->_defined_or($row->{patches}, 0);
+ $hash{perl} = $self->_defined_or($row->{perl}, 'ALL');
+ $hash{platform} = $self->_defined_or($row->{platform}, 'ALL');
return \%hash;
}
View
@@ -0,0 +1,54 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 25;
+use CPAN::Testers::WWW::Reports::Mailer;
+
+use lib 't';
+use CTWRM_Testing;
+
+ok( my $obj = CTWRM_Testing::getObj(), "got object" );
+
+# test the attributes generated by Class::Accessor::Chained::Fast
+
+# predefined attributes
+foreach my $k ( qw/
+ debug
+ logfile
+ logclean
+ tt
+ pause
+ lastmail
+/ ){
+ my $label = "[$k]";
+ SKIP: {
+ 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, "$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" );
+# };
+#}
+
+# TODO -- test these:
+# $MAX_ID;
+
View
@@ -0,0 +1,40 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 2;
+use CPAN::Testers::WWW::Reports::Mailer;
+
+use lib 't';
+use CTWRM_Testing;
+
+{
+ ok( my $obj = CTWRM_Testing::getObj(), "got object" );
+
+ $obj->check_counts;
+
+ my ($counts,@log);
+ open FILE, '<', $obj->logfile;
+ while(<FILE>) {
+ next unless($counts || /COUNTS:/);
+ $counts = 1;
+ chomp;
+ push @log, substr($_,21);
+ }
+
+ is_deeply(\@log, [
+ 'INFO: COUNTS:',
+ 'INFO: REPORTS = 0',
+ 'INFO: PASS = 0',
+ 'INFO: FAIL = 0',
+ 'INFO: UNKNOWN = 0',
+ 'INFO: NA = 0',
+ 'INFO: NOMAIL = 0',
+ 'INFO: MAILS = 0',
+ 'INFO: NEWAUTH = 0',
+ 'INFO: GOOD = 0',
+ 'INFO: BAD = 0',
+ 'INFO: TEST = 0',
+ ], "log written");
+}
View
@@ -0,0 +1,28 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 9;
+use CPAN::Testers::WWW::Reports::Mailer;
+
+use lib 't';
+use CTWRM_Testing;
+
+{
+ ok( my $obj = CTWRM_Testing::getObj(), "got object" );
+
+ my $f = File::Spec->catfile('t','_DBDIR','lastmail');
+ ok($obj->lastmail($f),'reset last mail file');
+ is($obj->lastmail,$f, 'reset last mail');
+
+ ok(!-f $f, 'lastmail not created');
+ is($obj->_get_lastid,0, 'new last id');
+ ok(-f $f, 'lastmail now exists');
+ ok($obj->_get_lastid(12), 'set last id');
+ is($obj->_get_lastid,12, 'get last id');
+
+ my ($counts,@log);
+ my @lines = do { open FILE, '<', $obj->lastmail; <FILE> };
+ is($lines[0],12, 'read last id');
+}
View
@@ -0,0 +1,19 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 5;
+use CPAN::Testers::WWW::Reports::Mailer;
+
+use lib 't';
+use CTWRM_Testing;
+
+{
+ ok( my $obj = CTWRM_Testing::getObj(), "got object" );
+
+ is($obj->_get_author('Abstract-Meta-Class','0.11'),'ADRIANWIT','found author ADRIANWIT');
+ is($obj->_get_author('Acme-CPANAuthors-French','0.07'),'SAPER','found author SAPER');
+ is($obj->_get_author('Acme-Buffy','1.5'),'LBROCARD','found author LBROCARD');
+ is($obj->_get_author('AI-NeuralNet-Mesh','0.44'),'JBRYAN','found author JBRYAN');
+}
Oops, something went wrong.

0 comments on commit 1115416

Please sign in to comment.