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 )