Permalink
Browse files

added submission rate graphs

  • Loading branch information...
1 parent f4c66ec commit b49092e8168ee27244c380fc872099cb5cd45f47 @barbie committed Jun 3, 2014
Showing with 105 additions and 15 deletions.
  1. +1 −0 Changes
  2. +26 −15 lib/CPAN/Testers/WWW/Statistics/Graphs.pm
  3. +78 −0 lib/CPAN/Testers/WWW/Statistics/Pages.pm
View
@@ -3,6 +3,7 @@ Revision history for CPAN-Testers-WWW-Statistics
- added new distributions pages.
- added new distribution versions page.
+ - added submission rate graphs.
1.12 2014-06-02
- added cpan/backpan 100 files to CPAN Stats page creation.
@@ -34,6 +34,7 @@ Note that this package should not be called directly, but via its parent as:
# -------------------------------------
# Library Modules
+use File::Basename;
use File::Path;
use HTML::Entities;
use IO::File;
@@ -52,14 +53,18 @@ my %month = (
my ($backg,$foreg) = ('black','white');
my @graphs = (
-['stats1' ,'CPAN Testers Statistics - Reports', [qw(UPLOADS REPORTS PASS FAIL)], 'TEST_RANGES', 'month'],
-['stats2' ,'CPAN Testers Statistics - Attributes', [qw(TESTERS PLATFORMS PERLS)], 'TEST_RANGES', 'month'],
-['stats3' ,'CPAN Testers Statistics - Non-Passes', [qw(FAIL NA UNKNOWN)], 'TEST_RANGES', 'month'],
-['stats4' ,'CPAN Testers Statistics - Testers', [qw(ALL FIRST LAST)], 'TEST_RANGES', 'month'],
-['stats6' ,'CPAN Statistics - Uploads', [qw(AUTHORS DISTROS)], 'CPAN_RANGES', 'month'],
-['stats12','CPAN Statistics - New Uploads', [qw(AUTHORS DISTROS)], 'CPAN_RANGES', 'month'],
-['build1' ,'CPAN Testers Performance Graph', [qw(REQUESTS PAGES REPORTS)], 'NONE', 'daily'],
-['pcent1' ,'CPAN Testers Statistics - Percentages', [qw(FAIL OTHER PASS)], 'TEST_RANGES', 'month'],
+['stats/stats1' ,'CPAN Testers Statistics - Reports' ,[qw(UPLOADS REPORTS PASS FAIL)],'TEST_RANGES' ,'month'],
+['stats/stats2' ,'CPAN Testers Statistics - Attributes' ,[qw(TESTERS PLATFORMS PERLS)] ,'TEST_RANGES' ,'month'],
+['stats/stats3' ,'CPAN Testers Statistics - Non-Passes' ,[qw(FAIL NA UNKNOWN)] ,'TEST_RANGES' ,'month'],
+['stats/stats4' ,'CPAN Testers Statistics - Testers' ,[qw(ALL FIRST LAST)] ,'TEST_RANGES' ,'month'],
+['stats/stats6' ,'CPAN Statistics - Uploads' ,[qw(AUTHORS DISTROS)] ,'CPAN_RANGES' ,'month'],
+['stats/stats12' ,'CPAN Statistics - New Uploads' ,[qw(AUTHORS DISTROS)] ,'CPAN_RANGES' ,'month'],
+['stats/build1' ,'CPAN Testers Performance Graph' ,[qw(REQUESTS PAGES REPORTS)] ,'NONE' ,'daily'],
+['stats/pcent1' ,'CPAN Testers Statistics - Percentages',[qw(FAIL OTHER PASS)] ,'TEST_RANGES' ,'month'],
+['rates/submit1' ,'CPAN Submissions - By Month' ,[qw(EXCLUSIVE INCLUSIVE)] ,'NONE' ,'index'],
+['rates/submit2' ,'CPAN Submissions - By Day of the Week',[qw(EXCLUSIVE INCLUSIVE)] ,'NONE' ,'index'],
+['rates/submit3' ,'CPAN Submissions - By Day' ,[qw(EXCLUSIVE INCLUSIVE)] ,'NONE' ,'index'],
+['rates/submit4' ,'CPAN Submissions - By Hour' ,[qw(EXCLUSIVE INCLUSIVE)] ,'NONE' ,'index'],
);
my $lwp = LWP::UserAgent->new();
@@ -145,12 +150,15 @@ sub create {
my $status = 1; # assume failure
my $directory = $self->{parent}->directory;
- my $results = "$directory/stats";
- mkpath($results);
$self->{parent}->_log("create start");
for my $g (@graphs) {
+ my $results = "$directory/$g->[0]";
+ my ($path,$file) = (dirname($results),basename($results));
+ mkpath($path);
+ $g->[0] = $file;
+
my $ranges = $self->{parent}->ranges($g->[3]);
$self->{parent}->_log("writing graph - got range [$g->[3]] = " . (scalar(@$ranges)) . ", latest=$ranges->[-1]");
@@ -172,19 +180,19 @@ sub create {
};
if($@ || !$res->is_success()) {
- my $file = "$results/$g->[0]-$r.html";
+ $file = "$results-$r.html";
warn("FAIL: $0 - Cannot access page - see '$file' [$url] [" . length($url) . "] [$@]\n");
_save_content($res,$file);
} elsif($res->header('Content-Type') =~ /html/) {
- my $file = "$results/$g->[0]-$r.html";
+ $file = "$results-$r.html";
warn("FAIL: $0 - request failed - see '$file'\n");
_save_content($res,$file);
} else {
- my $file = "$results/$g->[0]-$r.png";
+ $file = "$results-$r.png";
_save_content($res,$file);
if($r eq $latest) {
- $file = "$results/$g->[0].png";
+ $file = "$results.png";
_save_content($res,$file);
}
$status = 0;
@@ -222,7 +230,10 @@ sub _make_graph {
return unless(@data);
for my $date (@{$data[0]}) {
- if($type eq 'month') {
+ if($type eq 'index') {
+ push @dates1, "'";
+ push @dates2, $date;
+ } elsif($type eq 'month') {
my $year = substr($date,0,4);
my $month = substr($date,4,2);
push @dates1, ($month % 2 == 1 ? $MONTHS[$month][0] : '');
@@ -813,6 +813,7 @@ sub _report_cpan {
$self->_writepage('trends',\%tvars);
$self->_report_new_distros();
+ $self->_report_submissions();
$self->{parent}->_log("building cpan leader page");
@@ -1024,6 +1025,83 @@ sub _report_new_distros {
$self->_writepage("newdistros/newversions",$tvars);
}
+sub _report_submissions {
+ my $self = shift;
+
+ $self->{parent}->_log("building submission data files");
+
+ my $sql = 'select from_unixtime(released) as reldate from uploads';
+
+ my $now = DateTime->now;
+ my (%hours,%days,%months,%dotw,%tvars);
+
+ my $next = $self->{parent}->{CPANSTATS}->iterator('hash',$sql);
+ for my $row ($next->()) {
+ next unless($row->{reldate} && $row->{reldate} =~ /^(\d+)\-(\d+)\-(\d+).(\d+):(\d+):(\d+)/);
+ my ($year,$month,$day,$hour,$minute,$second) = ($1,$2,$3,$4,$5,$6);
+
+ my $date = DateTime->new( year => $year, month => $month, day => $day, hour => $hour, minute => $minute, second => $second );
+ my $dotw = $date->day_of_week;
+
+ $months{that}{$month}++;
+ $dotw{that}{$dotw}++;
+ $days{that}{$day}++;
+ $hours{that}{$hour}++;
+
+ if($year != $now->year) {
+ $months{this}{$month}++;
+ $dotw{this}{$dotw}++;
+ } elsif($date->week_number != $now->week_number) {
+ $dotw{this}{$dotw}++;
+ }
+
+ if(( $year != $now->year) ||
+ ( $year == $now->year && $month != $now->month) ) {
+ $days{this}{$day}++;
+ }
+
+ if(( $year != $now->year) ||
+ ( $year == $now->year && $month != $now->month) ||
+ ( $year == $now->year && $month == $now->month && $day != $now->day) ) {
+ $hours{this}{$hour}++;
+ }
+ }
+
+ my $directory = $self->{parent}->directory;
+ my $results = "$directory/rates";
+ mkpath($results);
+
+ my $fh = IO::File->new(">$results/submit1.txt");
+ print $fh "#INDEX,EXCLUSIVE,INCLUSIVE\n";
+ for my $month (sort {$a <=> $b} keys %{$months{this}}) {
+ printf $fh "%d,%d,%d\n", $month, $months{this}{$month}, $months{that}{$month};
+ }
+ $fh->close;
+
+ $fh = IO::File->new(">$results/submit2.txt");
+ print $fh "#INDEX,EXCLUSIVE,INCLUSIVE\n";
+ for my $dotw (sort {$a <=> $b} keys %{$dotw{this}}) {
+ printf $fh "%d,%d,%d\n", $dotw, $dotw{this}{$dotw}, $dotw{that}{$dotw};
+ }
+ $fh->close;
+
+ $fh = IO::File->new(">$results/submit3.txt");
+ print $fh "#INDEX,EXCLUSIVE,INCLUSIVE\n";
+ for my $day (sort {$a <=> $b} keys %{$days{this}}) {
+ printf $fh "%d,%d,%d\n", $day, $days{this}{$day}, $days{that}{$day};
+ }
+ $fh->close;
+
+ $fh = IO::File->new(">$results/submit4.txt");
+ print $fh "#INDEX,EXCLUSIVE,INCLUSIVE\n";
+ for my $hour (sort {$a <=> $b} keys %{$hours{this}}) {
+ printf $fh "%d,%d,%d\n", $hour, $hours{this}{$hour}, $hours{that}{$hour};
+ }
+ $fh->close;
+
+ $self->_writepage('rates',\%tvars);
+}
+
sub _update_noreports {
my $self = shift;

0 comments on commit b49092e

Please sign in to comment.