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