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