line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Labyrinth::Plugin::CPAN::Monitor; |
2
|
|
|
|
|
|
|
|
3
|
4
|
|
|
4
|
|
14500
|
use strict; |
|
4
|
|
|
|
|
9
|
|
|
4
|
|
|
|
|
102
|
|
4
|
4
|
|
|
4
|
|
18
|
use warnings; |
|
4
|
|
|
|
|
8
|
|
|
4
|
|
|
|
|
103
|
|
5
|
|
|
|
|
|
|
|
6
|
4
|
|
|
4
|
|
18
|
use vars qw($VERSION); |
|
4
|
|
|
|
|
9
|
|
|
4
|
|
|
|
|
170
|
|
7
|
|
|
|
|
|
|
$VERSION = '3.59'; |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
=head1 NAME |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
Labyrinth::Plugin::CPAN::Monitor - Plugin to monitor actions and tables |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
=cut |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
#---------------------------------------------------------------------------- |
16
|
|
|
|
|
|
|
# Libraries |
17
|
|
|
|
|
|
|
|
18
|
4
|
|
|
4
|
|
21
|
use base qw(Labyrinth::Plugin::Base); |
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
241
|
|
19
|
|
|
|
|
|
|
|
20
|
4
|
|
|
4
|
|
22
|
use Labyrinth::Audit; |
|
4
|
|
|
|
|
8
|
|
|
4
|
|
|
|
|
462
|
|
21
|
4
|
|
|
4
|
|
23
|
use Labyrinth::DTUtils; |
|
4
|
|
|
|
|
9
|
|
|
4
|
|
|
|
|
228
|
|
22
|
4
|
|
|
4
|
|
25
|
use Labyrinth::Variables; |
|
4
|
|
|
|
|
8
|
|
|
4
|
|
|
|
|
508
|
|
23
|
|
|
|
|
|
|
|
24
|
4
|
|
|
4
|
|
27
|
use Labyrinth::Plugin::CPAN; |
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
23
|
|
25
|
|
|
|
|
|
|
|
26
|
4
|
|
|
4
|
|
101
|
use Data::Dumper; |
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
139
|
|
27
|
4
|
|
|
4
|
|
1742
|
use GD::Graph::lines; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
use GD::Graph::colour qw(:colours :convert); |
29
|
|
|
|
|
|
|
use WWW::Mechanize; |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
#---------------------------------------------------------------------------- |
32
|
|
|
|
|
|
|
# Variables |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
my $HOURS24 = 60 * 60 * 24; |
35
|
|
|
|
|
|
|
my $WEEKS1 = 60 * 60 * 24 * 7; |
36
|
|
|
|
|
|
|
my $WEEKS4 = 60 * 60 * 24 * 7 * 4; |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
my $mech = WWW::Mechanize->new(); |
39
|
|
|
|
|
|
|
$mech->agent_alias( 'Linux Mozilla' ); |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
my $chart_api = 'http://chart.apis.google.com/chart?chs=640x300&cht=lc'; |
42
|
|
|
|
|
|
|
my $chart_titles = 'chtt=%s&chdl=%s'; |
43
|
|
|
|
|
|
|
my $chart_labels = 'chxt=x,x,y,r&chxl=0:|%s|1:|%s|2:|%s|3:|%s'; |
44
|
|
|
|
|
|
|
my $chart_data = 'chd=t:%s'; |
45
|
|
|
|
|
|
|
my $chart_colour = 'chco=%s'; |
46
|
|
|
|
|
|
|
my $chart_filler = 'chf=bg,s,dddddd'; |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
my %COLOURS = ( |
49
|
|
|
|
|
|
|
white => 'FFFFFF', |
50
|
|
|
|
|
|
|
black => '000000', |
51
|
|
|
|
|
|
|
red => 'FF0000', |
52
|
|
|
|
|
|
|
blue => '0000FF', |
53
|
|
|
|
|
|
|
green => '00FF00', |
54
|
|
|
|
|
|
|
orange => 'E76300', |
55
|
|
|
|
|
|
|
purple => '800080', |
56
|
|
|
|
|
|
|
cyan => '00FFFF', |
57
|
|
|
|
|
|
|
cream => 'C8C8F0', |
58
|
|
|
|
|
|
|
yellow => 'FFFF00', |
59
|
|
|
|
|
|
|
brown => '987654', |
60
|
|
|
|
|
|
|
violet => '8A2BE2', |
61
|
|
|
|
|
|
|
torch => 'FD0E35', |
62
|
|
|
|
|
|
|
); |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
# predefine colours in GD::Chart::colours: |
65
|
|
|
|
|
|
|
# white, lgray, gray, dgray, black, lblue, blue, dblue, gold, lyellow, yellow, |
66
|
|
|
|
|
|
|
# dyellow, lgreen, green, dgreen, lred, red, dred, lpurple, purple, dpurple, |
67
|
|
|
|
|
|
|
# lorange, orange, pink, dpink, marine, cyan, lbrown, dbrown. |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
#my @COLOURS = qw(violet blue cyan green orange red torch brown cream yellow purple); |
70
|
|
|
|
|
|
|
my @COLOURS = qw(purple blue cyan green orange red dred brown cream yellow dpurple); |
71
|
|
|
|
|
|
|
#my @COLOURS = map {$COLOURS{$_}} qw(violet blue cyan green orange red torch brown cream yellow purple); |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
#---------------------------------------------------------------------------- |
74
|
|
|
|
|
|
|
# Public Interface Functions |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
=head1 METHODS |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
=head2 Public Interface Methods |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
=over 4 |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
=item Snapshot |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
Generate a new snapshot in the database. |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
=item Graphs |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
Provide monitor graphs |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
=back |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
=cut |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
sub Snapshot { |
95
|
|
|
|
|
|
|
my ($self,$progress) = @_; |
96
|
|
|
|
|
|
|
$progress->( "Create START" ) if(defined $progress); |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
my @rows = $dbi->GetQuery('array','CountRequests'); |
99
|
|
|
|
|
|
|
my $sql = $rows[0]->[0] > 0 ? 'CreateSnapshot' : 'CreateSnapshot0'; |
100
|
|
|
|
|
|
|
my $next = $dbi->Iterator('array',$sql); |
101
|
|
|
|
|
|
|
while(my $row = $next->()) { |
102
|
|
|
|
|
|
|
$dbi->DoQuery('InsertSnapshot',@$row); |
103
|
|
|
|
|
|
|
} |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
$progress->( "Create STOP" ) if(defined $progress); |
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
sub Graphs { |
109
|
|
|
|
|
|
|
my ($self,$progress) = @_; |
110
|
|
|
|
|
|
|
$progress->( "Update START" ) if(defined $progress); |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
my @date = localtime(time - $HOURS24); |
113
|
|
|
|
|
|
|
my $timestamp = sprintf "%04d-%02d-%02d %02d:%02d:%02d", |
114
|
|
|
|
|
|
|
$date[5]+1900,$date[4]+1,$date[3],$date[2],$date[1],$date[0]; |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
my (%data,%days); |
117
|
|
|
|
|
|
|
my @rows = $dbi->GetQuery('hash','GetSnapshots',{timestamp => $timestamp}); |
118
|
|
|
|
|
|
|
for my $row (@rows) { |
119
|
|
|
|
|
|
|
my $date = sprintf "%04d%02d%02d", $row->{year}, $row->{month}, $row->{day}; |
120
|
|
|
|
|
|
|
$data{$row->{now}}{$date} = $row; |
121
|
|
|
|
|
|
|
$days{$date} = sprintf "%02d/%02d/%04d", $row->{day}, $row->{month}, $row->{year};; |
122
|
|
|
|
|
|
|
} |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
_make_graphs(\%days,\%data,'-1d',$progress); |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
@date = localtime(time - $WEEKS1); |
127
|
|
|
|
|
|
|
$timestamp = sprintf "%04d-%02d-%02d %02d:%02d:%02d", |
128
|
|
|
|
|
|
|
$date[5]+1900,$date[4]+1,$date[3],$date[2],$date[1],$date[0]; |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
(%data,%days) = (); |
131
|
|
|
|
|
|
|
@rows = $dbi->GetQuery('hash','GetSnapshots',{timestamp => $timestamp}); |
132
|
|
|
|
|
|
|
for my $row (@rows) { |
133
|
|
|
|
|
|
|
my $date = sprintf "%04d%02d%02d", $row->{year}, $row->{month}, $row->{day}; |
134
|
|
|
|
|
|
|
$data{$row->{now}}{$date} = $row; |
135
|
|
|
|
|
|
|
$days{$date} = sprintf "%02d/%02d/%04d", $row->{day}, $row->{month}, $row->{year};; |
136
|
|
|
|
|
|
|
} |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
my $r = 0; |
139
|
|
|
|
|
|
|
for my $d (keys %data) { |
140
|
|
|
|
|
|
|
next if($r++ % 4 == 0); |
141
|
|
|
|
|
|
|
delete $data{$d}; |
142
|
|
|
|
|
|
|
} |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
_make_graphs(\%days,\%data,'-1w',$progress); |
145
|
|
|
|
|
|
|
} |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
#---------------------------------------------------------------------------- |
148
|
|
|
|
|
|
|
# Private Interface Functions |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
sub _make_graphs { |
151
|
|
|
|
|
|
|
my ($days,$data,$suffix,$progress) = @_; |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
my $y = 0; |
154
|
|
|
|
|
|
|
my (@name_count,@page_count,@page_weight,%seen); |
155
|
|
|
|
|
|
|
my ($max_name_count,$max_page_count,$max_page_weight) = (0,0,0); |
156
|
|
|
|
|
|
|
for my $now (sort keys %$data) { |
157
|
|
|
|
|
|
|
my (@now) = $now =~ /(\d+)-(\d+)-(\d+) (\d+):(\d+):(\d+)/; |
158
|
|
|
|
|
|
|
if($suffix eq '-1d') { |
159
|
|
|
|
|
|
|
push @{ $name_count[0] }, $y % 4 == 0 ? "$4:$5" : ''; |
160
|
|
|
|
|
|
|
push @{ $page_count[0] }, $y % 4 == 0 ? "$4:$5" : ''; |
161
|
|
|
|
|
|
|
push @{ $page_weight[0] }, $y % 4 == 0 ? "$4:$5" : ''; |
162
|
|
|
|
|
|
|
} else { |
163
|
|
|
|
|
|
|
push @{ $name_count[0] }, !$seen{"$3/$2"} ? "$3/$2" : ''; |
164
|
|
|
|
|
|
|
push @{ $page_count[0] }, !$seen{"$3/$2"} ? "$3/$2" : ''; |
165
|
|
|
|
|
|
|
push @{ $page_weight[0] }, !$seen{"$3/$2"} ? "$3/$2" : ''; |
166
|
|
|
|
|
|
|
$seen{"$3/$2"} = 1; |
167
|
|
|
|
|
|
|
} |
168
|
|
|
|
|
|
|
$y++; |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
my $inx = 1; |
171
|
|
|
|
|
|
|
for my $day (sort {$b <=> $a} keys %$days) { |
172
|
|
|
|
|
|
|
if(defined $data->{$now}{$day}) { |
173
|
|
|
|
|
|
|
push @{ $name_count[$inx] }, $data->{$now}{$day}->{name_count}; |
174
|
|
|
|
|
|
|
push @{ $page_count[$inx] }, $data->{$now}{$day}->{page_count}; |
175
|
|
|
|
|
|
|
push @{ $page_weight[$inx] }, $data->{$now}{$day}->{page_weight}; |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
$max_name_count = $data->{$now}{$day}->{name_count} if($max_name_count < $data->{$now}{$day}->{name_count}); |
178
|
|
|
|
|
|
|
$max_page_count = $data->{$now}{$day}->{page_count} if($max_page_count < $data->{$now}{$day}->{page_count}); |
179
|
|
|
|
|
|
|
$max_page_weight = $data->{$now}{$day}->{page_weight} if($max_page_weight < $data->{$now}{$day}->{page_weight}); |
180
|
|
|
|
|
|
|
} else { |
181
|
|
|
|
|
|
|
push @{ $name_count[$inx] }, 0; |
182
|
|
|
|
|
|
|
push @{ $page_count[$inx] }, 0; |
183
|
|
|
|
|
|
|
push @{ $page_weight[$inx] }, 0; |
184
|
|
|
|
|
|
|
} |
185
|
|
|
|
|
|
|
$inx++; |
186
|
|
|
|
|
|
|
} |
187
|
|
|
|
|
|
|
} |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
_write_image($max_name_count, 'Unique Page Requests',$days,\@name_count, "name_count$suffix", $progress); |
190
|
|
|
|
|
|
|
_write_image($max_page_count, 'Total Page Requests', $days,\@page_count, "page_count$suffix", $progress); |
191
|
|
|
|
|
|
|
_write_image($max_page_weight,'Total Page Weight', $days,\@page_weight,"page_weight$suffix",$progress); |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
$progress->( "Update STOP" ) if(defined $progress); |
194
|
|
|
|
|
|
|
} |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
sub _write_image { |
197
|
|
|
|
|
|
|
my ($m,$title,$days,$data,$filename,$progress) = @_; |
198
|
|
|
|
|
|
|
my $max = _set_max($m); |
199
|
|
|
|
|
|
|
my $range = _set_range(0,$max); |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
#$progress->( "DATA = [".(scalar(@$data))."] ".Dumper($data) ) if(defined $progress); |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
#my $grey = add_colour(grey => hex2rgb('#eeeeee')); |
204
|
|
|
|
|
|
|
my $graph = GD::Graph::lines->new(640, 300); |
205
|
|
|
|
|
|
|
#add_colour($_ => hex2rgb($COLOURS{$_})) for(@COLOURS); |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
$graph->set( |
208
|
|
|
|
|
|
|
title => $title, |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
x_label => 'Timestamp', |
211
|
|
|
|
|
|
|
x_label_position => 0.5, |
212
|
|
|
|
|
|
|
x_labels_vertical => 1, |
213
|
|
|
|
|
|
|
x_label_skip => $filename =~ /-1d$/ ? 1 : 1, |
214
|
|
|
|
|
|
|
x_tick_length => -2, |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
y_label => '', |
217
|
|
|
|
|
|
|
y_max_value => $max, |
218
|
|
|
|
|
|
|
y_tick_length => -2, |
219
|
|
|
|
|
|
|
y_number_format => \&_y_format, |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
line_width => 2, |
222
|
|
|
|
|
|
|
axis_space => 4, |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
legend_placement => 'RC', |
225
|
|
|
|
|
|
|
dclrs => [qw(lpurple blue cyan green orange red dred lbrown pink yellow dpurple)], |
226
|
|
|
|
|
|
|
#dclrs => [@COLOURS], |
227
|
|
|
|
|
|
|
boxclr => '#eeeeee', |
228
|
|
|
|
|
|
|
labelclr => 'dgray', |
229
|
|
|
|
|
|
|
axislabelclr => 'dgray', |
230
|
|
|
|
|
|
|
legendclr => 'dgray', |
231
|
|
|
|
|
|
|
valuesclr => 'dgray', |
232
|
|
|
|
|
|
|
textclr => 'dgray' |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
) or die $graph->error; |
235
|
|
|
|
|
|
|
my @days = map {$days->{$_}} sort {$b <=> $a} keys %$days; |
236
|
|
|
|
|
|
|
$graph->set_legend(@days); |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
#my $font = '/usr/share/fonts/truetype/ttf-dejavu/DejaVuSans.ttf'; |
239
|
|
|
|
|
|
|
my $font = '/usr/share/fonts/truetype/freefont/FreeSans.ttf'; |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
$graph->set_title_font( $font,10); |
242
|
|
|
|
|
|
|
$graph->set_legend_font( $font,10); |
243
|
|
|
|
|
|
|
$graph->set_x_label_font($font,8); |
244
|
|
|
|
|
|
|
$graph->set_y_label_font($font,8); |
245
|
|
|
|
|
|
|
$graph->set_x_axis_font( $font,8); |
246
|
|
|
|
|
|
|
$graph->set_y_axis_font( $font,8); |
247
|
|
|
|
|
|
|
$graph->set_values_font( $font,8); |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
my $gd = $graph->plot($data) or die $graph->error; |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
my $file = "$settings{webdir}/static/$filename.png"; |
253
|
|
|
|
|
|
|
my $fh = IO::File->new($file, 'w+') or die "Couldn't write to file [$file]: $!\n"; |
254
|
|
|
|
|
|
|
binmode $fh; |
255
|
|
|
|
|
|
|
print $fh $gd->png; |
256
|
|
|
|
|
|
|
$fh->close; |
257
|
|
|
|
|
|
|
} |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
sub _make_graph_url { |
260
|
|
|
|
|
|
|
my ($m,$title,$days,$data) = @_; |
261
|
|
|
|
|
|
|
my $max = _set_max($m); |
262
|
|
|
|
|
|
|
my $range = _set_range(0,$max); |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
my (@d,@c,@l); |
265
|
|
|
|
|
|
|
my @colours = @COLOURS; |
266
|
|
|
|
|
|
|
for my $inx (3 .. scalar(@$data)) { |
267
|
|
|
|
|
|
|
# data needs to be expressed as a percentage of the max |
268
|
|
|
|
|
|
|
for(@{$data->[$inx-1]}) { |
269
|
|
|
|
|
|
|
#print "pcent = $_ / $max * 100 = "; |
270
|
|
|
|
|
|
|
$_ = $_ / $max * 100; |
271
|
|
|
|
|
|
|
#print "$_ = "; |
272
|
|
|
|
|
|
|
$_ = int($_ * 1) / 1; |
273
|
|
|
|
|
|
|
#print "$_\n"; |
274
|
|
|
|
|
|
|
} |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
push @c, shift @colours; |
277
|
|
|
|
|
|
|
push @d, join(',',@{$data->[$inx-1]}); |
278
|
|
|
|
|
|
|
push @l, ($inx-3) . ' day' . ($inx-3==1 ? '' : 's') . ' old'; |
279
|
|
|
|
|
|
|
} |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
@l = map {$days->{$_}} sort {$b <=> $a} keys %$days; |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
my $xaxis1 = join('|', @{$data->[0]}); |
284
|
|
|
|
|
|
|
my $xaxis2 = join('|', @{$data->[1]}); |
285
|
|
|
|
|
|
|
my $datum = sprintf $chart_data, join('|',reverse @d); |
286
|
|
|
|
|
|
|
my $colour = sprintf $chart_colour, join(',',@c); |
287
|
|
|
|
|
|
|
my $titles = sprintf $chart_titles, $title, join('|',@l); |
288
|
|
|
|
|
|
|
my $labels = sprintf $chart_labels, $xaxis1, $xaxis2, $range, $range; |
289
|
|
|
|
|
|
|
$titles =~ s/ /+/g; |
290
|
|
|
|
|
|
|
$labels =~ s/ /+/g; |
291
|
|
|
|
|
|
|
return join('&', $chart_api, $titles, $labels, $colour, $chart_filler, $datum); |
292
|
|
|
|
|
|
|
} |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
sub _set_max { |
295
|
|
|
|
|
|
|
my $max = shift; |
296
|
|
|
|
|
|
|
my $lmt = 10; |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
return $lmt if($max <= $lmt); |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
my $len = length("$max") - 1; |
301
|
|
|
|
|
|
|
my $num = substr("$max",0,1); |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
if($max < 100_000) { |
304
|
|
|
|
|
|
|
my $lmt1 = (10**$len) * $num; |
305
|
|
|
|
|
|
|
my $lmt2 = ((10**$len) * $num) + ((1**($len-1)) * 5); |
306
|
|
|
|
|
|
|
my $lmt3 = (10**$len) * ($num + 1); |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
return $lmt1 if($max <= $lmt1); |
309
|
|
|
|
|
|
|
return $lmt2 if($max <= $lmt2); |
310
|
|
|
|
|
|
|
return $lmt3 if($max <= $lmt3); |
311
|
|
|
|
|
|
|
} |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
$num += ($num % 2) ? 1 : 2; |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
return (10**$len) * $num; |
316
|
|
|
|
|
|
|
} |
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
sub _set_range { |
319
|
|
|
|
|
|
|
my ($min,$max) = @_; |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
my $len = length("$max") - 2; |
322
|
|
|
|
|
|
|
my $pc0 = $max / 10; |
323
|
|
|
|
|
|
|
|
324
|
|
|
|
|
|
|
my $x1 = 10**$len * 1; |
325
|
|
|
|
|
|
|
my $x2 = 10**$len * 2; |
326
|
|
|
|
|
|
|
my $x5 = 10**$len * 5; |
327
|
|
|
|
|
|
|
my $x0 = 10**$len * 10; |
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
my $step = $pc0 <= $x1 ? $x1 : $pc0 <= $x2 ? $x2 : $pc0 <= $x5 ? $x5 : $x0; |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
my @r; |
332
|
|
|
|
|
|
|
for(my $r = $min; $r < ($max+$step); $r += $step) { |
333
|
|
|
|
|
|
|
my $x = $r < 1000 ? $r : $r < 1000000 ? ($r/1000) . 'k' : ($r/1000000) . 'm'; |
334
|
|
|
|
|
|
|
push @r, $x; |
335
|
|
|
|
|
|
|
}; |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
return join('|',@r); |
338
|
|
|
|
|
|
|
} |
339
|
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
sub _y_format { |
341
|
|
|
|
|
|
|
my $num = shift || return ''; |
342
|
|
|
|
|
|
|
return '' unless(defined $num); |
343
|
|
|
|
|
|
|
return $1.'k' if($num =~ /^(\d{1,3})000$/); |
344
|
|
|
|
|
|
|
return $1.'m' if($num =~ /^(\d{1,3})000000$/); |
345
|
|
|
|
|
|
|
return $num; |
346
|
|
|
|
|
|
|
} |
347
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
1; |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
__END__ |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
=head1 DATABASE SCHEMA |
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
DROP TABLE IF EXISTS `monitor`; |
355
|
|
|
|
|
|
|
CREATE TABLE `monitor` ( |
356
|
|
|
|
|
|
|
now timestamp, |
357
|
|
|
|
|
|
|
day int(2) not null default 0, |
358
|
|
|
|
|
|
|
month int(2) not null default 0, |
359
|
|
|
|
|
|
|
year int(4) not null default 0, |
360
|
|
|
|
|
|
|
name_count int(10) not null default 0, |
361
|
|
|
|
|
|
|
page_count int(10) not null default 0, |
362
|
|
|
|
|
|
|
page_weight int(10) not null default 0, |
363
|
|
|
|
|
|
|
PRIMARY KEY (now,day,month,year) |
364
|
|
|
|
|
|
|
); |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
=head1 SEE ALSO |
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
Labyrinth |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
=head1 AUTHOR |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
Barbie, <barbie@missbarbell.co.uk> for |
373
|
|
|
|
|
|
|
Miss Barbell Productions, L<http://www.missbarbell.co.uk/> |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
=head1 COPYRIGHT & LICENSE |
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
Copyright (C) 2008-2017 Barbie for Miss Barbell Productions |
378
|
|
|
|
|
|
|
All Rights Reserved. |
379
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
This module is free software; you can redistribute it and/or |
381
|
|
|
|
|
|
|
modify it under the Artistic License 2.0. |
382
|
|
|
|
|
|
|
|
383
|
|
|
|
|
|
|
=cut |