view release on metacpan or  search on metacpan

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

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;