File Coverage

blib/lib/CPAN/Testers/WWW/Statistics/Pages.pm
Criterion Covered Total %
statement 45 1296 3.4
branch 0 366 0.0
condition 0 168 0.0
subroutine 15 52 28.8
pod 14 14 100.0
total 74 1896 3.9


line stmt bran cond sub pod time code
1             package CPAN::Testers::WWW::Statistics::Pages;
2              
3 3     3   22514 use warnings;
  3         4  
  3         87  
4 3     3   8 use strict;
  3         4  
  3         71  
5 3     3   8 use vars qw($VERSION);
  3         4  
  3         132  
6              
7             $VERSION = '1.21';
8              
9             #----------------------------------------------------------------------------
10              
11             =head1 NAME
12              
13             CPAN::Testers::WWW::Statistics::Pages - CPAN Testers Statistics pages.
14              
15             =head1 SYNOPSIS
16              
17             my %hash = { config => 'options' };
18             my $obj = CPAN::Testers::WWW::Statistics->new(%hash);
19             my $ct = CPAN::Testers::WWW::Statistics::Pages->new(parent => $obj);
20              
21             $ct->update_full(); # updates statistics data and web pages
22              
23             # alternatively called individual processes
24              
25             $ct->update_data(); # updates statistics data
26             $ct->build_basics(); # updates basic web pages
27             $ct->build_matrices(); # updates matrix style web pages
28             $ct->build_stats(); # updates stats style web pages
29              
30             =head1 DESCRIPTION
31              
32             Using the cpanstats database, this module extracts all the data and generates
33             all the HTML pages needed for the CPAN Testers Statistics website. In addition,
34             also generates the data files in order generate the graphs that appear on the
35             site.
36              
37             Note that this package should not be called directly, but via its parent as:
38              
39             my %hash = { config => 'options' };
40             my $obj = CPAN::Testers::WWW::Statistics->new(%hash);
41              
42             $obj->make_pages(); # updates statistics data and web pages
43              
44             # alternatively called individual processes
45              
46             $obj->update(); # updates statistics data
47             $obj->make_basics(); # updates basic web pages
48             $obj->make_matrix(); # updates matrix style web pages
49             $obj->make_stats(); # updates stats style web pages
50              
51             =cut
52              
53             # -------------------------------------
54             # Library Modules
55              
56 3     3   1364 use Data::Dumper;
  3         14491  
  3         177  
57 3     3   1809 use DateTime;
  3         244197  
  3         90  
58 3     3   22 use File::Basename;
  3         2  
  3         185  
59 3     3   1388 use File::Copy;
  3         4707  
  3         147  
60 3     3   14 use File::Path;
  3         3  
  3         98  
61 3     3   1252 use File::Slurp;
  3         9424  
  3         159  
62 3     3   411 use HTML::Entities;
  3         3445  
  3         134  
63 3     3   386 use IO::File;
  3         5568  
  3         313  
64 3     3   1059 use JSON;
  3         14808  
  3         14  
65 3     3   1417 use Sort::Versions;
  3         1205  
  3         246  
66 3     3   10448 use Template;
  3         39940  
  3         69  
67             #use Time::HiRes qw ( time );
68 3     3   1202 use Time::Piece;
  3         16922  
  3         9  
