Permalink
Browse files

fixed subject, rewritten logic to improve performance

  • Loading branch information...
barbie committed Jun 6, 2009
1 parent 56b9116 commit 3467b5c357d87c791f8f1a9f85913c52a2f67fcd
Showing with 101 additions and 21 deletions.
  1. +8 −0 CHANGES
  2. +2 −2 META.yml
  3. +88 −16 lib/CPAN/Testers/WWW/Reports/Mailer.pm
  4. +2 −2 t/05setup_db-cpanstats.t
  5. +1 −1 t/31lastid.t
View
@@ -1,5 +1,13 @@
Revision history for Perl module CPAN::Testers::WWW::Reports::Mailer.
+0.17 06/06/2009
+ - fixed email subject bug. Thanks to TONYC & RCAPUTO for spotting it.
+ - changed the way _get_lastid() works.
+ - added _set_lastid() to shortcut updating to the latest report
+ - non-daily mode SQL rewritten to speed up processing.
+ - added _get_earliest() to get a realistic start id, if a given mode
+ hasn't been set with a last id.
+
0.16 23/04/2009
- added more tests
- added better reply-to handling
View
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: CPAN-Testers-WWW-Reports-Mailer
-version: 0.16
+version: 0.17
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.16
+ version: 0.17
meta-spec:
version: 1.4
@@ -4,7 +4,7 @@ use warnings;
use strict;
use vars qw($VERSION);
-$VERSION = '0.16';
+$VERSION = '0.17';
=head1 NAME
@@ -193,7 +193,13 @@ my @months = (
);
my %phrasebook = (
+ 'LastReport' => "SELECT MAX(id) FROM cpanstats",
+ 'GetEarliest' => "SELECT id FROM cpanstats WHERE fulldate > ? ORDER BY id LIMIT 1",
+
+ 'FindAuthorType' => "SELECT pauseid FROM prefs_distributions WHERE report = ?",
+
'GetReports' => "SELECT id,dist,version,platform,perl,state FROM cpanstats WHERE id > ? AND state IN ('pass','fail','na','unknown') ORDER BY id",
+ 'GetReports2' => "SELECT c.id,c.dist,c.version,c.platform,c.perl,c.state FROM cpanstats AS c WHERE c.id > ? AND c.state IN ('pass','fail','na','unknown') INNER JOIN ixlatest AS x ON x.dist=c.dist WHERE author IN (%s) ORDER BY id",
'GetReportCount' => "SELECT id FROM cpanstats WHERE platform=? AND perl=? AND state=? AND id < ? LIMIT 2",
'GetLatestDistVers' => "SELECT version FROM cpanstats WHERE dist=? AND state='cpan' ORDER BY id DESC LIMIT 1",
'GetAuthor' => "SELECT tester FROM cpanstats WHERE dist=? AND version=? AND state='cpan' LIMIT 1",
@@ -337,14 +343,24 @@ sub check_reports {
$self->_log( "INFO: START checking reports in '$mode' mode\n" );
$self->_log( "INFO: last_id=$last_id\n" );
- # find all reports since last update
- my $rows = $self->{CPANSTATS}->iterator('hash',$phrasebook{'GetReports'},$last_id);
- unless($rows) {
- $self->_log( "INFO: STOP checking reports\n" );
- return;
+ my $next;
+ if($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);
+ $next = $self->{CPANSTATS}->iterator('hash',$sql,$last_id);
+ } else {
+ # find all reports since last update
+ $next = $self->{CPANSTATS}->iterator('hash',$phrasebook{'GetReports'},$last_id);
+ unless($next) {
+ $self->_log( "INFO: STOP checking reports\n" );
+ return;
+ }
}
- while( my $row = $rows->()) {
+ my $rows = 0;
+ while( my $row = $next->()) {
+ $rows++;
$self->_log( "DEBUG: processing report: $row->{id}\n" ) if($self->debug);
$self->{counts}{REPORTS}++;
@@ -436,6 +452,8 @@ sub check_reports {
push @{$reports{$author}->{dists}{$row->{dist}}->{versions}{$row->{version}}->{platforms}{$row->{platform}}->{perls}{$row->{perl}}->{states}{uc $row->{state}}->{value}}, $row->{id};
}
+ return $self->_set_lastid() unless($rows);
+
if($mode ne 'reports') {
$self->_log( "DEBUG: processing authors: ".(scalar(keys %reports))."\n" ) if($self->debug);
@@ -505,15 +523,13 @@ sub check_reports {
$tvars{dists} = \@e;
$tvars{period} = $MODES{$mode}->{period};
$tvars{report} = $MODES{$mode}->{report};
- $tvars{subject} = 'CPAN Testers $tvars{report} Report';
+ $tvars{subject} = "CPAN Testers $tvars{report} Report";
$self->_write_mail('mailer.eml',\%tvars);
}
}
- $self->_get_lastid($last_id) unless($self->debug);
- $self->_log( "INFO: new last_id=$last_id\n" );
- $self->_log( "INFO: STOP checking reports\n" );
+ $self->_set_lastid($last_id);
}
sub check_counts {
@@ -569,6 +585,8 @@ HERE
=item * _get_lastid
+=item * _set_lastid
+
=item * _get_author
=item * _get_prefs
@@ -591,22 +609,76 @@ sub _get_lastid {
overwrite_file( $self->lastmail, 'daily=0,weekly=0,reports=0' ) unless -f $self->lastmail;
- if ($id) {
+ if (defined $id) {
my $text = read_file($self->lastmail);
if($text =~ m!$mode=\d+!) {
$text =~ s!($mode=)\d+!$1$id!;
} else {
$text .= ",$mode=$id"; # auto add mode
}
+ $text =~ s/\s+//g;
overwrite_file( $self->lastmail, $text );
+ return $id;
+ }
+
+ my $text = read_file($self->lastmail);
+ return $id if(($id) = $text =~ m!$mode=(\d+)!);
+ return $self->_get_earliest(); # mode not found, find earliest id based on mode
+}
+
+sub _set_lastid {
+ my ($self,$id) = @_;
+
+ if(!defined $id) {
+ my @lastid = $self->{CPANPREFS}->get_query('array',$phrasebook{'LastReport'});
+ $id = @lastid ? $lastid[0]->[0] : 0;
+ }
+
+ $self->_log( "INFO: new last_id=$id\n" );
+ $self->_log( "INFO: STOP checking reports\n" );
+
+ return $id if($self->debug);
+
+ $self->_get_lastid($id);
+}
+
+sub _get_earliest {
+ my $self = shift;
+ my $mode = $self->mode;
+
+ my @date = localtime(time);
+ $date[5] += 1900;
+ $date[4] += 1;
+ if($mode eq 'monthly') {
+ $date[4] -= 1;
+ $date[3] = 1;
+ } elsif($mode eq 'daily' || $mode eq 'reports') {
+ $date[3] -= 1;
} else {
- my $text = read_file($self->lastmail);
- if(($id) = $text =~ m!$mode=(\d+)!) {
- return $id;
+ $date[3] -=7;
+ }
+
+ if($date[3] < 1) {
+ $date[4] -= 1;
+ if($date[4] == 2 && $date[5] % 4) {
+ $date[3] = 28 - $date[3];
+ } elsif($date[3] == 2) {
+ $date[3] = 29 - $date[3];
+ } elsif($date[3] == 4 || $date[3] == 6 || $date[3] == 9 || $date[3] == 11) {
+ $date[3] = 30 - $date[3];
} else {
- return 0; # mode not found start from zero
+ $date[3] = 31 - $date[3];
+ }
+ if($date[4] < 1) {
+ $date[4] = 12;
+ $date[5] -= 1;
}
}
+
+ my $fulldate = sprintf "%04d%02d%02d000000", $date[5], $date[4], $date[3];
+ my @report = $self->{CPANSTATS}->get_query('array',$phrasebook{'GetEarliest'}, $fulldate);
+ return 0 unless(@report);
+ return $report[0]->[0] || 0;
}
sub _get_author {
View
@@ -27,13 +27,13 @@ $dbh->do(q{
perl TEXT,
osname TEXT,
osvers TEXT,
- date TEXT
+ fulldate TEXT
)
});
while(<DATA>){
chomp;
- $dbh->do('INSERT INTO cpanstats ( id, state, postdate, tester, dist, version, platform, perl, osname, osvers, date ) VALUES ( ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ? )', {}, split(/\|/,$_) );
+ $dbh->do('INSERT INTO cpanstats ( id, state, postdate, tester, dist, version, platform, perl, osname, osvers, fulldate ) VALUES ( ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ? )', {}, split(/\|/,$_) );
}
$dbh->do(q{ CREATE INDEX distverstate ON cpanstats (dist, version, state) });
View
@@ -13,7 +13,7 @@ use CTWRM_Testing;
{
ok( my $obj = CTWRM_Testing::getObj(), "got object" );
- my $f = File::Spec->catfile('t','_DBDIR','lastmail');
+ my $f = 't/_DBDIR/lastmail';
ok($obj->lastmail($f),'reset last mail file');
is($obj->lastmail,$f, 'reset last mail');

0 comments on commit 3467b5c

Please sign in to comment.