line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package CPAN::Testers::WWW::Statistics::Leaderboard; |
2
|
|
|
|
|
|
|
|
3
|
2
|
|
|
2
|
|
3708
|
use warnings; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
55
|
|
4
|
2
|
|
|
2
|
|
6
|
use strict; |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
44
|
|
5
|
2
|
|
|
2
|
|
9
|
use vars qw($VERSION); |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
1178
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
$VERSION = '1.21'; |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
#---------------------------------------------------------------------------- |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
=head1 NAME |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
CPAN::Testers::WWW::Statistics::Leaderboard - CPAN Testers Statistics leaderboard. |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
=head1 SYNOPSIS |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
my %hash = { config => 'options' }; |
18
|
|
|
|
|
|
|
my $obj = CPAN::Testers::WWW::Statistics->new(%hash); |
19
|
|
|
|
|
|
|
my $lb = CPAN::Testers::WWW::Statistics::Leaderboard->new(parent => $obj); |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
$ct->process( renew => 1 ); # renew all counts |
22
|
|
|
|
|
|
|
$ct->process( update => 1 ); # update counts for the last 3 months |
23
|
|
|
|
|
|
|
$ct->process( postdate => '201206' ); # update counts for specified month |
24
|
|
|
|
|
|
|
$ct->process( check => 1 ); # check for discrepancies |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
=head1 DESCRIPTION |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
Using the cpanstats database, this module provides the data in the |
29
|
|
|
|
|
|
|
'leaderboard' table within the 'cpanstats' database. The data itself is then |
30
|
|
|
|
|
|
|
used by the Pages module to create the leaderboard pages. |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
Previously this information was held in a JSON file, but maintaining accurate |
33
|
|
|
|
|
|
|
data has been problematic. |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
Note that this package should not be called directly, but via its parent as: |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
my %hash = { config => 'options' }; |
38
|
|
|
|
|
|
|
my $obj = CPAN::Testers::WWW::Statistics->new(%hash); |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
$obj->leaderboard( %options ); # above for the list of options |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
=cut |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
# ------------------------------------- |
45
|
|
|
|
|
|
|
# Public Methods |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
=head1 INTERFACE |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
=head2 The Constructor |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
=over 4 |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
=item * new |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
Page creation object. Allows the user to turn or off the progress tracking. |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
new() takes an option hash as an argument, which may contain 'progress => 1' |
58
|
|
|
|
|
|
|
to turn on the progress tracker. |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
=back |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
=cut |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
sub new { |
65
|
0
|
|
|
0
|
1
|
|
my $class = shift; |
66
|
0
|
|
|
|
|
|
my %hash = @_; |
67
|
|
|
|
|
|
|
|
68
|
0
|
0
|
|
|
|
|
die "Must specify the parent statistics object\n" unless(defined $hash{parent}); |
69
|
|
|
|
|
|
|
|
70
|
0
|
|
|
|
|
|
my $self = {parent => $hash{parent}}; |
71
|
0
|
|
|
|
|
|
bless $self, $class; |
72
|
|
|
|
|
|
|
|
73
|
0
|
|
|
|
|
|
return $self; |
74
|
|
|
|
|
|
|
} |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
=head2 Public Methods |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
=over 4 |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
=item * renew |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
Renew all OS counts for all month entries. |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
=item * update |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
Update all OS counts for the last 3 months. |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
=item * postdate |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
Update all OS counts for the specified month. |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
=item * check |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
Verify monthy counts with source table to ensure all OS counts have been |
95
|
|
|
|
|
|
|
appropriately applied. |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
=item * results |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
Provides the data as a hash for the required months, with the OS and tester |
100
|
|
|
|
|
|
|
names as subsidary keys. |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
Note that month '999999' is a special case, and is an accumulation of all other |
103
|
|
|
|
|
|
|
months, from those requested. Thus if only '999999' is requested the top level |
104
|
|
|
|
|
|
|
hash return will only consist of one date, and will be a sum of all months. |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
=back |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
=cut |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
sub renew { |
111
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
112
|
|
|
|
|
|
|
|
113
|
0
|
|
|
|
|
|
$self->{parent}->_log("START renew"); |
114
|
0
|
|
|
|
|
|
$self->_update( 'SELECT distinct(postdate) as postdate FROM cpanstats' ); |
115
|
0
|
|
|
|
|
|
$self->{parent}->_log("STOP renew"); |
116
|
|
|
|
|
|
|
} |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
sub postdate { |
119
|
0
|
|
|
0
|
1
|
|
my ($self,$date) = @_; |
120
|
|
|
|
|
|
|
|
121
|
0
|
|
|
|
|
|
$self->{parent}->_log("START postdate = $date"); |
122
|
0
|
|
|
|
|
|
$self->_update( "SELECT '$date' as postdate" ); |
123
|
0
|
|
|
|
|
|
$self->{parent}->_log("STOP postdate"); |
124
|
|
|
|
|
|
|
} |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
sub update { |
127
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
128
|
|
|
|
|
|
|
|
129
|
0
|
|
|
|
|
|
$self->{parent}->_log("START update"); |
130
|
0
|
|
|
|
|
|
$self->_update( 'SELECT distinct(postdate) as postdate FROM cpanstats ORDER BY postdate DESC LIMIT 3' ); |
131
|
0
|
|
|
|
|
|
$self->{parent}->_log("STOP update"); |
132
|
|
|
|
|
|
|
} |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
sub check { |
135
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
136
|
|
|
|
|
|
|
|
137
|
0
|
|
|
|
|
|
my $sql1 = |
138
|
|
|
|
|
|
|
'SELECT postdate,COUNT(id) AS qty FROM cpanstats '. |
139
|
|
|
|
|
|
|
'WHERE type=2 '. |
140
|
|
|
|
|
|
|
'GROUP BY postdate'; |
141
|
0
|
|
|
|
|
|
my $sql2 = |
142
|
|
|
|
|
|
|
'SELECT postdate,SUM(score) AS qty FROM leaderboard '. |
143
|
|
|
|
|
|
|
'GROUP BY postdate '. |
144
|
|
|
|
|
|
|
'ORDER BY postdate'; |
145
|
|
|
|
|
|
|
|
146
|
0
|
|
|
|
|
|
my %hash; |
147
|
0
|
|
|
|
|
|
my @rows = $self->{parent}->{CPANSTATS}->get_query('hash',$sql1); |
148
|
0
|
|
|
|
|
|
for my $row (@rows) { |
149
|
0
|
|
|
|
|
|
$hash{ $row->{postdate} } = $row->{qty}; |
150
|
|
|
|
|
|
|
} |
151
|
|
|
|
|
|
|
|
152
|
0
|
|
|
|
|
|
my %data; |
153
|
0
|
|
|
|
|
|
@rows = $self->{parent}->{CPANSTATS}->get_query('hash',$sql2); |
154
|
0
|
|
|
|
|
|
for my $row (@rows) { |
155
|
0
|
0
|
|
|
|
|
next if($hash{ $row->{postdate} } == $row->{qty}); |
156
|
0
|
|
|
|
|
|
my $str = sprintf "%s, %d, %d", $row->{postdate}, $hash{ $row->{postdate} }, $row->{qty}; |
157
|
0
|
|
|
|
|
|
$self->{parent}->_log($str); |
158
|
|
|
|
|
|
|
|
159
|
0
|
|
|
|
|
|
$data{$row->{postdate}}{cpanstats} = $hash{ $row->{postdate} }; |
160
|
0
|
|
|
|
|
|
$data{$row->{postdate}}{leaderboard} = $row->{qty}; |
161
|
|
|
|
|
|
|
} |
162
|
|
|
|
|
|
|
|
163
|
0
|
|
|
|
|
|
return \%data; |
164
|
|
|
|
|
|
|
} |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
sub results { |
167
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
168
|
0
|
|
|
|
|
|
my %dates = map {$_ => 1} @{ shift() }; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
|
170
|
0
|
|
|
|
|
|
my $sql1 = q{SELECT * FROM leaderboard ORDER BY postdate,osname}; |
171
|
|
|
|
|
|
|
# my $sql1 = q{ |
172
|
|
|
|
|
|
|
# SELECT l.*, p.name, p.pause |
173
|
|
|
|
|
|
|
# FROM leaderboard l |
174
|
|
|
|
|
|
|
# LEFT JOIN testers.profile p ON p.testerid=l.testerid |
175
|
|
|
|
|
|
|
# ORDER BY postdate,osname |
176
|
|
|
|
|
|
|
# }; |
177
|
|
|
|
|
|
|
|
178
|
0
|
|
|
|
|
|
my %hash; |
179
|
0
|
|
|
|
|
|
my @rows = $self->{parent}->{CPANSTATS}->get_query('hash',$sql1); |
180
|
0
|
|
|
|
|
|
for my $row (@rows) { |
181
|
0
|
|
|
|
|
|
my $tester = $self->{parent}->tester_lookup($row->{addressid},$row->{testerid}); |
182
|
0
|
|
0
|
|
|
|
$tester ||= $row->{tester}; |
183
|
|
|
|
|
|
|
|
184
|
0
|
0
|
|
|
|
|
if($dates{ $row->{postdate} }) { |
|
|
0
|
|
|
|
|
|
185
|
0
|
|
|
|
|
|
$hash{ $row->{postdate} }{$row->{osname}}{$tester} = $row->{score}; |
186
|
|
|
|
|
|
|
} elsif($dates{ '999999' }) { |
187
|
0
|
|
|
|
|
|
$hash{ '999999' }{$row->{osname}}{$tester} += $row->{score}; |
188
|
|
|
|
|
|
|
} |
189
|
|
|
|
|
|
|
} |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
# make sure we reference an empty hash, not undef |
192
|
0
|
|
|
|
|
|
for(keys %dates) { |
193
|
0
|
0
|
|
|
|
|
$hash{$_} = {} unless(defined $hash{$_}); |
194
|
|
|
|
|
|
|
} |
195
|
|
|
|
|
|
|
|
196
|
0
|
|
|
|
|
|
return \%hash; |
197
|
|
|
|
|
|
|
} |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
# ------------------------------------- |
200
|
|
|
|
|
|
|
# Private Methods |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
sub _update { |
203
|
0
|
|
|
0
|
|
|
my $self = shift; |
204
|
|
|
|
|
|
|
|
205
|
0
|
|
|
|
|
|
my $sql1 = shift; |
206
|
0
|
|
|
|
|
|
my $sql2 = 'SELECT osname,tester,COUNT(id) AS count FROM cpanstats '. |
207
|
|
|
|
|
|
|
'WHERE postdate=? AND type=2 '. |
208
|
|
|
|
|
|
|
'GROUP BY osname,tester ORDER BY tester,osname'; |
209
|
0
|
|
|
|
|
|
my $sql3 = 'REPLACE INTO leaderboard (postdate,osname,tester,score,addressid,testerid) VALUES (?,?,?,?,?,?)'; |
210
|
0
|
|
|
|
|
|
my $sql4 = 'DELETE FROM leaderboard WHERE postdate=?'; |
211
|
|
|
|
|
|
|
|
212
|
0
|
|
|
|
|
|
my @rows = $self->{parent}->{CPANSTATS}->get_query('hash',$sql1); |
213
|
0
|
|
|
|
|
|
for my $row (@rows) { |
214
|
0
|
|
|
|
|
|
$self->{parent}->_log("postdate = $row->{postdate}"); |
215
|
|
|
|
|
|
|
|
216
|
0
|
|
|
|
|
|
$self->{parent}->{CPANSTATS}->do_query($sql4,$row->{postdate}); |
217
|
|
|
|
|
|
|
|
218
|
0
|
|
|
|
|
|
my (%hash,%names); |
219
|
0
|
|
|
|
|
|
my $next = $self->{parent}->{CPANSTATS}->iterator('hash',$sql2,$row->{postdate}); |
220
|
0
|
|
|
|
|
|
while(my $row2 = $next->()) { |
221
|
0
|
|
|
|
|
|
my ($name,$addressid,$testerid) = $self->{parent}->tester($row2->{tester}); |
222
|
0
|
|
|
|
|
|
my $osname = lc $row2->{osname}; |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
#$self->{parent}->_log( sprintf "%s,%s,%d", $osname, $name, $row2->{count} ); |
225
|
0
|
|
|
|
|
|
$hash{$osname}{$name}{score} += $row2->{count}; |
226
|
0
|
|
|
|
|
|
$hash{$osname}{$name}{addressid} = $addressid; |
227
|
0
|
|
|
|
|
|
$hash{$osname}{$name}{testerid} = $testerid; |
228
|
|
|
|
|
|
|
#$self->{parent}->_log( sprintf "%s,%s,%d", $osname, $name, $hash{$osname}{$name}{score} ); |
229
|
|
|
|
|
|
|
} |
230
|
|
|
|
|
|
|
|
231
|
0
|
|
|
|
|
|
for my $osname (keys %hash) { |
232
|
0
|
|
|
|
|
|
for my $name (keys %{ $hash{$osname} }) { |
|
0
|
|
|
|
|
|
|
233
|
0
|
|
|
|
|
|
$self->{parent}->{CPANSTATS}->do_query($sql3, |
234
|
|
|
|
|
|
|
$row->{postdate}, $osname, $name, |
235
|
|
|
|
|
|
|
$hash{$osname}{$name}{score}, |
236
|
|
|
|
|
|
|
$hash{$osname}{$name}{addressid}, |
237
|
|
|
|
|
|
|
$hash{$osname}{$name}{testerid}); |
238
|
|
|
|
|
|
|
} |
239
|
|
|
|
|
|
|
} |
240
|
|
|
|
|
|
|
} |
241
|
|
|
|
|
|
|
} |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
q("I'll never forget him (the leader of the pack)"); |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
__END__ |