69              
70             # -------------------------------------
71             # Variables
72              
73             my %month = (
74             0 => 'January', 1 => 'February', 2 => 'March', 3 => 'April',
75             4 => 'May', 5 => 'June', 6 => 'July', 7 => 'August',
76             8 => 'September', 9 => 'October', 10 => 'November', 11 => 'December'
77             );
78              
79             my @months = map { $month{$_} } keys %month;
80             my @days = qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday);
81              
82             my $ADAY = 86400;
83              
84             my %matrix_limits = (
85             all => [ 1000, 5000 ],
86             month => [ 100, 500 ]
87             );
88              
89             # -------------------------------------
90             # Subroutines
91              
92             =head1 INTERFACE
93              
94             =head2 The Constructor
95              
96             =over 4
97              
98             =item * new
99              
100             Page creation object. Allows the user to turn or off the progress tracking.
101              
102             new() takes an option hash as an argument, which may contain 'progress => 1'
103             to turn on the progress tracker.
104              
105             =back
106              
107             =cut
108              
109             sub new {
110 0     0 1   my $class = shift;
111 0           my %hash = @_;
112              
113 0 0         die "Must specify the parent statistics object\n" unless(defined $hash{parent});
114              
115 0           my $self = {parent => $hash{parent}};
116 0           bless $self, $class;
117              
118 0           $self->setdates();
119 0           return $self;
120             }
121              
122             =head2 Public Methods
123              
124             =over 4
125              
126             =item * setdates
127              
128             Prime all key date variable.
129              
130             =item * update_full
131              
132             Full update of data and pages.
133              
134             =item * update_data
135              
136             Update data and store in JSON format.
137              
138             =item * build_basics
139              
140             Create the basic set of pages,those require no statistical calculation.
141              
142             =item * build_matrices
143              
144             Create the matrices pages and distribution list pages.
145              
146             =item * build_stats
147              
148             Create all other statistical pages; monthly tables, interesting stats, etc.
149              
150             =item * build_leaders
151              
152             Create all OS Leaderboards.
153              
154             =item * build_cpan
155              
156             Create/update the CPAN specific statistics data files and pages.
157              
158             =item * build_performance
159              
160             Create/update the builder performance data file.
161              
162             =item * build_noreports
163              
164             Create all OS no report pages.
165              
166             =back
167              
168             =cut
169              
170             sub setdates {
171 0     0 1   my $self = shift;
172 0   0       my $time = shift || time;
173              
174 0           $self->{parent}->_log("init");
175              
176 0           Time::Piece::day_list(@days);
177 0           Time::Piece::mon_list(@months);
178              
179             # timestamp for now
180 0           my $t = localtime($time);
181 0           $self->{dates}{RUNTIME} = $t->strftime("%a, %e %b %Y %T %Z");
182              
183             # todays date
184 0           my @datetime = localtime($time);
185 0           my $THISYEAR = ($datetime[5] + 1900);
186 0           my $THISMONTH = ($datetime[4]);
187 0           $self->{dates}{RUNDATE} = sprintf "%d%s %s %d", $datetime[3], _ext($datetime[3]), $month{$THISMONTH}, $THISYEAR;
188              
189             # THISMONTH is the last date for all data
190 0           $self->{dates}{THISMONTH} = ($THISYEAR) * 100 + $THISMONTH + 1;
191 0           $self->{dates}{THISDATE} = sprintf "%s %d", $month{int($THISMONTH)}, $THISYEAR;
192              
193 0           my $THATMONTH = $THISMONTH - 1;
194 0           my $THATYEAR = $THISYEAR;
195 0 0         if($THATMONTH < 0) {
196 0           $THATMONTH = 11;
197 0           $THATYEAR--;
198             }
199              
200             # LASTMONTH is the Month/Year stats are run for
201 0           $self->{dates}{LASTMONTH} = sprintf "%04d%02d", $THATYEAR, int($THATMONTH+1);
202 0           $self->{dates}{LASTDATE} = sprintf "%s %d", $month{int($THATMONTH)}, $THATYEAR;
203 0           $self->{dates}{PREVMONTH} = sprintf "%02d/%02d", int($THATMONTH+1), $THATYEAR - 2000;
204              
205 0           $THATMONTH--;
206 0 0         if($THATMONTH < 0) {
207 0           $THATMONTH = 11;
208 0           $THATYEAR--;
209             }
210              
211             # THATMONTH is the previous Month/Year for a full matrix
212 0           $self->{dates}{THATMONTH} = sprintf "%04d%02d", $THATYEAR, int($THATMONTH+1);
213            
214 0           $self->{parent}->_log( "THISYEAR=[$THISYEAR]" );
215 0           $self->{parent}->_log( "THATYEAR=[$THATYEAR]" );
216 0           $self->{parent}->_log( "DATES=" . Dumper( $self->{dates} ) );
217              
218             # calculate database metrics
219 0           my @rows = $self->{parent}->{CPANSTATS}->get_query('array',"SELECT fulldate FROM cpanstats ORDER BY id DESC LIMIT 1");
220 0           my @time = $rows[0]->[0] =~ /(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})/;
221 0           $self->{dates}{RUNDATE2} = sprintf "%d%s %s %d", $time[2],_ext($time[2]),$month{$time[1]-1},$time[0];
222 0           $self->{dates}{RUNDATE3} = sprintf "%d%s %s %d, %02d:%02d", $time[2],_ext($time[2]),$month{$time[1]-1},$time[0],$time[3],$time[4];
223             }
224              
225             sub update_full {
226 0     0 1   my $self = shift;
227              
228 0           $self->{parent}->_log("start update_full");
229 0           $self->build_basics();
230 0           $self->build_data();
231 0           $self->build_matrices();
232 0           $self->build_stats();
233 0           $self->build_leaders();
234 0           $self->{parent}->_log("finish update_full");
235             }
236              
237             sub update_data {
238 0     0 1   my $self = shift;
239              
240 0           $self->{parent}->_log("start update_data");
241 0           $self->build_data();
242 0           $self->{parent}->_log("finish update_data");
243             }
244              
245             sub build_basics {
246 0     0 1   my $self = shift;
247              
248 0           $self->{parent}->_log("start build_basics");
249              
250             ## BUILD INFREQUENT PAGES
251 0           $self->_write_basics();
252 0           $self->_missing_in_action();
253              
254 0           $self->{parent}->_log("finish build_basics");
255             }
256              
257             sub build_matrices {
258 0     0 1   my $self = shift;
259              
260 0           $self->{parent}->_log("start build_matrices");
261 0           $self->storage_read();
262 0 0         if($self->{perls}) {
263 0           $self->{parent}->_log("building dist hash from storage");
264              
265 0           my @versions = sort {versioncmp($b,$a)} keys %{$self->{perls}};
  0            
  0            
266 0           $self->{versions} = \@versions;
267              
268 0           $self->_build_osname_matrix();
269 0           $self->_build_platform_matrix();
270             }
271 0           $self->{parent}->_log("finish build_matrices");
272             }
273              
274             sub build_stats {
275 0     0 1   my $self = shift;
276              
277 0           $self->{parent}->_log("stats start");
278              
279 0           $self->{parent}->_log("building dist hash from storage");
280 0           $self->storage_read();
281 0           my $testers = $self->storage_read('testers');
282 0           $self->{parent}->_log("dist hash from storage built");
283              
284 0 0         if($testers) {
285 0           for my $tester (keys %$testers) {
286 0           $self->{counts}{$testers->{$tester}{first}}{first}++;
287 0           $self->{counts}{$testers->{$tester}{last}}{last}++;
288             }
289              
290 0           $testers = {}; # save memory
291 0           $self->{parent}->_log("tester counts built");
292              
293 0           my @versions = sort {versioncmp($b,$a)} keys %{$self->{perls}};
  0            
  0            
294 0           $self->{versions} = \@versions;
295              
296             ## BUILD INDEPENDENT STATS
297 0           $self->_build_sizes();
298 0           $self->_report_cpan();
299              
300             ## BUILD MONTHLY STATS
301 0           $self->_build_monthly_stats();
302              
303             ## BUILD STATS PAGES
304 0           $self->_report_interesting();
305 0           $self->_build_monthly_stats_files();
306 0           $self->_build_failure_rates();
307 0           $self->_build_performance_stats();
308              
309             ## BUILD INDEX PAGE
310 0           $self->_write_index();
311             }
312              
313 0           $self->{parent}->_log("stats finish");
314             }
315              
316             sub build_cpan {
317 0     0 1   my $self = shift;
318              
319 0           $self->{parent}->_log("cpan stats start");
320              
321             ## BUILD INDEPENDENT STATS
322 0           $self->_build_sizes();
323 0           $self->_report_cpan();
324              
325 0           $self->{parent}->_log("cpan stats finish");
326             }
327              
328             sub build_performance {
329 0     0 1   my $self = shift;
330              
331 0           $self->{parent}->_log("performance start");
332 0           $self->{build} = $self->storage_read('build');
333              
334             ## BUILD PERFORMANCE FILES
335 0           $self->_build_performance_stats();
336              
337 0           $self->{parent}->_log("performance finish");
338             }
339              
340             sub build_leaders {
341 0     0 1   my $self = shift;
342              
343 0           $self->{parent}->_log("leaders start");
344              
345             ## BUILD OS LEADERBOARDS
346 0           $self->_build_osname_leaderboards();
347              
348 0           $self->{parent}->_log("leaders finish");
349             }
350              
351             sub build_noreports {
352 0     0 1   my $self = shift;
353              
354 0           $self->{parent}->_log("noreports start");
355              
356 0           $self->_update_noreports();
357 0           $self->_build_noreports();
358              
359 0           $self->{parent}->_log("noreports finish");
360             }
361              
362             =head2 Private Methods
363              
364             =head3 Data Methods
365              
366             =over 4
367              
368             =item * build_data
369              
370             =item * storage_read
371              
372             =item * storage_write
373              
374             =back
375              
376             =cut
377              
378             sub build_data {
379 0     0 1   my $self = shift;
380              
381 0           $self->{parent}->_log("building rate hash");
382              
383 0           my ($d1,$d2) = (time(), time() - $ADAY);
384 0           my @date = localtime($d2);
385 0           my $date = sprintf "%04d%02d%02d", $date[5]+1900, $date[4]+1, $date[3];
386 0           my @tday = localtime($d1);
387 0           my $tday = sprintf "%04d%02d%02d", $tday[5]+1900, $tday[4]+1, $tday[3];
388              
389 0   0       my $lastid = $self->storage_read('lastid') || 0;
390 0           my $testers = {};
391              
392 0 0         if($lastid) {
393 0           $self->{parent}->_log("building dist hash from storage");
394              
395 0           $self->storage_read();
396 0           $testers = $self->storage_read('testers');
397              
398             # only remember the latest release for 'dists' hash
399 0           my $iterator = $self->{parent}->{CPANSTATS}->iterator('hash',"SELECT dist,version FROM ixlatest");
400 0           while(my $row = $iterator->()) {
401 0 0 0       next if($self->{dists}{$row->{dist}} && $self->{dists}{$row->{dist}}->{VER} eq $row->{version});
402 0           $self->{dists}{$row->{dist}} = { ALL => 0, IXL => 0, VER => $row->{version}};
403             }
404              
405             } else {
406 0           $self->{parent}->_log("building dist hash from scratch");
407              
408 0           my $iterator = $self->{parent}->{CPANSTATS}->iterator('hash',"SELECT dist,version FROM ixlatest");
409 0           while(my $row = $iterator->()) {
410 0           $self->{dists}{$row->{dist}}->{ALL} = 0;
411 0           $self->{dists}{$row->{dist}}->{IXL} = 0;
412 0           $self->{dists}{$row->{dist}}->{VER} = $row->{version};
413             }
414              
415 0           $self->{parent}->_log("building stats hash");
416              
417 0   0       $self->{count}{$_} ||= 0 for(qw(posters entries reports distros));
418 0           $self->{xrefs} = { posters => {}, entries => {}, reports => {} },
419             $self->{xlast} = { posters => [], entries => [], reports => [] },
420             }
421              
422             # clear old month entries
423 0           for my $key (qw(platform osys osname)) {
424 0           for my $name (keys %{$self->{$key}}) {
  0            
425 0           for my $perl (keys %{$self->{$key}{$name}}) {
  0            
426 0           for my $month (keys %{$self->{$key}{$name}{$perl}{month}}) {
  0            
427 0 0 0       next if($month =~ /^\d+$/ && $month > $self->{dates}{THATMONTH});
428 0           delete $self->{$key}{$name}{$perl}{month}{$month};
429             }
430             }
431             }
432             }
433              
434             #$self->{parent}->_log("build:1.".Dumper($self->{build}));
435              
436             # reports builder performance stats
437 0           for my $d (keys %{$self->{build}}) {
  0            
438 0           $self->{build}{$d}->{old} = 0;
439             }
440 0           my $file = $self->{parent}->builder();
441 0 0 0       if($file && -f $file) {
442 0 0         if(my $fh = IO::File->new($file,'r')) {
443 0           while(<$fh>) {
444 0           my ($d,$r,$p) = /(\d+),(\d+),(\d+)/;
445 0 0         next unless($d);
446 0           $self->{build}{$d}->{webtotal} = $r;
447 0           $self->{build}{$d}->{webunique} = $p;
448 0           $self->{build}{$d}->{old} = 1;
449             }
450 0           $fh->close;
451             }
452             }
453 0           $self->{build}{$date}->{old} = 1; # keep the tally for yesterday
454 0           $self->{build}{$tday}->{old} = 2; # keep the tally for today, but don't use
455 0           for my $d (keys %{$self->{build}}) {
  0            
456 0 0         delete $self->{build}{$d} unless($self->{build}{$d}->{old});
457             }
458             #$self->{parent}->_log("build:2.".Dumper($self->{build}));
459              
460              
461             # load pass matrices, for all or just the last full month
462 0           $self->{parent}->_log("building pass reports matrices from database");
463 0           my $count = 0;
464 0           my $iterator = $self->{parent}->{CPANSTATS}->iterator('hash','SELECT * FROM passreports');
465 0           while(my $row = $iterator->()) {
466 0           $self->{pass}{$row->{platform}}{$row->{perl}}{all}{$row->{dist}} = 1;
467 0 0         next if($row->{postdate} <= $self->{dates}{THATMONTH});
468 0           $self->{pass}{$row->{platform}}{$row->{perl}}{month}{$row->{postdate}}{$row->{dist}} = 1;
469             }
470              
471              
472             # 0, 1, 2, 3, 4, 5 6, 7, 8, 9, 10 11 12
473             # id, guid, state, postdate, tester, dist, version, platform, perl, osname, osvers, fulldate, type
474              
475 0           $self->{parent}->_log("building dist hash from $lastid");
476 0           $iterator = $self->{parent}->{CPANSTATS}->iterator('hash',"SELECT * FROM cpanstats WHERE type = 2 AND id > $lastid ORDER BY id LIMIT 1000000");
477 0           while(my $row = $iterator->()) {
478 0           $row->{perl} =~ s/\s.*//; # only need to know the main release
479 0           $lastid = $row->{id};
480              
481             {
482 0           my $osname = $self->{parent}->osname($row->{osname});
  0            
483 0           my ($name) = $self->{parent}->tester($row->{tester});
484              
485 0           $self->{stats}{$row->{postdate}}{reports}++;
486 0           $self->{stats}{$row->{postdate}}{state }{$row->{state}}++;
487             #$self->{stats}{$row->{postdate}}{dist }{$row->{dist}}++;
488             #$self->{stats}{$row->{postdate}}{version }{$row->{version}}++;
489              
490             # check distribution tallies
491 0 0         if(defined $self->{dists}{$row->{dist}}) {
492 0           $self->{dists}{$row->{dist}}{ALL}++;
493              
494 0 0         if($self->{dists}{$row->{dist}}->{VER} eq $row->{version}) {
495 0           $self->{dists}{$row->{dist}}{IXL}++;
496              
497             # check failure rates
498 0 0         $self->{fails}{$row->{dist}}{$row->{version}}{fail}++ if($row->{state} eq 'fail');
499 0 0         $self->{fails}{$row->{dist}}{$row->{version}}{pass}++ if($row->{state} eq 'pass');
500 0           $self->{fails}{$row->{dist}}{$row->{version}}{total}++;
501             }
502             }
503              
504             # build matrix stats
505 0           my $perl = $row->{perl};
506 0           $perl =~ s/\s.*//; # only need to know the main release
507 0           $self->{perls}{$perl} = 1;
508              
509             # $self->{pass} {$row->{platform}}{$perl}{all}{$row->{dist}} = 1;
510 0           $self->{platform}{$row->{platform}}{$perl}{all}++;
511 0           $self->{osys} {$osname} {$perl}{all}{$row->{dist}} = 1;
512 0           $self->{osname} {$osname} {$perl}{all}++;
513              
514 0 0         if($row->{postdate} > $self->{dates}{THATMONTH}) {
515             # $self->{pass} {$row->{platform}}{$perl}{month}{$row->{postdate}}{$row->{dist}} = 1;
516 0           $self->{platform}{$row->{platform}}{$perl}{month}{$row->{postdate}}++;
517 0           $self->{osys} {$osname} {$perl}{month}{$row->{postdate}}{$row->{dist}} = 1;
518 0           $self->{osname} {$osname} {$perl}{month}{$row->{postdate}}++;
519             }
520              
521             # record tester activity
522 0   0       $testers->{$name}{first} ||= $row->{postdate};
523 0           $testers->{$name}{last} = $row->{postdate};
524 0           $self->{counts}{$row->{postdate}}{testers}{$name} = 1;
525              
526 0           my $day = substr($row->{fulldate},0,8);
527 0 0         $self->{build}{$day}{reports}++ if(defined $self->{build}{$day});
528             }
529              
530 0           my @row = (0, map {$row->{$_}} qw(id guid state postdate tester dist version platform perl osname osvers fulldate type));
  0            
531              
532 0           $self->{count}{posters} = $row[1];
533 0           $self->{count}{entries}++;
534 0           $self->{count}{reports}++;
535              
536 0           my $type = 'reports';
537 0 0         $self->{parent}->_log("checkpoint: count=$self->{count}{$type}, lastid=$lastid") if($self->{count}{$type} % 10000 == 0);
538              
539 0 0         if($self->{count}->{$type} % 100000 == 0) {
540             # due to the large data structures used, long runs (eg starting from
541             # scratch) should save the current state periodically.
542 0           $self->storage_write();
543 0           $self->storage_write('testers',$testers);
544 0           $self->storage_write('lastid',$lastid);
545             }
546              
547 0 0 0       if($self->{count}{$type} == 1 || ($self->{count}->{$type} % 500000) == 0) {
548 0           $self->{xrefs}{$type}->{$self->{count}->{$type}} = \@row;
549             } else {
550 0           $self->{xlast}{$type} = \@row;
551             }
552             }
553             #$self->{parent}->_log("build:3.".Dumper($self->{build}));
554             #$self->{parent}->_log("build:4.".Dumper($testers));
555              
556 0           $self->storage_write();
557 0           $self->storage_write('testers',$testers);
558 0           $self->storage_write('lastid',$lastid);
559              
560 0           for my $tester (keys %$testers) {
561 0           $self->{counts}{$testers->{$tester}{first}}{first}++;
562 0           $self->{counts}{$testers->{$tester}{last}}{last}++;
563             }
564             #$self->{parent}->_log("build:5.".Dumper($self->{counts}));
565              
566 0           my @versions = sort {versioncmp($b,$a)} keys %{$self->{perls}};
  0            
  0            
567 0           $self->{versions} = \@versions;
568              
569 0           $self->{parent}->_log("stats hash built");
570             }
571              
572             sub storage_read {
573 0     0 1   my ($self,$type) = @_;
574              
575 0 0         if($type) {
576 0           my $storage = sprintf $self->{parent}->mainstore(), $type;
577 0 0         return unless(-f $storage);
578 0           my $data = read_file($storage);
579 0           my $store = decode_json($data);
580 0           return $store->{$type};
581             }
582              
583             # for $type (qw(stats dists fails perls pass platform osys osname build counts count xrefs xlast)) {
584 0           for $type (qw(stats dists fails perls platform osys osname build counts count xrefs xlast)) {
585 0           my $storage = sprintf $self->{parent}->mainstore(), $type;
586 0 0         next unless(-f $storage);
587 0           my $data = read_file($storage);
588 0           my $store = decode_json($data);
589 0           $self->{$type} = $store->{$type};
590             }
591             }
592              
593             sub storage_write {
594 0     0 1   my ($self,$type,$store) = @_;
595              
596 0 0         if($type) {
597 0 0         return unless($store);
598 0           my $data = encode_json({$type => $store});
599              
600 0           my $storage = sprintf $self->{parent}->mainstore(), $type;
601 0           my $dir = dirname($storage);
602 0 0 0       mkpath($dir) if($dir && !-e $dir);
603 0           overwrite_file($storage,$data);
604 0           return;
605             }
606              
607             # for $type (qw(stats dists fails perls pass platform osys osname build counts count xrefs xlast)) {
608 0           for $type (qw(stats dists fails perls platform osys osname build counts count xrefs xlast)) {
609 0 0         next unless($self->{$type});
610 0           my $data = encode_json({$type => $self->{$type}});
611              
612 0           my $storage = sprintf $self->{parent}->mainstore(), $type;
613 0           my $dir = dirname($storage);
614 0 0 0       mkpath($dir) if($dir && !-e $dir);
615 0           overwrite_file($storage,$data);
616             }
617             }
618              
619             =head3 Page Creation Methods
620              
621             =over 4
622              
623             =item * _write_basics
624              
625             Write out basic pages, all of which are simply built from the templates,
626             without any data processing required.
627              
628             =cut
629              
630             sub _write_basics {
631 0     0     my $self = shift;
632 0           my $directory = $self->{parent}->directory;
633 0           my $templates = $self->{parent}->templates;
634 0           my $results = "$directory/stats";
635 0           mkpath($results);
636              
637 0           $self->{parent}->_log("writing basic files");
638              
639 0           my $ranges1 = $self->{parent}->ranges('TEST_RANGES');
640 0           my $ranges2 = $self->{parent}->ranges('CPAN_RANGES');
641              
642             # additional pages not requiring metrics
643 0           my %pages = (
644             cpanmail => {},
645             response => {},
646             perform => {},
647             terms => {},
648             graphs => {},
649             graphs1 => {RANGES => $ranges1, template=>'archive', PREFIX=>'stats1' ,TITLE=>'Monthly Report Counts'},
650             graphs2 => {RANGES => $ranges1, template=>'archive', PREFIX=>'stats2' ,TITLE=>'Testers, Platforms and Perls'},
651             graphs3 => {RANGES => $ranges1, template=>'archive', PREFIX=>'stats3' ,TITLE=>'Monthly Non-Passing Reports Counts'},
652             graphs4 => {RANGES => $ranges1, template=>'archive', PREFIX=>'stats4' ,TITLE=>'Monthly Tester Fluctuations'},
653             graphs5 => {RANGES => $ranges1, template=>'archive', PREFIX=>'pcent1' ,TITLE=>'Monthly Report Percentages'},
654             graphs6 => {RANGES => $ranges2, template=>'archive', PREFIX=>'stats6' ,TITLE=>'All Distribution Uploads per Month'},
655             graphs12 => {RANGES => $ranges2, template=>'archive', PREFIX=>'stats12',TITLE=>'New Distribution Uploads per Month'}
656             );
657              
658 0           $self->{parent}->_log("building support pages");
659 0           $self->_writepage($_,$pages{$_}) for(keys %pages);
660              
661             # copy files
662 0           $self->{parent}->_log("copying static files");
663 0           my $tocopy = $self->{parent}->tocopy;
664 0           $self->{parent}->_log("files to copy = " . scalar(@$tocopy));
665 0           for my $filename (@$tocopy) {
666 0           my $source = $templates . "/$filename";
667 0 0         if(-f $source) {
668 0           my $target = $directory . "/$filename";
669 0 0         next if(-f $target);
670              
671 0           mkpath( dirname($target) );
672 0 0         if(-d dirname($target)) {
673 0           $self->{parent}->_log("copying '$source' to '$target'");
674 0           copy( $source, $target );
675             } else {
676 0           $self->{parent}->_log("copy error: Missing directory: $target");
677 0           warn "Missing directory: $target\n";
678             }
679             } else {
680 0           $self->{parent}->_log("copy error: Missing file: $source");
681 0           warn "Missing file: $source\n";
682             }
683             }
684              
685             #link files
686 0           $self->{parent}->_log("linking static files");
687 0           my $tolink = $self->{parent}->tolink;
688 0           for my $filename (keys %$tolink) {
689 0           my $source = $directory . "/$filename";
690 0           my $target = $directory . '/'.$tolink->{$filename};
691              
692 0 0         next if(-f $target);
693 0 0         if(-f $source) {
694 0           link($target,$source);
695             } else {
696 0           warn "Missing file: $source\n";
697             }
698             }
699              
700             # wget
701 0           my $cmd = sprintf "wget -O %s/sponsors.json http://iheart.cpantesters.org/home/sponsors?images=1 2>/dev/null", $directory;
702 0           $self->{parent}->_log("sponsors: '$cmd'");
703 0           system($cmd);
704             }
705              
706             =item * _write_index
707              
708             Writes out the main index page, after all stats have been calculated.
709              
710             =cut
711              
712             sub _write_index {
713 0     0     my $self = shift;
714 0           my $directory = $self->{parent}->directory;
715 0           my $templates = $self->{parent}->templates;
716              
717 0           $self->{parent}->_log("writing index file");
718              
719             # calculate growth rates
720 0           my ($d1,$d2) = (time(), time() - $ADAY);
721 0           my @date = localtime($d2);
722 0           my $date = sprintf "%04d%02d%02d", $date[5]+1900, $date[4]+1, $date[3];
723              
724 0           my @rows = $self->{parent}->{CPANSTATS}->get_query('array',"SELECT COUNT(*) FROM cpanstats WHERE type = 2 AND fulldate like '$date%'");
725 0 0         $self->{rates}{report} = $rows[0]->[0] ? $ADAY / $rows[0]->[0] * 1000 : $ADAY / 10000 * 1000;
726 0           @rows = $self->{parent}->{CPANSTATS}->get_query('array',"SELECT COUNT(*) FROM uploads WHERE released > $d2 and released < $d1");
727 0 0         $self->{rates}{distro} = $rows[0]->[0] ? $ADAY / $rows[0]->[0] * 1000 : $ADAY / 60 * 1000;
728              
729 0 0         $self->{rates}{report} = 1000 if($self->{rates}{report} < 1000);
730 0 0         $self->{rates}{distro} = 1000 if($self->{rates}{distro} < 1000);
731              
732             # index page
733 0           my %pages = (
734             index => {
735             LASTMONTH => $self->{dates}{LASTMONTH},
736             report_count => $self->{count}{reports},
737             distro_count => $self->{count}{distros},
738             report_rate => $self->{rates}{report},
739             distro_rate => $self->{rates}{distro}
740             },
741             );
742              
743 0           $self->_writepage($_,$pages{$_}) for(keys %pages);
744             }
745              
746             =item * _report_interesting
747              
748             Generates the interesting stats page
749              
750             =cut
751              
752             sub _report_interesting {
753 0     0     my $self = shift;
754 0           my %tvars;
755              
756 0           $self->{parent}->_log("building interesting page");
757              
758 0           $tvars{sizes}{reports} = $self->{sizes}{dir_reports};
759              
760 0           my (@bydist,@byvers);
761 0           my $inx = 20;
762 0 0         for my $dist (sort {$self->{dists}{$b}{ALL} <=> $self->{dists}{$a}{ALL} || $a cmp $b} keys %{$self->{dists}}) {
  0            
  0            
763 0           push @bydist, [$self->{dists}{$dist}{ALL},$dist];
764 0 0         last if(--$inx <= 0);
765             }
766 0           $inx = 20;
767 0 0         for my $dist (sort {$self->{dists}{$b}{IXL} <=> $self->{dists}{$a}{IXL} || $a cmp $b} keys %{$self->{dists}}) {
  0            
  0            
768 0           push @byvers, [$self->{dists}{$dist}{IXL},$dist,$self->{dists}{$dist}{VER}];
769 0 0         last if(--$inx <= 0);
770             }
771              
772 0           $tvars{BYDIST} = \@bydist;
773 0           $tvars{BYVERS} = \@byvers;
774              
775 0           my $type = 'reports';
776 0   0       $self->{count}{$type} ||= 0;
777 0 0         $self->{xrefs}{$type}{$self->{count}{$type}} = $self->{xlast} ? $self->{xlast}{$type} : [];
778              
779 0           for my $key (sort {$b <=> $a} keys %{ $self->{xrefs}{$type} }) {
  0            
  0            
780 0           my @row = @{ $self->{xrefs}{$type}{$key} };
  0            
781              
782 0           $row[0] = $key;
783 0 0         $row[3] = uc $row[3] if($row[3]);
784 0 0 0       ($row[5]) = $self->{parent}->tester($row[5]) if($row[5] && $row[5] =~ /\@/);
785 0           push @{ $tvars{ uc($type) } }, \@row;
  0            
786             }
787              
788 0           my @headings = qw( count grade postdate tester dist version platform perl osname osvers fulldate );
789 0           $tvars{HEADINGS} = \@headings;
790 0           $self->_writepage('interest',\%tvars);
791             }
792              
793             =item * _report_cpan
794              
795             Generates the statistic pages that relate specifically to CPAN.
796              
797             =cut
798              
799             sub _report_cpan {
800 0     0     my $self = shift;
801 0           my (%authors,%distros,%tvars);
802              
803 0           $self->{parent}->_log("building cpan trends page");
804              
805 0           my $directory = $self->{parent}->directory;
806 0           my $results = "$directory/stats";
807 0           mkpath($results);
808              
809 0           my $next = $self->{parent}->{CPANSTATS}->iterator('hash',"SELECT * FROM uploads ORDER BY released");
810 0           while(my $row = $next->()) {
811 0 0         next if($row->{dist} eq 'perl');
812              
813 0           my $date = _parsedate($row->{released});
814 0           $authors{$row->{author}}{count}++;
815 0           $distros{$row->{dist}}{count}++;
816 0           $authors{$row->{author}}{dist}{$row->{dist}}++;
817 0 0         $authors{$row->{author}}{dists}++ if($authors{$row->{author}}{dist}{$row->{dist}} == 1);
818              
819 0           $self->{counts}{$date}{authors}{$row->{author}}++;
820 0           $self->{counts}{$date}{distros}{$row->{dist}}++;
821              
822 0 0         $self->{counts}{$date}{newauthors}++ if($authors{$row->{author}}{count} == 1);
823 0 0         $self->{counts}{$date}{newdistros}++ if($distros{$row->{dist}}{count} == 1);
824              
825 0           $self->{pause}{$date}++;
826             }
827              
828 0 0         my $stat6 = IO::File->new("$results/stats6.txt",'w+') or die "Cannot write to file [$results/stats6.txt]: $!\n";
829 0           print $stat6 "#DATE,AUTHORS,DISTROS\n";
830 0 0         my $stat12 = IO::File->new("$results/stats12.txt",'w+') or die "Cannot write to file [$results/stats12.txt]: $!\n";
831 0           print $stat12 "#DATE,AUTHORS,DISTROS\n";
832              
833 0           for my $date (sort keys %{ $self->{counts} }) {
  0            
834 0           my $authors = scalar(keys %{ $self->{counts}{$date}{authors} });
  0            
835 0           my $distros = scalar(keys %{ $self->{counts}{$date}{distros} });
  0            
836              
837 0   0       $self->{counts}{$date}{newauthors} ||= 0;
838 0   0       $self->{counts}{$date}{newdistros} ||= 0;
839              
840 0           print $stat6 "$date,$authors,$distros\n";
841 0           print $stat12 "$date,$self->{counts}{$date}{newauthors},$self->{counts}{$date}{newdistros}\n";
842              
843             # print $stat6 "$date,$authors\n";
844             # print $stat7 "$date,$distros\n";
845             # print $stat12 "$date,$self->{counts}{$date}{newauthors}\n";
846             # print $stat13 "$date,$self->{counts}{$date}{newdistros}\n";
847             }
848              
849 0           $stat6->close;
850             # $stat7->close;
851 0           $stat12->close;
852             # $stat13->close;
853              
854 0           $tvars{maxyear} = DateTime->now->year;
855 0           $self->_writepage('trends',\%tvars);
856              
857 0           $self->_report_new_distros();
858 0           $self->_report_submissions();
859              
860 0           $self->{parent}->_log("building cpan leader page");
861              
862 0           my $query = 'SELECT x.author,COUNT(x.dist) AS count FROM ixlatest AS x '.
863             'INNER JOIN uploads AS u ON u.dist=x.dist AND u.version=x.version '.
864             "WHERE u.type != 'backpan' GROUP BY x.author";
865 0           my @latest = $self->{parent}->{CPANSTATS}->get_query('hash',$query);
866 0           my (@allcurrent,@alluploads,@allrelease,@alldistros);
867 0           my $inx = 1;
868 0           for my $latest (sort {$b->{count} <=> $a->{count}} @latest) {
  0            
869 0           push @allcurrent, {inx => $inx++, count => $latest->{count}, name => $latest->{author}};
870 0 0         last if($inx > 20);
871             }
872              
873 0           $inx = 1;
874 0 0         for my $author (sort {$authors{$b}{dists} <=> $authors{$a}{dists} || $a cmp $b} keys %authors) {
  0            
875 0           push @alluploads, {inx => $inx++, count => $authors{$author}{dists}, name => $author};
876 0 0         last if($inx > 20);
877             }
878              
879 0           $inx = 1;
880 0 0         for my $author (sort {$authors{$b}{count} <=> $authors{$a}{count} || $a cmp $b} keys %authors) {
  0            
881 0           push @allrelease, {inx => $inx++, count => $authors{$author}{count}, name => $author};
882 0 0         last if($inx > 20);
883             }
884              
885 0           $inx = 1;
886 0 0         for my $distro (sort {$distros{$b}{count} <=> $distros{$a}{count} || $a cmp $b} keys %distros) {
  0            
887 0           push @alldistros, {inx => $inx++, count => $distros{$distro}{count}, name => $distro};
888 0 0         last if($inx > 20);
889             }
890              
891 0           $tvars{allcurrent} = \@allcurrent;
892 0           $tvars{alluploads} = \@alluploads;
893 0           $tvars{allrelease} = \@allrelease;
894 0           $tvars{alldistros} = \@alldistros;
895              
896 0           $self->_writepage('leadercpan',\%tvars);
897              
898              
899 0           $self->{parent}->_log("building cpan interesting stats page (part 1)");
900              
901 0           $tvars{sizes}{cpan} = $self->{sizes}{dir_cpan};
902 0           $tvars{sizes}{backpan} = $self->{sizes}{dir_backpan};
903              
904 0           $tvars{authors}{total} = $self->_count_mailrc();
905 0           my @rows = $self->{parent}->{CPANSTATS}->get_query('array',"SELECT COUNT(distinct author) FROM uploads");
906 0           $tvars{authors}{active} = $rows[0]->[0];
907 0           $tvars{authors}{inactive} = $tvars{authors}{total} - $rows[0]->[0];
908              
909 0           @rows = $self->{parent}->{CPANSTATS}->get_query('array',"SELECT COUNT(distinct dist) FROM uploads WHERE type != 'backpan'");
910 0           $tvars{distros}{uploaded1} = $rows[0]->[0];
911 0           $self->{count}{distros} = $rows[0]->[0];
912 0           @rows = $self->{parent}->{CPANSTATS}->get_query('array',"SELECT COUNT(distinct dist) FROM uploads");
913 0           $tvars{distros}{uploaded2} = $rows[0]->[0];
914 0           $tvars{distros}{uploaded3} = $tvars{distros}{uploaded2} - $tvars{distros}{uploaded1};
915              
916 0           @rows = $self->{parent}->{CPANSTATS}->get_query('array',"SELECT COUNT(*) FROM uploads WHERE type != 'backpan'");
917 0           $tvars{distros}{uploaded4} = $rows[0]->[0];
918 0           @rows = $self->{parent}->{CPANSTATS}->get_query('array',"SELECT COUNT(*) FROM uploads");
919 0           $tvars{distros}{uploaded5} = $rows[0]->[0];
920 0           $tvars{distros}{uploaded6} = $tvars{distros}{uploaded5} - $tvars{distros}{uploaded4};
921              
922              
923 0           $self->{parent}->_log("building cpan interesting stats page (part 2)");
924              
925 0           my (%stats,%dists,%pause,%last);
926 0           $next = $self->{parent}->{CPANSTATS}->iterator('hash','SELECT * FROM uploads ORDER BY released');
927 0           while(my $row = $next->()) {
928 0           $stats{vcounter}++;
929 0 0         if($stats{vcounter} % 10000 == 0) {
930 0           $stats{'uploads'}{$stats{vcounter}}{dist} = $row->{dist};
931 0           $stats{'uploads'}{$stats{vcounter}}{vers} = $row->{version};
932 0           $stats{'uploads'}{$stats{vcounter}}{date} = $row->{released};
933 0           $stats{'uploads'}{$stats{vcounter}}{name} = $row->{author};
934             }
935              
936 0           $last{'uploads'}{counter} = $stats{vcounter};
937 0           $last{'uploads'}{dist} = $row->{dist};
938 0           $last{'uploads'}{vers} = $row->{version};
939 0           $last{'uploads'}{date} = $row->{released};
940 0           $last{'uploads'}{name} = $row->{author};
941              
942 0 0         unless($pause{$row->{author}}) {
943 0           $pause{$row->{author}} = 1;
944 0           $stats{pcounter}++;
945 0 0         if($stats{pcounter} % 1000 == 0) {
946 0           $stats{'uploaders'}{$stats{pcounter}}{dist} = $row->{dist};
947 0           $stats{'uploaders'}{$stats{pcounter}}{vers} = $row->{version};
948 0           $stats{'uploaders'}{$stats{pcounter}}{date} = $row->{released};
949 0           $stats{'uploaders'}{$stats{pcounter}}{name} = $row->{author};
950             }
951              
952 0           $last{'uploaders'}{counter} = $stats{pcounter};
953 0           $last{'uploaders'}{dist} = $row->{dist};
954 0           $last{'uploaders'}{vers} = $row->{version};
955 0           $last{'uploaders'}{date} = $row->{released};
956 0           $last{'uploaders'}{name} = $row->{author};
957             }
958              
959 0 0         next if($dists{$row->{dist}});
960              
961 0           $dists{$row->{dist}} = 1;
962 0           $stats{dcounter}++;
963 0 0         if($stats{dcounter} % 5000 == 0) {
964 0           $stats{'distributions'}{$stats{dcounter}}{dist} = $row->{dist};
965 0           $stats{'distributions'}{$stats{dcounter}}{vers} = $row->{version};
966 0           $stats{'distributions'}{$stats{dcounter}}{date} = $row->{released};
967 0           $stats{'distributions'}{$stats{dcounter}}{name} = $row->{author};
968             }
969              
970 0           $last{'distributions'}{counter} = $stats{dcounter};
971 0           $last{'distributions'}{dist} = $row->{dist};
972 0           $last{'distributions'}{vers} = $row->{version};
973 0           $last{'distributions'}{date} = $row->{released};
974 0           $last{'distributions'}{name} = $row->{author};
975             }
976              
977 0           for my $type (qw(distributions uploads uploaders)) {
978 0           my @list;
979 0           $stats{$type}{$last{$type}{counter}} = $last{$type};
980 0           for my $count (sort {$a <=> $b} keys %{$stats{$type}}) {
  0            
  0            
981 0           my @date = localtime($stats{$type}{$count}{date});
982 0           my $date = sprintf "%04d-%02d-%02d %02d:%02d:%02d", $date[5]+1900, $date[4]+1, $date[3], $date[2], $date[1], $date[0] ;
983 0           $stats{$type}{$count}{counter} = $count;
984 0           $stats{$type}{$count}{date} = $date;
985 0           push @list, $stats{$type}{$count};
986             }
987 0 0         $tvars{$type} = \@list if(@list);
988             }
989              
990 0           $self->_writepage('statscpan',\%tvars);
991              
992              
993 0           $self->{parent}->_log("building cpan/backpan 100s");
994              
995             # calculate CPAN 100 data
996 0           $self->_count_mailrc();
997 0           @rows = $self->{parent}->{CPANSTATS}->get_query('hash',"SELECT t.author,t.count FROM (SELECT author,count(distinct dist) AS count FROM uploads WHERE type!='backpan' GROUP BY author ORDER BY count DESC LIMIT 100) AS t WHERE t.count >= 100");
998 0           my $fh = IO::File->new(">$results/cpan100.csv");
999 0           printf $fh "# DATE: %s\n", DateTime->now->datetime;
1000 0           print $fh "#Pause,Count,Name\n";
1001 0           for my $row (@rows) {
1002 0   0       printf $fh "%s,%d,%s\n", $row->{author}, $row->{count}, $self->{alias}{$row->{author}}||'???';
1003             }
1004 0           $fh->close;
1005              
1006             # calculate BACKCPAN 100 data
1007 0           @rows = $self->{parent}->{CPANSTATS}->get_query('hash',"SELECT t.author,t.count FROM (SELECT author,count(distinct dist) AS count FROM uploads GROUP BY author ORDER BY count DESC LIMIT 100) AS t WHERE t.count >= 100");
1008 0           $fh = IO::File->new(">$results/backpan100.csv");
1009 0           printf $fh "# DATE: %s\n", DateTime->now->datetime;
1010 0           print $fh "#Pause,Count,Name\n";
1011 0           for my $row (@rows) {
1012 0   0       printf $fh "%s,%d,%s\n", $row->{author}, $row->{count}, $self->{alias}{$row->{author}}||'???';
1013             }
1014 0           $fh->close;
1015             }
1016              
1017             sub _report_new_distros {
1018 0     0     my $self = shift;
1019              
1020 0           $self->{parent}->_log("building new distro pages");
1021              
1022 0           my (%seen,%allversions,%newversions);
1023 0           my $start_year = 1995;
1024 0           my $start_month = 8;
1025 0           my $this_year = DateTime->now->year;
1026 0           my $sql = 'select author,dist,version,from_unixtime(released) as reldate from uploads where released >= ? AND released < ? order by released';
1027              
1028 0           for my $year (1995 .. $this_year) {
1029 0           my $tvars = { template => 'newdistros', year => $year };
1030              
1031 0           for my $month (1 .. 12) {
1032 0 0 0       next if($year == $start_year && $month < $start_month);
1033              
1034 0           my $thismon = DateTime->new( year => $year, month => $month, day => 1, hour => 0, minute => 0, second => 0);
1035 0           my $nextmon = DateTime->new( year => $thismon->clone->add( months => 1 )->year, month => $thismon->clone->add( months => 1 )->month, day => 1, hour => 0, minute => 0, second => 0);
1036              
1037 0 0         last if($thismon > DateTime->now);
1038              
1039 0           $tvars->{newdistros}{$month}{month} = $thismon->month_name;
1040 0           $tvars->{newdistros}{$month}{counter} = 0;
1041              
1042 0           my @rows = $self->{parent}->{CPANSTATS}->get_query('hash',$sql,$thismon->epoch(),$nextmon->epoch());
1043 0           for my $row (@rows) {
1044 0           $allversions{$row->{version}}++;
1045              
1046 0 0         next if($seen{$row->{dist}});
1047              
1048 0           $seen{$row->{dist}} = 1;
1049 0           push @{$tvars->{newdistros}{$month}{dists}},
  0            
1050             {
1051             author => $row->{author},
1052             dist => $row->{dist},
1053             version => $row->{version},
1054             reldate => $row->{reldate}
1055             };
1056              
1057 0           $tvars->{newdistros}{$month}{counter}++;
1058 0           $newversions{$row->{version}}++;
1059             }
1060             }
1061              
1062 0           $self->_writepage("newdistros/$year",$tvars);
1063             }
1064              
1065 0           $self->{parent}->_log("building new distro versions page");
1066              
1067 0           my (@allversions,@newversions);
1068 0 0         for my $v (sort {$allversions{$b} <=> $allversions{$a} || $a cmp $b} keys %allversions) {
  0            
1069 0           push @allversions, { version => $v, count => $allversions{$v} };
1070             }
1071 0           my $tvars = { template => 'versions', type => 'All', versions => \@allversions };
1072 0           $self->_writepage("newdistros/allversions",$tvars);
1073              
1074 0 0         for my $v (sort {$newversions{$b} <=> $newversions{$a} || $a cmp $b} keys %newversions) {
  0            
1075 0           push @newversions, { version => $v, count => $newversions{$v} };
1076             }
1077 0           $tvars = { template => 'versions', type => 'New', versions => \@newversions };
1078 0           $self->_writepage("newdistros/newversions",$tvars);
1079             }
1080              
1081             sub _report_submissions {
1082 0     0     my $self = shift;
1083              
1084 0           $self->{parent}->_log("building submission data files");
1085              
1086 0           my $sql = 'select from_unixtime(released) as reldate from uploads';
1087              
1088 0           my $now = DateTime->now;
1089 0           my (%hours,%days,%months,%dotw,%tvars);
1090              
1091 0           my $next = $self->{parent}->{CPANSTATS}->iterator('hash',$sql);
1092 0           while( my $row = $next->() ) {
1093 0 0 0       next unless($row->{reldate} && $row->{reldate} =~ /^(\d+)\-(\d+)\-(\d+).(\d+):(\d+):(\d+)/);
1094 0           my ($year,$month,$day,$hour,$minute,$second) = ($1,$2,$3,$4,$5,$6);
1095              
1096 0           my $date = DateTime->new( year => $year, month => $month, day => $day, hour => $hour, minute => $minute, second => $second );
1097 0           my $dotw = $date->day_of_week;
1098              
1099 0           $months{that}{$month}++;
1100 0           $dotw{that}{$dotw}++;
1101 0           $days{that}{$day}++;
1102 0           $hours{that}{$hour}++;
1103              
1104 0 0         if($year != $now->year) {
    0          
1105 0           $months{this}{$month}++;
1106 0           $dotw{this}{$dotw}++;
1107             } elsif($date->week_number != $now->week_number) {
1108 0           $dotw{this}{$dotw}++;
1109             }
1110              
1111 0 0 0       if(( $year != $now->year) ||
      0        
1112             ( $year == $now->year && $month != $now->month) ) {
1113 0           $days{this}{$day}++;
1114             }
1115              
1116 0 0 0       if(( $year != $now->year) ||
      0        
      0        
      0        
      0        
1117             ( $year == $now->year && $month != $now->month) ||
1118             ( $year == $now->year && $month == $now->month && $day != $now->day) ) {
1119 0           $hours{this}{$hour}++;
1120             }
1121             }
1122              
1123 0           my $directory = $self->{parent}->directory;
1124 0           my $results = "$directory/rates";
1125 0           mkpath($results);
1126              
1127 0           $self->{parent}->_log("writing $results/submit1.txt");
1128 0           my $fh = IO::File->new(">$results/submit1.txt");
1129 0           print $fh "#INDEX,EXCLUSIVE,INCLUSIVE\n";
1130 0           for my $month (sort {$a <=> $b} keys %{$months{this}}) {
  0            
  0            
1131 0           printf $fh "%d,%d,%d\n", $month, $months{this}{$month}, $months{that}{$month};
1132             }
1133 0           $fh->close;
1134              
1135 0           $self->{parent}->_log("writing $results/submit2.txt");
1136 0           $fh = IO::File->new(">$results/submit2.txt");
1137 0           print $fh "#INDEX,EXCLUSIVE,INCLUSIVE\n";
1138 0           for my $dotw (sort {$a <=> $b} keys %{$dotw{this}}) {
  0            
  0            
1139 0           printf $fh "%d,%d,%d\n", $dotw, $dotw{this}{$dotw}, $dotw{that}{$dotw};
1140             }
1141 0           $fh->close;
1142              
1143 0           $self->{parent}->_log("writing $results/submit3.txt");
1144 0           $fh = IO::File->new(">$results/submit3.txt");
1145 0           print $fh "#INDEX,EXCLUSIVE,INCLUSIVE\n";
1146 0           for my $day (sort {$a <=> $b} keys %{$days{this}}) {
  0            
  0            
1147 0           printf $fh "%d,%d,%d\n", $day, $days{this}{$day}, $days{that}{$day};
1148             }
1149 0           $fh->close;
1150              
1151 0           $self->{parent}->_log("writing $results/submit4.txt");
1152 0           $fh = IO::File->new(">$results/submit4.txt");
1153 0           print $fh "#INDEX,EXCLUSIVE,INCLUSIVE\n";
1154 0           for my $hour (sort {$a <=> $b} keys %{$hours{this}}) {
  0            
  0            
1155 0           printf $fh "%d,%d,%d\n", $hour, $hours{this}{$hour}, $hours{that}{$hour};
1156             }
1157 0           $fh->close;
1158              
1159 0           $self->_writepage('rates',\%tvars);
1160             }
1161              
1162             sub _update_noreports {
1163 0     0     my $self = shift;
1164              
1165 0           $self->{parent}->_log("start update_noreports");
1166              
1167 0           my %phrasebook = (
1168             'DISTS' => q{ SELECT * FROM ixlatest WHERE oncpan=1 ORDER BY released DESC},
1169             'LIST' => q{ SELECT osname,count(*) AS count
1170             FROM cpanstats
1171             WHERE dist=? AND version=?
1172             GROUP BY osname},
1173             'DELETE' => q{DELETE FROM noreports WHERE dist=?},
1174             'INSERT' => q{INSERT INTO noreports (dist,version,osname) VALUES (?,?,?)}
1175             );
1176              
1177 0           my %dists;
1178 0           my $osnames = $self->{parent}->osnames();
1179 0           my $noreports = $self->{parent}->noreports();
1180 0           my $grace = time - 2419200;
1181              
1182 0           my @rows = $self->{parent}->{CPANSTATS}->get_query('hash',$phrasebook{DISTS});
1183 0           for my $row (@rows) {
1184 0 0 0       next if($noreports && $row->{dist} =~ /^$noreports$/);
1185 0 0         next if($dists{$row->{dist}}); # ignore older versions (by other authors)
1186 0 0         next if($row->{released} >= $grace); # ignore recently released distributions
1187 0           for my $osname (keys %$osnames) {
1188 0           $dists{$row->{dist}}{$row->{version}}{$osname} = 1;
1189             }
1190             }
1191              
1192 0           for my $dist (keys %dists) {
1193 0           for my $version (keys %{$dists{$dist}}) {
  0            
1194 0           @rows = $self->{parent}->{CPANSTATS}->get_query('hash',$phrasebook{LIST},$dist,$version);
1195 0           for my $row (@rows) {
1196 0           delete $dists{$dist}{$version}{$row->{osname}};
1197             }
1198              
1199 0           $self->{parent}->{CPANSTATS}->do_query($phrasebook{DELETE},$dist);
1200 0           $self->{parent}->{CPANSTATS}->do_query($phrasebook{INSERT},$dist,$version,$_)
1201 0           for(keys %{$dists{$dist}{$version}});
1202             }
1203             }
1204              
1205 0           $self->{parent}->_log("finish update_noreports");
1206             }
1207              
1208             sub _build_noreports {
1209 0     0     my $self = shift;
1210 0           my $grace = time - 2419200;
1211            
1212 0           my $noreports = $self->{parent}->noreports();
1213 0           my $osnames = $self->{parent}->osnames();
1214              
1215 0           my $query =
1216             'SELECT x.*,count(s.id) as count FROM ixlatest AS x '.
1217             'LEFT JOIN release_summary AS s ON (x.dist=s.dist AND x.version=s.version) '.
1218             'GROUP BY x.dist,x.version ORDER BY x.released DESC';
1219 0           my $next = $self->{parent}->{CPANSTATS}->iterator('hash',$query);
1220              
1221 0           my (@rows,%dists);
1222 0           while(my $row = $next->()) {
1223 0 0 0       next if($noreports && $row->{dist} =~ /^$noreports$/);
1224 0 0         next if($dists{$row->{dist}});
1225 0           $dists{$row->{dist}} = $row->{released};
1226              
1227 0 0         next if($row->{count} > 0);
1228 0 0 0       next if(!$row->{oncpan} || $row->{oncpan} != 1);
1229 0 0         next if($row->{released} > $grace);
1230              
1231 0           my @dt = localtime($row->{released});
1232 0           $row->{datetime} = sprintf "%04d-%02d-%02d", $dt[5]+1900,$dt[4]+1,$dt[3];
1233 0           push @rows, $row;
1234             }
1235              
1236 0           my @osnames = map { { osname => $_, ostitle => $osnames->{$_} } } sort {$osnames->{$a} cmp $osnames->{$b}} keys %$osnames;
  0            
  0            
1237 0           my $tvars = { rows => \@rows, rowcount => scalar(@rows), template => 'noreports', osnames => \@osnames, ostitle => 'ALL' };
1238 0           $self->_writepage('noreports/all',$tvars);
1239              
1240             # html files
1241 0           $query = q[select i.* from noreports r inner join ixlatest i on i.dist=r.dist and i.version=r.version where r.osname=? and i.oncpan=1 order by i.dist];
1242 0           for my $os (@osnames) {
1243 0           my @dists = $self->{parent}->{CPANSTATS}->get_query('hash',$query,$os->{osname});
1244 0           for(@dists) {
1245 0           my @dt = localtime($_->{released});
1246 0           $_->{datetime} = sprintf "%04d-%02d-%02d", $dt[5]+1900,$dt[4]+1,$dt[3];
1247             }
1248 0           $tvars = { rows => \@dists, rowcount => scalar(@dists), template => 'noreports', osnames => \@osnames, ostitle => $os->{ostitle}, osname => $os->{osname} };
1249 0           $self->_writepage('noreports/'.$os->{osname},$tvars);
1250             }
1251              
1252             # data files
1253 0           $query = q[select u.* from noreports r inner join uploads u on u.dist=r.dist and u.version=r.version where r.osname=? and u.type='cpan' order by u.dist];
1254 0           for my $os (@osnames) {
1255 0           my @dists = $self->{parent}->{CPANSTATS}->get_query('hash',$query,$os->{osname});
1256 0           for(@dists) {
1257 0           my @dt = localtime($_->{released});
1258 0           $_->{datetime} = sprintf "%04d-%02d-%02d", $dt[5]+1900,$dt[4]+1,$dt[3];
1259             }
1260 0           $tvars = { rows => \@dists, rowcount => scalar(@dists), template => 'noreports', extension => 'csv', osnames => \@osnames, ostitle => $os->{ostitle} };
1261 0           $self->_writepage('noreports/'.$os->{osname},$tvars);
1262             }
1263             }
1264              
1265             sub _missing_in_action {
1266 0     0     my $self = shift;
1267 0           my (%tvars,%missing,@missing);
1268              
1269 0           $self->{parent}->_log("building missing in action page");
1270              
1271 0           my $missing = $self->{parent}->missing();
1272 0 0         return unless(-f $missing);
1273 0 0         my $fh = IO::File->new($missing) or return;
1274 0           while(<$fh>) {
1275 0           chomp;
1276 0           my ($pauseid,$timestamp,$reason) = /^([a-z]+)[ \t]+([^+]+\+0[01]00) (.*)/i;
1277 0 0         next unless($pauseid);
1278 0           $reason =~ s/
1279 0           $reason =~ s/>/>/g;
1280 0           $missing{$pauseid}{timestamp} = $timestamp;
1281 0           $missing{$pauseid}{reason} = $reason;
1282             }
1283 0           $fh->close;
1284              
1285 0           for my $pauseid (sort keys %missing) {
1286 0           push @missing, { pauseid => $pauseid, timestamp => $missing{$pauseid}{timestamp}, reason => $missing{$pauseid}{reason} };
1287             }
1288              
1289 0 0         $tvars{missing} = \@missing if(@missing);
1290 0           $self->_writepage('missing',\%tvars);
1291             }
1292              
1293             sub _build_osname_matrix {
1294 0     0     my $self = shift;
1295              
1296 0           my %tvars = (template => 'osmatrix', FULL => 1, MONTH => 0);
1297 0           $self->{parent}->_log("building OS matrix - 1");
1298 0           my $CONTENT = $self->_osname_matrix($self->{versions},'all',1);
1299 0           $tvars{CONTENT} = $CONTENT;
1300 0           $self->_writepage('osmatrix-full',\%tvars);
1301              
1302 0           %tvars = (template => 'osmatrix', FULL => 1, MONTH => 0, layout => 'layout-wide');
1303 0           $tvars{CONTENT} = $CONTENT;
1304 0           $self->{parent}->_log("building OS matrix - 2");
1305 0           $self->_writepage('osmatrix-full-wide',\%tvars);
1306              
1307 0           %tvars = (template => 'osmatrix', FULL => 1, MONTH => 1);
1308 0           $self->{parent}->_log("building OS matrix - 3");
1309 0           $CONTENT = $self->_osname_matrix($self->{versions},'month',1);
1310 0           $tvars{CONTENT} = $CONTENT;
1311 0           $self->_writepage('osmatrix-full-month',\%tvars);
1312              
1313 0           %tvars = (template => 'osmatrix', FULL => 1, MONTH => 1, layout => 'layout-wide');
1314 0           $tvars{CONTENT} = $CONTENT;
1315 0           $self->{parent}->_log("building OS matrix - 4");
1316 0           $self->_writepage('osmatrix-full-month-wide',\%tvars);
1317              
1318 0           my @vers = grep {!/^5\.(11|9|7)\./} @{$self->{versions}};
  0            
  0            
1319              
1320 0           %tvars = (template => 'osmatrix', FULL => 0, MONTH => 0);
1321 0           $self->{parent}->_log("building OS matrix - 5");
1322 0           $CONTENT = $self->_osname_matrix(\@vers,'all',0);
1323 0           $tvars{CONTENT} = $CONTENT;
1324 0           $self->_writepage('osmatrix',\%tvars);
1325              
1326 0           %tvars = (template => 'osmatrix', FULL => 0, MONTH => 0, layout => 'layout-wide');
1327 0           $tvars{CONTENT} = $CONTENT;
1328 0           $self->{parent}->_log("building OS matrix - 6");
1329 0           $self->_writepage('osmatrix-wide',\%tvars);
1330              
1331 0           %tvars = (template => 'osmatrix', FULL => 0, MONTH => 1);
1332 0           $self->{parent}->_log("building OS matrix - 7");
1333 0           $CONTENT = $self->_osname_matrix(\@vers,'month',0);
1334 0           $tvars{CONTENT} = $CONTENT;
1335 0           $self->_writepage('osmatrix-month',\%tvars);
1336              
1337 0           %tvars = (template => 'osmatrix', FULL => 0, MONTH => 1, layout => 'layout-wide');
1338 0           $tvars{CONTENT} = $CONTENT;
1339 0           $self->{parent}->_log("building OS matrix - 8");
1340 0           $self->_writepage('osmatrix-month-wide',\%tvars);
1341             }
1342              
1343             sub _osname_matrix {
1344 0     0     my $self = shift;
1345 0 0         my $vers = shift or return '';
1346 0           my $type = shift;
1347 0   0       my $full = shift || 0;
1348 0 0         return '' unless(@$vers);
1349              
1350 0           my %totals;
1351 0           for my $osname (sort keys %{$self->{osys}}) {
  0            
1352 0 0         if($type eq 'month') {
1353 0           my $check = 0;
1354 0 0         for my $perl (@$vers) { $check++ if(defined $self->{osys}{$osname}{$perl}{month}{$self->{dates}{LASTMONTH}}) }
  0            
1355 0 0         next if($check == 0);
1356             }
1357 0           for my $perl (@$vers) {
1358 0           my $count = defined $self->{osys}{$osname}{$perl}{$type}
1359             ? ($type eq 'month'
1360 0           ? scalar(keys %{$self->{osys}{$osname}{$perl}{month}{$self->{dates}{LASTMONTH}}})
1361 0 0         : scalar(keys %{$self->{osys}{$osname}{$perl}{$type}}))
    0          
1362             : 0;
1363 0   0       $count ||= 0;
1364 0           $totals{os}{$osname} += $count;
1365 0           $totals{perl}{$perl} += $count;
1366             }
1367             }
1368              
1369 0           my $index = 0;
1370 0 0         my $content =
1371             "\n"
1372             . '' ' '; '; '; '; '; ' '
1373             . "\n"
1374             . '
OS/Perl'
1375             . join( "", @$vers )
1376             . 'OS/Perl
1377             . "\n"
1378             . '
Totals'
1379 0           . join( '', map {$totals{perl}{$_}||0} @$vers )
1380             . 'Totals
1381              
1382 0 0         for my $osname (sort {$totals{os}{$b} <=> $totals{os}{$a} || $a cmp $b} keys %{$totals{os}}) {
  0            
  0            
1383 0 0         if($type eq 'month') {
1384 0           my $check = 0;
1385 0 0         for my $perl (@$vers) { $check++ if(defined $self->{osys}{$osname}{$perl}{month}{$self->{dates}{LASTMONTH}}) }
  0            
1386 0 0         next if($check == 0);
1387             }
1388 0           $content .= "\n" . '
' . $osname . '' . $totals{os}{$osname} . '
1389 0           for my $perl (@$vers) {
1390 0           my $count = defined $self->{osys}{$osname}{$perl}{$type}
1391             ? ($type eq 'month'
1392 0           ? scalar(keys %{$self->{osys}{$osname}{$perl}{month}{$self->{dates}{LASTMONTH}}})
1393 0 0         : scalar(keys %{$self->{osys}{$osname}{$perl}{$type}}))
    0          
1394             : 0;
1395 0   0       $count ||= 0;
1396 0 0         if($count) {
1397 0 0         if($self->{list}{osname}{$osname}{$perl}{$type}) {
1398 0           $index = $self->{list}{osname}{$osname}{$perl}{$type};
1399             } else {
1400 0 0         my %tvars = (template => 'distlist', OS => 1, MONTH => ($type eq 'month' ? 1 : 0), FULL => $full);
1401 0           my @list = sort keys %{$self->{osys}{$osname}{$perl}{$type}};
  0            
1402 0           $tvars{dists} = \@list;
1403 0           $tvars{vplatform} = $osname;
1404 0           $tvars{vperl} = $perl;
1405 0           $tvars{count} = $count;
1406              
1407 0           $index = join('-','osys', $type, $osname, $perl);
1408 0           $index =~ s/[^-.\w]/-/g;
1409 0           $index = 'matrix/' . $index;
1410 0           $self->{list}{osname}{$osname}{$perl}{$type} = $index;
1411 0           $self->_writepage($index,\%tvars);
1412             }
1413             }
1414              
1415 0 0         my $number = ($type eq 'month' ? $self->{osname}{$osname}{$perl}{month}{$self->{dates}{LASTMONTH}} : $self->{osname}{$osname}{$perl}{$type});
1416 0   0       $number ||= 0;
1417 0           my $class = 'none';
1418 0 0         $class = 'some' if($number > 0);
1419 0 0         $class = 'more' if($number > $matrix_limits{$type}->[0]);
1420 0 0         $class = 'lots' if($number > $matrix_limits{$type}->[1]);
1421              
1422             # count = number of distributions with a pass
1423             # number = number of reports submitted for that platform/perl
1424 0 0         $content .= qq{}
1425             . ($count ? qq|$count
$number| : '-')
1426             . '
1427             }
1428 0           $content .= '' . $totals{os}{$osname} . '' . $osname . '
1429 0           $content .= '
1430             }
1431              
1432             $content .=
1433 0 0         "\n"
1434             . '
Totals'
1435 0           . join( '', map {$totals{perl}{$_}||0} @$vers )
1436             . 'Totals
1437             . "\n"
1438             . '
OS/Perl'
1439             . join( "", @$vers )
1440             . 'OS/Perl
1441             . "\n" .
1442             '
';
1443              
1444 0           return $content;
1445             }
1446              
1447             sub _build_platform_matrix {
1448 0     0     my $self = shift;
1449              
1450 0           my %tvars = (template => 'pmatrix', FULL => 1, MONTH => 0);
1451 0           $self->{parent}->_log("building platform matrix - 1");
1452 0           my $CONTENT = $self->_platform_matrix($self->{versions},'all',1);
1453 0           $tvars{CONTENT} = $CONTENT;
1454 0           $self->_writepage('pmatrix-full',\%tvars);
1455              
1456 0           %tvars = (template => 'pmatrix', FULL => 1, MONTH => 0, layout => 'layout-wide');
1457 0           $tvars{CONTENT} = $CONTENT;
1458 0           $self->{parent}->_log("building platform matrix - 2");
1459 0           $self->_writepage('pmatrix-full-wide',\%tvars);
1460              
1461 0           %tvars = (template => 'pmatrix', FULL => 1, MONTH => 1);
1462 0           $self->{parent}->_log("building platform matrix - 3");
1463 0           $CONTENT = $self->_platform_matrix($self->{versions},'month',1);
1464 0           $tvars{CONTENT} = $CONTENT;
1465 0           $self->_writepage('pmatrix-full-month',\%tvars);
1466              
1467 0           %tvars = (template => 'pmatrix', FULL => 1, MONTH => 1, layout => 'layout-wide');
1468 0           $tvars{CONTENT} = $CONTENT;
1469 0           $self->{parent}->_log("building platform matrix - 4");
1470 0           $self->_writepage('pmatrix-full-month-wide',\%tvars);
1471              
1472 0           my @vers = grep {!/^5\.(11|9|7)\./} @{$self->{versions}};
  0            
  0            
1473              
1474 0           %tvars = (template => 'pmatrix', FULL => 0, MONTH => 0);
1475 0           $self->{parent}->_log("building platform matrix - 5");
1476 0           $CONTENT = $self->_platform_matrix(\@vers,'all',0);
1477 0           $tvars{CONTENT} = $CONTENT;
1478 0           $self->_writepage('pmatrix',\%tvars);
1479              
1480 0           %tvars = (template => 'pmatrix', FULL => 0, MONTH => 0, layout => 'layout-wide');
1481 0           $tvars{CONTENT} = $CONTENT;
1482 0           $self->{parent}->_log("building platform matrix - 6");
1483 0           $self->_writepage('pmatrix-wide',\%tvars);
1484              
1485 0           %tvars = (template => 'pmatrix', FULL => 0, MONTH => 1);
1486 0           $self->{parent}->_log("building platform matrix - 7");
1487 0           $CONTENT = $self->_platform_matrix(\@vers,'month',0);
1488 0           $tvars{CONTENT} = $CONTENT;
1489 0           $self->_writepage('pmatrix-month',\%tvars);
1490              
1491 0           %tvars = (template => 'pmatrix', FULL => 0, MONTH => 1, layout => 'layout-wide');
1492 0           $tvars{CONTENT} = $CONTENT;
1493 0           $self->{parent}->_log("building platform matrix - 8");
1494 0           $self->_writepage('pmatrix-month-wide',\%tvars);
1495             }
1496              
1497             sub _platform_matrix {
1498 0     0     my $self = shift;
1499 0 0         my $vers = shift or return '';
1500 0           my $type = shift;
1501 0   0       my $full = shift || 0;
1502 0 0         return '' unless(@$vers);
1503              
1504 0           my %totals;
1505 0           for my $platform (sort keys %{$self->{pass}}) {
  0            
1506 0 0         if($type eq 'month') {
1507 0           my $check = 0;
1508 0 0         for my $perl (@$vers) { $check++ if(defined $self->{pass}{$platform}{$perl}{month}{$self->{dates}{LASTMONTH}}) }
  0            
1509 0 0         next if($check == 0);
1510             }
1511 0           for my $perl (@$vers) {
1512 0           my $count = defined $self->{pass}{$platform}{$perl}{$type}
1513             ? ($type eq 'month'
1514 0           ? scalar(keys %{$self->{pass}{$platform}{$perl}{month}{$self->{dates}{LASTMONTH}}})
1515 0 0         : scalar(keys %{$self->{pass}{$platform}{$perl}{$type}}))
    0          
1516             : 0;
1517 0   0       $count ||= 0;
1518 0           $totals{platform}{$platform} += $count;
1519 0           $totals{perl}{$perl} += $count;
1520             }
1521             }
1522              
1523 0           my $index = 0;
1524 0 0         my $content =
1525             "\n"
1526             . '' ' '; '; '; '; '; ' '
1527             . "\n"
1528             . '
Platform/Perl'
1529             . join( "", @$vers )
1530             . 'Platform/Perl
1531             . "\n"
1532             . '
Totals'
1533 0           . join( '', map {$totals{perl}{$_}||0} @$vers )
1534             . 'Totals
1535              
1536 0 0         for my $platform (sort {$totals{platform}{$b} <=> $totals{platform}{$a} || $a cmp $b} keys %{$totals{platform}}) {
  0            
  0            
1537 0 0         if($type eq 'month') {
1538 0           my $check = 0;
1539 0 0         for my $perl (@$vers) { $check++ if(defined $self->{pass}{$platform}{$perl}{month}{$self->{dates}{LASTMONTH}}) }
  0            
1540 0 0         next if($check == 0);
1541             }
1542 0           $content .= "\n" . '
' . $platform . '' . $totals{platform}{$platform} . '
1543 0           for my $perl (@$vers) {
1544 0           my $count = defined $self->{pass}{$platform}{$perl}{$type}
1545             ? ($type eq 'month'
1546 0           ? scalar(keys %{$self->{pass}{$platform}{$perl}{month}{$self->{dates}{LASTMONTH}}})
1547 0 0         : scalar(keys %{$self->{pass}{$platform}{$perl}{$type}}))
    0          
1548             : 0;
1549 0   0       $count ||= 0;
1550 0 0         if($count) {
1551 0 0         if($self->{list}{platform}{$platform}{$perl}{$type}) {
1552 0           $index = $self->{list}{platform}{$platform}{$perl}{$type};
1553             } else {
1554 0 0         my %tvars = (template => 'distlist', OS => 0, MONTH => ($type eq 'month' ? 1 : 0), FULL => $full);
1555 0           my @list = sort keys %{$self->{pass}{$platform}{$perl}{$type}};
  0            
1556 0           $tvars{dists} = \@list;
1557 0           $tvars{vplatform} = $platform;
1558 0           $tvars{vperl} = $perl;
1559 0           $tvars{count} = $count;
1560              
1561 0           $index = join('-','platform', $type, $platform, $perl);
1562 0           $index =~ s/[^-.\w]/-/g;
1563 0           $index = 'matrix/' . $index;
1564 0           $self->{list}{platform}{$platform}{$perl}{$type} = $index;
1565 0           $self->_writepage($index,\%tvars);
1566             }
1567             }
1568              
1569 0 0         my $number = ($type eq 'month' ? $self->{platform}{$platform}{$perl}{month}{$self->{dates}{LASTMONTH}} : $self->{platform}{$platform}{$perl}{$type});
1570 0   0       $number ||= 0;
1571 0           my $class = 'none';
1572 0 0         $class = 'some' if($number > 0);
1573 0 0         $class = 'more' if($number > $matrix_limits{$type}->[0]);
1574 0 0         $class = 'lots' if($number > $matrix_limits{$type}->[1]);
1575              
1576             # count = number of distributions with a pass
1577             # number = number of reports submitted for that platform/perl
1578 0 0         $content .= qq{}
1579             . ($count ? qq|$count
$number| : '-')
1580             . '
1581             }
1582 0           $content .= '' . $totals{platform}{$platform} . '' . $platform . '
1583 0           $content .= '
1584             }
1585             $content .=
1586 0 0         "\n"
1587             . '
Totals'
1588 0           . join( '', map {$totals{perl}{$_}||0} @$vers )
1589             . 'Totals
1590             . "\n"
1591             . '
Platform/Perl'
1592             . join( "", @$vers )
1593             . 'Platform/Perl
1594             . "\n"
1595             . '
';
1596              
1597 0           return $content;
1598             }
1599              
1600             # Notes:
1601             #
1602             # * use a JSON store (e.g. cpanstats-platform.json)
1603             # * find the last month stored
1604             # * rebuild from last month to current month
1605             # * store JSON data
1606              
1607             sub _build_monthly_stats {
1608 0     0     my $self = shift;
1609 0           my (%tvars,%stats,%testers,%monthly);
1610 0           my %templates = (
1611             platform => 'mplatforms',
1612             osname => 'mosname',
1613             perl => 'mperls',
1614             tester => 'mtesters'
1615             );
1616              
1617 0           $self->{parent}->_log("building monthly tables");
1618              
1619 0           my $query = q!SELECT postdate,%s,count(id) AS count FROM cpanstats ! .
1620             q!WHERE type = 2 %s ! .
1621             q!GROUP BY postdate,%s ORDER BY postdate,count DESC,%s!;
1622              
1623 0           for my $type (qw(platform osname perl)) {
1624 0           $self->{parent}->_log("building monthly $type table");
1625 0           (%tvars,%stats,%monthly) = ();
1626 0           my $postdate = '';
1627              
1628 0           my $json = $self->storage_read($type);
1629 0 0         if($json) {
1630 0           my $last = 0;
1631 0           for my $date (keys %{ $json->{monthly} }) {
  0            
1632 0 0         $last = $date if($date > $last);
1633             }
1634              
1635 0           delete $json->{$_}{$last} for(qw(monthly stats));
1636              
1637 0           %monthly = %{ $json->{monthly} };
  0            
1638 0           %stats = %{ $json->{stats} };
  0            
1639              
1640 0 0         $postdate = "AND postdate >= '$last'" if($last);
1641             }
1642              
1643 0           my $sql = sprintf $query, $type, $postdate, $type, $type;
1644 0           my $next = $self->{parent}->{CPANSTATS}->iterator('hash',$sql);
1645 0           while(my $row = $next->()) {
1646 0           $monthly{$row->{postdate}}{$type}{$row->{$type}} = 1;
1647 0 0         $row->{$type} = $self->{parent}->osname($row->{$type}) if($type eq 'osname');
1648 0           push @{$stats{$row->{postdate}}{list}}, "[$row->{count}] $row->{$type}";
  0            
1649             }
1650              
1651 0           for my $date (sort {$b <=> $a} keys %stats) {
  0            
1652 0           $stats{$date}{count} = scalar(@{$stats{$date}{list}});
  0            
1653 0           push @{$tvars{STATS}}, [$date,$stats{$date}{count},join(', ',@{$stats{$date}{list}})];
  0            
  0            
1654             }
1655 0           $self->_writepage($templates{$type},\%tvars);
1656              
1657             # remember monthly counts for monthly files later
1658 0           for my $date (keys %monthly) {
1659 0           $self->{monthly}{$date}{$type} = keys %{ $monthly{$date}{$type} };
  0            
1660             }
1661              
1662             # store data
1663 0           my $hash = { monthly => \%monthly, stats => \%stats };
1664 0           $self->storage_write($type,$hash);
1665             }
1666              
1667             {
1668 0           my $type = 'tester';
  0            
1669 0           $self->{parent}->_log("building monthly $type table");
1670 0           (%tvars,%stats,%monthly) = ();
1671 0           my $postdate = '';
1672              
1673 0           my $json = $self->storage_read($type);
1674 0 0         if($json) {
1675 0           my $last = 0;
1676 0           for my $date (keys %{ $json->{monthly} }) {
  0            
1677 0 0         $last = $date if($date > $last);
1678             }
1679              
1680 0           delete $json->{$_}{$last} for(qw(monthly stats));
1681              
1682 0           %monthly = %{ $json->{monthly} };
  0            
1683 0           %stats = %{ $json->{stats} };
  0            
1684              
1685 0 0         $postdate = "AND postdate >= '$last'" if($last);
1686             }
1687              
1688 0           my $sql = sprintf $query, $type, $postdate, $type, $type;
1689 0           my $next = $self->{parent}->{CPANSTATS}->iterator('hash',$sql);
1690 0           while(my $row = $next->()) {
1691 0           my ($name) = $self->{parent}->tester($row->{tester});
1692 0           $testers{$name} += $row->{count};
1693 0           $stats{$row->{postdate}}{list}{$name} += $row->{count};
1694 0           $monthly{$row->{postdate}}{$type}{$name} = 1;
1695             }
1696              
1697 0           for my $date (sort {$b <=> $a} keys %stats) {
  0            
1698 0           $stats{$date}{count} = keys %{$stats{$date}{list}};
  0            
1699 0           push @{$tvars{STATS}}, [$date,$stats{$date}{count},
  0            
1700             join(', ',
1701 0 0         map {"[$stats{$date}{list}{$_}] $_"}
1702 0           sort {$stats{$date}{list}{$b} <=> $stats{$date}{list}{$a} || $a cmp $b}
1703 0           keys %{$stats{$date}{list}})];
1704             }
1705 0           $self->_writepage($templates{$type},\%tvars);
1706              
1707             # remember monthly counts for monthly files later
1708 0           for my $date (keys %monthly) {
1709 0           $self->{monthly}{$date}{$type} = keys %{ $monthly{$date}{$type} };
  0            
1710             }
1711              
1712             # store data
1713 0           my $hash = { monthly => \%monthly, stats => \%stats };
1714 0           $self->storage_write($type,$hash);
1715             }
1716             }
1717              
1718             sub _build_osname_leaderboards {
1719 0     0     my $self = shift;
1720              
1721 0           $self->{parent}->_log("building osname leaderboards");
1722              
1723             # set dates
1724 0           my $post0 = '999999';
1725 0           my $post1 = $self->{dates}{THATMONTH};
1726 0           my $post2 = $self->{dates}{LASTMONTH};
1727 0           my $post3 = $self->{dates}{THISMONTH};
1728              
1729 0           my @dates = ($post0, $post1, $post2, $post3);
1730 0           my %dates = map {$_ => 1} @dates;
  0            
1731              
1732 0           $self->{parent}->_log("1.post0=$post0");
1733 0           $self->{parent}->_log("2.post1=$post1");
1734 0           $self->{parent}->_log("3.post2=$post2");
1735 0           $self->{parent}->_log("4.post3=$post3");
1736              
1737             # load data
1738 0           my $data = $self->{parent}->leaderboard( results => \@dates );
1739 0           $self->{parent}->tester( 'test' );
1740              
1741 0           my @posts = sort keys %$data;
1742 0           $self->{parent}->_log("5.posts[0]=$posts[0]");
1743              
1744             # store data for the last 3 months, and in total
1745 0           my %oses;
1746 0           for my $post (keys %$data) {
1747 0 0         if($dates{$post}) {
1748 0           for my $os (keys %{$data->{$post}}) {
  0            
1749 0 0         next unless($os);
1750 0           $oses{$os} = 1;
1751 0           for my $tester (keys %{$data->{$post}{$os}}) {
  0            
1752 0   0       $data->{$post0}{$os}{$tester} ||= 0; # make sure we include all testers
1753             }
1754             }
1755             } else {
1756 0           for my $os (keys %{$data->{$post}}) {
  0            
1757 0 0         next unless($os);
1758 0           $oses{$os} = 1;
1759 0           for my $tester (keys %{$data->{$post}{$os}}) {
  0            
1760 0           $data->{$post0}{$os}{$tester} += $data->{$post}{$os}{$tester};
1761             }
1762             }
1763 0           delete $data->{$post};
1764             }
1765             }
1766              
1767             #$self->{parent}->_log("6.data=".Dumper($data));
1768              
1769             # reorganise data
1770 0           my %hash;
1771 0           for my $os (keys %oses) {
1772 0           for my $tester (keys %{$data->{$post0}{$os}}) {
  0            
1773 0   0       $hash{$os}{$tester}{this} = $data->{$post3}{$os}{$tester} || 0;
1774 0   0       $hash{$os}{$tester}{that} = $data->{$post2}{$os}{$tester} || 0;
1775 0   0       $hash{$os}{$tester}{all} = ($data->{$post3}{$os}{$tester} || 0) + ($data->{$post2}{$os}{$tester} || 0) +
      0        
      0        
      0        
1776             ($data->{$post1}{$os}{$tester} || 0) + ($data->{$post0}{$os}{$tester} || 0);
1777             }
1778             }
1779              
1780 0           $self->{parent}->_log("1.reorg");
1781              
1782 0           my %titles = (
1783             this => 'This Month',
1784             that => 'Last Month',
1785             all => 'All Months'
1786             );
1787              
1788 0           my $sql = 'SELECT * FROM osname ORDER BY ostitle';
1789 0           my @rows = $self->{parent}->{CPANSTATS}->get_query('hash',$sql);
1790 0           my @oses = grep {$_->{osname}} @rows;
  0            
1791              
1792 0           for my $osname (keys %oses) {
1793 0 0         next unless($osname);
1794 0           for my $type (qw(this that all)) {
1795 0           my @leaders;
1796 0 0 0       for my $tester (sort {($hash{$osname}{$b}{$type} || 0) <=> ($hash{$osname}{$a}{$type} || 0) || $a cmp $b} keys %{$hash{$osname}}) {
  0   0        
  0            
1797 0           push @leaders,
1798             { col2 => $hash{$osname}{$tester}{this},
1799             col1 => $hash{$osname}{$tester}{that},
1800             col3 => $hash{$osname}{$tester}{all},
1801             tester => $tester
1802             } ;
1803             }
1804              
1805 0           my $os = lc $osname;
1806              
1807 0           my %tvars;
1808 0           $tvars{osnames} = \@oses;
1809 0           $tvars{template} = 'leaderos';
1810 0           $tvars{osname} = $self->{parent}->osname($osname);
1811 0           $tvars{leaders} = \@leaders;
1812 0           $tvars{headers} = { col1 => $post2, col2 => $post3, title => "$tvars{osname} Leaderboard ($titles{$type})" };
1813 0 0         $tvars{links}{this} = $type eq 'this' ? '' : "leaders-$os-this.html";
1814 0 0         $tvars{links}{that} = $type eq 'that' ? '' : "leaders-$os-that.html";
1815 0 0         $tvars{links}{all} = $type eq 'all' ? '' : "leaders-$os-all.html";
1816 0           $self->{parent}->_log("1.leaders/leaders-$os-$type");
1817              
1818 0           $self->_writepage("leaders/leaders-$os-$type",\%tvars);
1819             }
1820             }
1821              
1822 0           $self->{parent}->_log("building leader board");
1823 0           my (%tvars,%stats,%testers) = ();
1824              
1825 0           $tvars{osnames} = \@oses;
1826 0           for my $post ($post0, $post1, $post2, $post3) {
1827 0           for my $os (keys %{$data->{$post}}) {
  0            
1828 0 0         next unless($os);
1829 0           for my $tester (keys %{$data->{$post}{$os}}) {
  0            
1830 0           $testers{$tester} += $data->{$post}{$os}{$tester};
1831             }
1832             }
1833             }
1834              
1835 0           my $count = 1;
1836 0 0         for my $tester (sort {$testers{$b} <=> $testers{$a} || $a cmp $b} keys %testers) {
  0            
1837 0           push @{$tvars{STATS}}, [$count++, $testers{$tester}, $tester];
  0            
1838             }
1839              
1840 0           $count--;
1841              
1842 0           $self->{parent}->tester_loader();
1843              
1844 0           $self->{parent}->_log("Unknown Addresses: ".($count-$self->{parent}->known_t));
1845 0           $self->{parent}->_log("Known Addresses: ".($self->{parent}->known_s));
1846 0           $self->{parent}->_log("Listed Addresses: ".($self->{parent}->known_s + $count - $self->{parent}->known_t));
1847 0           $self->{parent}->_log("Unknown Testers: ".($count-$self->{parent}->known_t));
1848 0           $self->{parent}->_log("Known Testers: ".($self->{parent}->known_t));
1849 0           $self->{parent}->_log("Listed Testers: ".($count));
1850              
1851 0           push @{$tvars{COUNTS}},
  0            
1852             ($count-$self->{parent}->known_t),
1853             $self->{parent}->known_s,
1854             ($self->{parent}->known_s + $count - $self->{parent}->known_t),
1855             ($count - $self->{parent}->known_t),
1856             $self->{parent}->known_t,
1857             $count;
1858              
1859 0           $self->_writepage('testers',\%tvars);
1860             }
1861              
1862             sub _build_monthly_stats_files {
1863 0     0     my $self = shift;
1864 0           my %tvars;
1865              
1866 0           my $directory = $self->{parent}->directory;
1867 0           my $results = "$directory/stats";
1868 0           mkpath($results);
1869              
1870 0           $self->{parent}->_log("building monthly stats for graphs - 1,3,pcent1");
1871              
1872             #print "DATE,UPLOADS,REPORTS,NA,PASS,FAIL,UNKNOWN\n";
1873 0           my $fh1 = IO::File->new(">$results/stats1.txt");
1874 0           print $fh1 "#DATE,UPLOADS,REPORTS,PASS,FAIL\n";
1875              
1876 0           my $fh2 = IO::File->new(">$results/pcent1.txt");
1877 0           print $fh2 "#DATE,FAIL,OTHER,PASS\n";
1878              
1879 0           my $fh3 = IO::File->new(">$results/stats3.txt");
1880 0           print $fh3 "#DATE,FAIL,NA,UNKNOWN\n";
1881              
1882 0           for my $date (sort keys %{$self->{stats}}) {
  0            
1883 0 0         next if($date > $self->{dates}{THISMONTH});
1884              
1885 0   0       my $uploads = ($self->{pause}{$date} || 0);
1886 0   0       my $reports = ($self->{stats}{$date}{reports} || 0);
1887 0   0       my $passes = ($self->{stats}{$date}{state}{pass} || 0);
1888 0   0       my $fails = ($self->{stats}{$date}{state}{fail} || 0);
1889 0           my $others = $reports - $passes - $fails;
1890              
1891 0           my @fields = (
1892             $date, $uploads, $reports, $passes, $fails
1893             );
1894              
1895 0 0         my @pcent = (
    0          
    0          
1896             $date,
1897             ($reports > 0 ? int($fails / $reports * 100) : 0),
1898             ($reports > 0 ? int($others / $reports * 100) : 0),
1899             ($reports > 0 ? int($passes / $reports * 100) : 0)
1900             );
1901              
1902 0           unshift @{$tvars{STATS}},
  0            
1903             [ @fields,
1904             $self->{stats}{$date}{state}{na},
1905             $self->{stats}{$date}{state}{unknown}];
1906              
1907             # graphs don't include current month
1908 0 0         next if($date > $self->{dates}{THISMONTH}-1);
1909              
1910 0           my $content = sprintf "%d,%d,%d,%d,%d\n", @fields;
1911 0           print $fh1 $content;
1912              
1913 0           $content = sprintf "%d,%d,%d,%d\n", @pcent;
1914 0           print $fh2 $content;
1915              
1916 0   0       $content = sprintf "%d,%d,%d,%d\n",
      0        
      0        
1917             $date,
1918             ($self->{stats}{$date}{state}{fail} || 0),
1919             ($self->{stats}{$date}{state}{na} || 0),
1920             ($self->{stats}{$date}{state}{unknown} || 0);
1921 0           print $fh3 $content;
1922             }
1923 0           $fh1->close;
1924 0           $fh2->close;
1925 0           $fh3->close;
1926              
1927 0           $self->_writepage('mreports',\%tvars);
1928              
1929 0           $self->{parent}->_log("building monthly stats for graphs - 2");
1930              
1931             #print "DATE,TESTERS,PLATFORMS,PERLS\n";
1932 0           $fh2 = IO::File->new(">$results/stats2.txt");
1933 0           print $fh2 "#DATE,TESTERS,PLATFORMS,PERLS\n";
1934              
1935 0           for my $date (sort keys %{$self->{stats}}) {
  0            
1936 0 0         next if($date > $self->{dates}{THISMONTH}-1);
1937 0   0       printf $fh2 "%d,%d,%d,%d\n",
      0        
      0        
1938             $date,
1939             ($self->{monthly}{$date}{tester} || 0),
1940             ($self->{monthly}{$date}{platform} || 0),
1941             ($self->{monthly}{$date}{perl} || 0);
1942             }
1943 0           $fh2->close;
1944              
1945 0           $self->{parent}->_log("building monthly stats for graphs - 4");
1946              
1947             #print "DATE,ALL,FIRST,LAST\n";
1948 0           $fh1 = IO::File->new(">$results/stats4.txt");
1949 0           print $fh1 "#DATE,ALL,FIRST,LAST\n";
1950              
1951 0           for my $date (sort keys %{ $self->{stats} }) {
  0            
1952 0 0         next if($date > $self->{dates}{THISMONTH}-1);
1953              
1954 0 0         if(defined $self->{counts}{$date}) {
1955 0           $self->{counts}{$date}{all} = scalar(keys %{$self->{counts}{$date}{testers}});
  0            
1956             }
1957 0   0       $self->{counts}{$date}{all} ||= 0;
1958 0   0       $self->{counts}{$date}{first} ||= 0;
1959 0   0       $self->{counts}{$date}{last} ||= 0;
1960 0 0         $self->{counts}{$date}{last} = '' if($date > $self->{dates}{LASTMONTH});
1961              
1962 0           printf $fh1 "%d,%s,%s,%s\n",
1963             $date,
1964             $self->{counts}{$date}{all},
1965             $self->{counts}{$date}{first},
1966             $self->{counts}{$date}{last};
1967             }
1968 0           $fh1->close;
1969             }
1970              
1971             sub _build_failure_rates {
1972 0     0     my $self = shift;
1973 0           my (%tvars,%dists);
1974              
1975 0           $self->{parent}->_log("building failure rates");
1976              
1977 0           my $query =
1978             'SELECT x.dist,x.version,u.released FROM ixlatest AS x '.
1979             'INNER JOIN uploads AS u ON u.dist=x.dist AND u.version=x.version '.
1980             "WHERE u.type != 'backpan'";
1981 0           my $next = $self->{parent}->{CPANSTATS}->iterator('hash',$query);
1982 0           while(my $row = $next->()) {
1983 0           $dists{$row->{dist}}{$row->{version}} = $row->{released};
1984             }
1985              
1986 0           $self->{parent}->_log("selecting failure rates");
1987              
1988             # select worst failure rates - latest version, and ignoring backpan only.
1989 0           my %worst;
1990 0           for my $dist (keys %{ $self->{fails} }) {
  0            
1991 0 0         next unless($dists{$dist});
1992 0           my ($version) = sort {$dists{$dist}{$b} <=> $dists{$dist}{$a}} keys %{$dists{$dist}};
  0            
  0            
1993              
1994 0           $worst{"$dist-$version"} = $self->{fails}->{$dist}{$version};
1995 0           $worst{"$dist-$version"}->{dist} = $dist;
1996 0 0         $worst{"$dist-$version"}->{pcent} = $self->{fails}{$dist}{$version}{fail}
1997             ? int(($self->{fails}{$dist}{$version}{fail}/$self->{fails}{$dist}{$version}{total})*10000)/100
1998             : 0.00;
1999 0   0       $worst{"$dist-$version"}->{pass} ||= 0;
2000 0   0       $worst{"$dist-$version"}->{fail} ||= 0;
2001              
2002 0           my @post = localtime($dists{$dist}{$version});
2003 0           $worst{"$dist-$version"}->{post} = sprintf "%04d%02d", $post[5]+1900, $post[4]+1;
2004             }
2005              
2006 0           $self->{parent}->_log("worst = " . scalar(keys %worst) . " entries");
2007 0           $self->{parent}->_log("building failure counts");
2008              
2009             # calculate worst failure rates - by failure count
2010 0           my $count = 1;
2011 0 0         for my $dist (sort {$worst{$b}->{fail} <=> $worst{$a}->{fail} || $worst{$b}->{pcent} <=> $worst{$a}->{pcent}} keys %worst) {
  0            
2012 0 0         last unless($worst{$dist}->{fail});
2013 0           my $pcent = sprintf "%3.2f%%", $worst{$dist}->{pcent};
2014 0           push @{$tvars{WORST}}, [$count++, $worst{$dist}->{fail}, $dist, $worst{$dist}->{post}, $worst{$dist}->{pass}, $worst{$dist}->{total}, $pcent, $worst{$dist}->{dist}];
  0            
2015 0 0         last if($count > 100);
2016             }
2017              
2018 0           $self->_writepage('wdists',\%tvars);
2019 0           undef %tvars;
2020              
2021 0           $self->{parent}->_log("building failure pecentages");
2022              
2023             # calculate worst failure rates - by percentage
2024 0           $count = 1;
2025 0 0         for my $dist (sort {$worst{$b}->{pcent} <=> $worst{$a}->{pcent} || $worst{$b}->{fail} <=> $worst{$a}->{fail}} keys %worst) {
  0            
2026 0 0         last unless($worst{$dist}->{fail});
2027 0           my $pcent = sprintf "%3.2f%%", $worst{$dist}->{pcent};
2028 0           push @{$tvars{WORST}}, [$count++, $worst{$dist}->{fail}, $dist, $worst{$dist}->{post}, $worst{$dist}->{pass}, $worst{$dist}->{total}, $pcent, $worst{$dist}->{dist}];
  0            
2029 0 0         last if($count > 100);
2030             }
2031              
2032 0           $self->_writepage('wpcent',\%tvars);
2033 0           undef %tvars;
2034              
2035 0           $self->{parent}->_log("done building failure rates");
2036              
2037             # now we do as above but for the last 6 months
2038              
2039 0           my @recent = localtime(time() - 15778463); # 6 months ago
2040 0           my $recent = sprintf "%04d%02d", $recent[5]+1900, $recent[4]+1;
2041              
2042 0           for my $dist (keys %worst) {
2043 0 0         next if($worst{$dist}->{post} ge $recent);
2044 0           delete $worst{$dist};
2045             }
2046              
2047             # calculate worst failure rates - by failure count
2048 0           $count = 1;
2049 0 0         for my $dist (sort {$worst{$b}->{fail} <=> $worst{$a}->{fail} || $worst{$b}->{pcent} <=> $worst{$a}->{pcent}} keys %worst) {
  0            
2050 0 0         last unless($worst{$dist}->{fail});
2051 0           my $pcent = sprintf "%3.2f%%", $worst{$dist}->{pcent};
2052 0           push @{$tvars{WORST}}, [$count++, $worst{$dist}->{fail}, $dist, $worst{$dist}->{post}, $worst{$dist}->{pass}, $worst{$dist}->{total}, $pcent, $worst{$dist}->{dist}];
  0            
2053 0 0         last if($count > 100);
2054             }
2055              
2056 0           $self->_writepage('wdists-recent',\%tvars);
2057 0           undef %tvars;
2058              
2059 0           $self->{parent}->_log("building failure pecentages");
2060              
2061             # calculate worst failure rates - by percentage
2062 0           $count = 1;
2063 0 0         for my $dist (sort {$worst{$b}->{pcent} <=> $worst{$a}->{pcent} || $worst{$b}->{fail} <=> $worst{$a}->{fail}} keys %worst) {
  0            
2064 0 0         last unless($worst{$dist}->{fail});
2065 0           my $pcent = sprintf "%3.2f%%", $worst{$dist}->{pcent};
2066 0           push @{$tvars{WORST}}, [$count++, $worst{$dist}->{fail}, $dist, $worst{$dist}->{post}, $worst{$dist}->{pass}, $worst{$dist}->{total}, $pcent, $worst{$dist}->{dist}];
  0            
2067 0 0         last if($count > 100);
2068             }
2069              
2070 0           $self->_writepage('wpcent-recent',\%tvars);
2071             }
2072              
2073             sub _build_performance_stats {
2074 0     0     my $self = shift;
2075              
2076 0           my $directory = $self->{parent}->directory;
2077 0           my $results = "$directory/stats";
2078 0           mkpath($results);
2079              
2080 0           $self->{parent}->_log("building peformance stats for graphs");
2081              
2082 0           my $fh = IO::File->new(">$results/build1.txt");
2083 0           print $fh "#DATE,REQUESTS,PAGES,REPORTS\n";
2084              
2085 0           for my $date (sort {$a <=> $b} keys %{$self->{build}}) {
  0            
  0            
2086             #$self->{parent}->_log("build_stats: date=$date, old=$self->{build}{$date}->{old}");
2087 0 0         next if($self->{build}{$date}->{old} == 2); # ignore todays tally
2088             #next if($date > $self->{dates}{THISMONTH}-1);
2089              
2090 0   0       printf $fh "%d,%d,%d,%d\n",
      0        
      0        
2091             $date,
2092             ($self->{build}{$date}{webtotal} || 0),
2093             ($self->{build}{$date}{webunique} || 0),
2094             ($self->{build}{$date}{reports} || 0);
2095             }
2096 0           $fh->close;
2097             }
2098              
2099             sub _build_sizes {
2100 0     0     my $self = shift;
2101 0           my $du = 'du -h --max-depth=0';
2102              
2103 0           for my $dir (qw( dir_cpan dir_backpan dir_reports )) {
2104 0           my $path = $self->{parent}->$dir();
2105 0           my $res =`$du $path`;
2106 0   0       $res ||= '';
2107 0 0         $res =~ s/\s.*$//s if($res);
2108 0           $self->{sizes}{$dir} = $res;
2109 0           $self->{parent}->_log(".. size for $dir ($path) = $res");
2110             }
2111             }
2112              
2113             =item * _writepage
2114              
2115             Creates a single HTML page.
2116              
2117             =cut
2118              
2119             sub _writepage {
2120 0     0     my ($self,$page,$vars) = @_;
2121 0           my $directory = $self->{parent}->directory;
2122 0           my $templates = $self->{parent}->templates;
2123              
2124             #$self->{parent}->_log("_writepage: page=$page");
2125              
2126 0   0       my $extension = $vars->{extension} || 'html';
2127 0   0       my $template = $vars->{template} || $page;
2128 0   0       my $tlayout = $vars->{layout} || 'layout';
2129 0           my $layout = "$tlayout.$extension";
2130 0           my $source = "$template.$extension";
2131 0           my $target = "$directory/$page.$extension";
2132              
2133             #$self->{parent}->_log("_writepage: layout=$layout, source=$source, target=$target");
2134              
2135 0           mkdir(dirname($target));
2136              
2137 0           $vars->{SOURCE} = $source;
2138 0           $vars->{VERSION} = $VERSION;
2139 0           $vars->{copyright} = $self->{parent}->copyright;
2140 0           $vars->{$_} = $self->{dates}{$_} for(keys %{ $self->{dates} });
  0            
2141              
2142             #if($page =~ /(statscpan|interest)/) {
2143             # $self->{parent}->_log("$page:" . Dumper($vars));
2144             #}
2145              
2146 0           my %config = ( # provide config info
2147             RELATIVE => 1,
2148             ABSOLUTE => 1,
2149             INCLUDE_PATH => $templates,
2150             INTERPOLATE => 0,
2151             POST_CHOMP => 1,
2152             TRIM => 1,
2153             );
2154              
2155 0           my $parser = Template->new(\%config); # initialise parser
2156 0 0         $parser->process($layout,$vars,$target) # parse the template
2157             or die $parser->error() . "\n";
2158             }
2159              
2160             # Provides the ordinal for dates.
2161              
2162             sub _ext {
2163 0     0     my $num = shift;
2164 0 0 0       return 'st' if($num == 1 || $num == 21 || $num == 31);
      0        
2165 0 0 0       return 'nd' if($num == 2 || $num == 22);
2166 0 0 0       return 'rd' if($num == 3 || $num == 23);
2167 0           return 'th';
2168             }
2169              
2170             sub _parsedate {
2171 0     0     my $time = shift;
2172 0           my @time = localtime($time);
2173 0           return sprintf "%04d%02d", $time[5]+1900,$time[4]+1;
2174             }
2175              
2176             sub _count_mailrc {
2177 0     0     my $self = shift;
2178 0           my $count = 0;
2179 0           my $mailrc = $self->{parent}->mailrc();
2180              
2181 0 0         my $fh = IO::File->new($mailrc,'r') or die "Cannot read file [$mailrc]: $!\n";
2182 0           while(<$fh>) {
2183 0 0         next unless(/^alias\s*(\w+)\s+"([\s\w]+)\s+<[^>]+>"/);
2184 0           $self->{alias}{$1} = $2;
2185 0           $count++;
2186             }
2187 0           $fh->close;
2188              
2189 0           return $count;
2190             }
2191              
2192             q("Will code for Guinness!");
2193              
2194             __END__