Skip to content

Commit

Permalink
lastmail now configurable, plus lots of tests
Browse files Browse the repository at this point in the history
  • Loading branch information
barbie committed Jan 19, 2009
1 parent 88fc2b2 commit 1115416
Show file tree
Hide file tree
Showing 14 changed files with 483 additions and 27 deletions.
4 changes: 4 additions & 0 deletions CHANGES
@@ -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.
Expand Down
10 changes: 10 additions & 0 deletions MANIFEST
Expand Up @@ -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
Expand Down
4 changes: 2 additions & 2 deletions META.yml
@@ -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>
Expand Down Expand Up @@ -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
Expand Down
58 changes: 33 additions & 25 deletions lib/CPAN/Testers/WWW/Reports/Mailer.pm
Expand Up @@ -4,7 +4,7 @@ use warnings;
use strict;

use vars qw($VERSION);
$VERSION = '0.12';
$VERSION = '0.13';

=head1 NAME
Expand All @@ -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
Expand Down Expand Up @@ -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;
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -144,6 +149,7 @@ sub new {
my %options;
GetOptions( \%options,
'config=s',
'lastmail=s',
'logfile=s',
'logclean',
'debug',
Expand All @@ -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} ) );

Expand Down Expand Up @@ -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

}
Expand Down Expand Up @@ -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;
}
}
Expand Down Expand Up @@ -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;
}
Expand Down
54 changes: 54 additions & 0 deletions t/20attributes.t
@@ -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;

40 changes: 40 additions & 0 deletions t/30counts.t
@@ -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");
}
28 changes: 28 additions & 0 deletions t/31lastid.t
@@ -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');
}
19 changes: 19 additions & 0 deletions t/32get_author.t
@@ -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');
}

0 comments on commit 1115416

Please sign in to comment.