view release on metacpan or  search on metacpan

lib/CPAN/Testers/WWW/Statistics/Graphs.pm  view on Meta::CPAN

package CPAN::Testers::WWW::Statistics::Graphs;

use warnings;
use strict;
use vars qw($VERSION);

$VERSION = '1.23';

#----------------------------------------------------------------------------

=head1 NAME

CPAN::Testers::WWW::Statistics::Graphs - CPAN Testers Statistics graphs.

=head1 SYNOPSIS

  my %hash = { config => 'options' };
  my $obj = CPAN::Testers::WWW::Statistics->new(%hash);
  my $ct = CPAN::Testers::WWW::Statistics::Graphs->new(parent => $obj);
  $ct->create();

=head1 DESCRIPTION

Using previously formatted data, generate graphs using the Google Chart API.

Note that this package should not be called directly, but via its parent as:

  my %hash = { config => 'options' };
  my $obj = CPAN::Testers::WWW::Statistics->new(%hash);
  $obj->make_graphs();

=cut

# -------------------------------------
# Library Modules

use File::Basename;
use File::Path;
use HTML::Entities;
use IO::File;
use LWP::UserAgent;
use HTTP::Request;

# -------------------------------------
# Variables

my %month = (
    0 => 'January',   1 => 'February', 2 => 'March',     3 => 'April',
    4 => 'May',       5 => 'June',     6 => 'July',      7 => 'August',
    8 => 'September', 9 => 'October', 10 => 'November', 11 => 'December'
);

my ($backg,$foreg) = ('black','white');

my @graphs = (
['stats/stats1'     ,'CPAN Testers Statistics - Reports'        ,[qw(UPLOADS REPORTS PASS FAIL)],'TEST_RANGES'  ,'month'],
['stats/stats2'     ,'CPAN Testers Statistics - Attributes'     ,[qw(TESTERS PLATFORMS PERLS)]  ,'TEST_RANGES'  ,'month'],
['stats/stats3'     ,'CPAN Testers Statistics - Non-Passes'     ,[qw(FAIL NA UNKNOWN)]          ,'TEST_RANGES'  ,'month'],
['stats/stats4'     ,'CPAN Testers Statistics - Testers'        ,[qw(ALL FIRST LAST)]           ,'TEST_RANGES'  ,'month'],
['stats/stats6'     ,'CPAN Statistics - Uploads'                ,[qw(AUTHORS DISTROS)]          ,'CPAN_RANGES'  ,'month'],
['stats/stats12'    ,'CPAN Statistics - New Uploads'            ,[qw(AUTHORS DISTROS)]          ,'CPAN_RANGES'  ,'month'],
['stats/build1'     ,'CPAN Testers Performance Graph'           ,[qw(REQUESTS PAGES REPORTS)]   ,'NONE'         ,'daily'],
['stats/pcent1'     ,'CPAN Testers Statistics - Percentages'    ,[qw(FAIL OTHER PASS)]          ,'TEST_RANGES'  ,'month'],
['rates/submit1'    ,'CPAN Submissions - By Month'              ,[qw(EXCLUSIVE INCLUSIVE)]      ,'NONE'         ,'index'],
['rates/submit2'    ,'CPAN Submissions - By Day of the Week'    ,[qw(EXCLUSIVE INCLUSIVE)]      ,'NONE'         ,'index'],
['rates/submit3'    ,'CPAN Submissions - By Day of the Month'   ,[qw(EXCLUSIVE INCLUSIVE)]      ,'NONE'         ,'index'],
['rates/submit4'    ,'CPAN Submissions - By Hour'               ,[qw(EXCLUSIVE INCLUSIVE)]      ,'NONE'         ,'index'],
);

my $lwp = LWP::UserAgent->new();
$lwp->agent( 'Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.4) Gecko/20030624' );

my $chart_api    = 'http://chart.apis.google.com/chart?chs=640x300&cht=lc';
my $chart_titles = 'chtt=%s&chdl=%s';
my $chart_labels = 'chxt=x,x,y,r&chxl=0:|%s|1:|%s|2:|%s|3:|%s';
my $chart_data   = 'chd=t:%s';
my $chart_colour = 'chco=%s';
my $chart_filler = 'chf=bg,s,dddddd';

