view release on metacpan or  search on metacpan

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

        $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;
        } elsif($type eq 'month') {
            my $year  = substr($date,0,4);
            my $month = substr($date,4,2);
            push @dates1, ($month % 2 == 1 ? $MONTHS[$month][0] : '');
            push @dates2, ($year != $yr ? $year : '');
            $yr = $year;
        } else {
            my $year  = substr($date,0,4);
            my $month = substr($date,4,2);
            my $day   = substr($date,6,2);
            push @dates1, ($day == 1 || $day % 7 == 0 ? sprintf "%d", $day : "'");
            push @dates2, ($MONTHS[$month][$day-1] || '');
        }
    }

    my $max = 0;
    for my $inx (1 .. $#data) {
        for my $data (@{$data[$inx]}) {
            $max = $data    if($max < $data);
        }
    }

    $max = _set_max($max);
    my $range = _set_range(0,$max);

    my (@d,@c);
    my @colours = @COLOURS;
    for my $inx (1 .. $#data) {
        push @c, shift @colours;
        # data needs to be expressed as a percentage of the max
        for(@{$data[$inx]}) {
            #print "pcent = $_ / $max * 100 = ";
            $_ = $_ / $max * 100;
            #print "$_ = ";
            $_ = int($_ * 1) / 1;
            #print "$_\n";
        }

        push @d, join(',',@{$data[$inx]});
    }
    my $d = join('|',@d);
    my $data = sprintf $chart_data, $d;

    my $dates1 = join('|', @dates1);
    my $dates2 = join('|', @dates2);

    my $colour = sprintf $chart_colour, join(',',@c);
    my $titles = sprintf $chart_titles, $title, join('|',@$legend);
    my $labels = sprintf $chart_labels, $dates1, $dates2, $range, $range;
    $titles =~ s/ /+/g;
    $labels =~ s/ /+/g;
    my @api = ($chart_api, $titles, $labels, $colour, $chart_filler, $data) ;

    my $url = join('&',@api);
$self->{parent}->_log("checkpoint 3 - $url");
    return $url;
}

#=item _get_data
#
#Reads and returns the contents of the graph data file.
#
#=cut

sub _get_data {
    my ($self,$file,$range) = @_;
    my ($fdate,$tdate) = split('-',$range);

    $self->{parent}->_log("get data - range=$range, fdate=$fdate, tdate=$tdate, file=$file");

    my @data;
    my $fh = IO::File->new($file)
        or return ();
        #or die "Cannot open data file [$file]: $!\n";
    while(<$fh>) {
        s/\s*$//;
        next    unless($_);
        next    if(/^#/ || /^$/);
        my @values = split(",",$_);
        next    if($values[0] < $fdate || $values[0] > $tdate);
        push @{$data[$_]}, $values[$_]    for(0..$#values);
    }
    return @data;
}

sub _dec2hex {
    my $hexnum = sprintf("%x", $_[0]);
    return '00'         if(length($hexnum) < 1);
    return '0'.$hexnum  if(length($hexnum) < 2);
    return $hexnum;
}

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);

    if($max < 100_000) {
        my $lmt1 =  (10**$len) *  $num;
        my $lmt2 = ((10**$len) *  $num) + ((1**($len-1)) * 5);
        my $lmt3 =  (10**$len) * ($num + 1);

        return $lmt1    if($max <= $lmt1);
        return $lmt2    if($max <= $lmt2);