CPAN-Testers-WWW-Reports
view release on metacpan or search on metacpan
lib/Labyrinth/Plugin/CPAN/Monitor.pm view on Meta::CPAN
push @{ $page_count[0] }, !$seen{"$3/$2"} ? "$3/$2" : '';
push @{ $page_weight[0] }, !$seen{"$3/$2"} ? "$3/$2" : '';
$seen{"$3/$2"} = 1;
}
$y++;
my $inx = 1;
for my $day (sort {$b <=> $a} keys %$days) {
if(defined $data->{$now}{$day}) {
push @{ $name_count[$inx] }, $data->{$now}{$day}->{name_count};
push @{ $page_count[$inx] }, $data->{$now}{$day}->{page_count};
push @{ $page_weight[$inx] }, $data->{$now}{$day}->{page_weight};
$max_name_count = $data->{$now}{$day}->{name_count} if($max_name_count < $data->{$now}{$day}->{name_count});
$max_page_count = $data->{$now}{$day}->{page_count} if($max_page_count < $data->{$now}{$day}->{page_count});
$max_page_weight = $data->{$now}{$day}->{page_weight} if($max_page_weight < $data->{$now}{$day}->{page_weight});
} else {
push @{ $name_count[$inx] }, 0;
push @{ $page_count[$inx] }, 0;
push @{ $page_weight[$inx] }, 0;
}
$inx++;
}
}
_write_image($max_name_count, 'Unique Page Requests',$days,\@name_count, "name_count$suffix", $progress);
_write_image($max_page_count, 'Total Page Requests', $days,\@page_count, "page_count$suffix", $progress);
_write_image($max_page_weight,'Total Page Weight', $days,\@page_weight,"page_weight$suffix",$progress);
$progress->( "Update STOP" ) if(defined $progress);
}
sub _write_image {
my ($m,$title,$days,$data,$filename,$progress) = @_;
my $max = _set_max($m);
my $range = _set_range(0,$max);
#$progress->( "DATA = [".(scalar(@$data))."] ".Dumper($data) ) if(defined $progress);
#my $grey = add_colour(grey => hex2rgb('#eeeeee'));
my $graph = GD::Graph::lines->new(640, 300);
#add_colour($_ => hex2rgb($COLOURS{$_})) for(@COLOURS);
$graph->set(
title => $title,
x_label => 'Timestamp',
x_label_position => 0.5,
x_labels_vertical => 1,
x_label_skip => $filename =~ /-1d$/ ? 1 : 1,
x_tick_length => -2,
y_label => '',
y_max_value => $max,
y_tick_length => -2,
y_number_format => \&_y_format,
line_width => 2,
axis_space => 4,
legend_placement => 'RC',
dclrs => [qw(lpurple blue cyan green orange red dred lbrown pink yellow dpurple)],
#dclrs => [@COLOURS],
boxclr => '#eeeeee',
labelclr => 'dgray',
axislabelclr => 'dgray',
legendclr => 'dgray',
valuesclr => 'dgray',
textclr => 'dgray'
) or die $graph->error;
my @days = map {$days->{$_}} sort {$b <=> $a} keys %$days;
$graph->set_legend(@days);
#my $font = '/usr/share/fonts/truetype/ttf-dejavu/DejaVuSans.ttf';
my $font = '/usr/share/fonts/truetype/freefont/FreeSans.ttf';
$graph->set_title_font( $font,10);
$graph->set_legend_font( $font,10);
$graph->set_x_label_font($font,8);
$graph->set_y_label_font($font,8);
$graph->set_x_axis_font( $font,8);
$graph->set_y_axis_font( $font,8);
$graph->set_values_font( $font,8);
my $gd = $graph->plot($data) or die $graph->error;
my $file = "$settings{webdir}/static/$filename.png";
my $fh = IO::File->new($file, 'w+') or die "Couldn't write to file [$file]: $!\n";
binmode $fh;
print $fh $gd->png;
$fh->close;
}
sub _make_graph_url {
my ($m,$title,$days,$data) = @_;
my $max = _set_max($m);
my $range = _set_range(0,$max);
my (@d,@c,@l);
my @colours = @COLOURS;
for my $inx (3 .. scalar(@$data)) {
# data needs to be expressed as a percentage of the max
for(@{$data->[$inx-1]}) {
#print "pcent = $_ / $max * 100 = ";
$_ = $_ / $max * 100;
#print "$_ = ";
$_ = int($_ * 1) / 1;
#print "$_\n";
}
push @c, shift @colours;
push @d, join(',',@{$data->[$inx-1]});
push @l, ($inx-3) . ' day' . ($inx-3==1 ? '' : 's') . ' old';
}
@l = map {$days->{$_}} sort {$b <=> $a} keys %$days;
my $xaxis1 = join('|', @{$data->[0]});
my $xaxis2 = join('|', @{$data->[1]});
my $datum = sprintf $chart_data, join('|',reverse @d);
my $colour = sprintf $chart_colour, join(',',@c);
my $titles = sprintf $chart_titles, $title, join('|',@l);
my $labels = sprintf $chart_labels, $xaxis1, $xaxis2, $range, $range;
$titles =~ s/ /+/g;
$labels =~ s/ /+/g;
return join('&', $chart_api, $titles, $labels, $colour, $chart_filler, $datum);
}
sub _set_max {
my $max = shift;
my $lmt = 10;
return $lmt if($max <= $lmt);
my $len = length("$max") - 1;
my $num = substr("$max",0,1);
( run in 2.489 seconds using v1.01-cache-2.11-cpan-c966e8aa7e8 )