my %COLOURS = (
    white      => [255,255,255],
    black      => [0,0,0],
    red        => [255,0,0],
    blue       => [0,0,255],
    purple     => [230,0,230],
    green      => [0,255,0],
    grey       => [128,128,128],
    light_grey => [170,170,170],
    dark_grey  => [75,75,75],
    cream      => [200,200,240],
    yellow     => [255,255,0],
    orange     => [255,128,0],
);

my @COLOURS = map {sprintf "%s%s%s", _dec2hex($COLOURS{$_}->[0]),_dec2hex($COLOURS{$_}->[1]),_dec2hex($COLOURS{$_}->[2])} qw(red blue green orange purple grey);
my @MONTH   = qw( - JANUARY FEBRUARY MARCH APRIL MAY JUNE JULY AUGUST SEPTEMBER OCTOBER NOVEMBER DECEMBER );
my @MONTHS  = map {my @x = split(//); my $x = join(' ',@x); [split(//,$x)]} @MONTH;

# -------------------------------------
# Subroutines

=head1 INTERFACE

lib/CPAN/Testers/WWW/Statistics/Graphs.pm  view on Meta::CPAN

=cut

sub new {
    my $class = shift;
    my %hash  = @_;

    die "Must specify the parent statistics object\n"   unless(defined $hash{parent});

    my $self = {parent => $hash{parent}};
    bless $self, $class;

    $self->{parent}->_log("GRAPHS: new");

    return $self;
}

=head2 Methods

=over 4

=item * create

Method to facilitate the creation of graphs.

=back

=cut

sub create {
    my $self = shift;
    my $status = 0; # assume success

    my $directory = $self->{parent}->directory;

    $self->{parent}->_log("create start");

    for my $g (@graphs) {
        my $results   = "$directory/$g->[0]";
        my ($path,$file) = (dirname($results),basename($results));
        mkpath($path);
        $g->[0] = $file;
        $g->[5] = $path;

        my $ranges = $self->{parent}->ranges($g->[3]);
        $self->{parent}->_log("writing graph - got range [$g->[3]] = " . (scalar(@$ranges)) . ", latest=$ranges->[-1]");

        my $latest = $ranges->[-1];

        for my $r (@$ranges) {
            $self->{parent}->_log("writing graph - $g->[0]-$r");

            my $url = $self->_make_graph($r,@$g);
            next    unless($url);

            $self->{parent}->_log("url - [".(length $url)."] $url");
    #        print "$url\n";

            my $res;
            eval {
                my $req = HTTP::Request->new(GET => $url);
                $res = $lwp->request($req);
            };

            if($@ || !$res->is_success()) {
                $file = "$results-$r.html";
                $self->{parent}->_log("FAIL: $0 - Cannot access page - see '$file' [$url] [" . length($url) . "] [$@]\n");
                _save_content($res,$file);
                $status = 1;
            } elsif($res->header('Content-Type') =~ /html/) {
                $file = "$results-$r.html";
                $self->{parent}->_log("FAIL: $0 - request failed - see '$file'\n");
                _save_content($res,$file);
                $status = 1;
            } else {
                $file = "$results-$r.png";
                _save_content($res,$file);

                if($r eq $latest) {
                    $file = "$results.png";
                    _save_content($res,$file);
                }
            }
        }
    }

    $self->{parent}->_log("finish = $status");
    return $status;
}

sub _save_content {
    my ($res,$file) = @_;
    my $fh = IO::File->new(">$file") or die "$0 - Cannot write file [$file]: $!\n";
    binmode($fh)    if($file =~ /\.png$/);
    print $fh $res->content;
    $fh->close;
}

#=item _make_graph
#
#Creates and writes out a single graph.
#
#=cut

sub _make_graph {
    my ($self,$r,$file,$title,$legend,$rcode,$type,$path) = @_;
    my (@dates1,@dates2);
    my $yr = 0;

    my @data = $self->_get_data("$path/$file.txt",$r);
    #use Data::Dumper;
    #print STDERR "#type=$type, file=$file.txt, data=".Dumper(\@data);

$self->{parent}->_log("checkpoint 1");
    return  unless(@data);
$self->{parent}->_log("checkpoint 2");

    for my $date (@{$data[0]}) {
        if($type eq 'index') {
            push @dates1, "'";
            push @dates2, $date;