#!/usr/bin/perl
use strict;
use warnings;
use File::Spec::Functions;
use GD::Graph;
use GD::Graph::bars;
use Module::CPANTS::ProcessCPAN;
use Module::CPANTS::Kwalitee;
use Module::CPANTS::Schema;
use Module::CPANTS::ProcessCPAN::ConfigData;
my $home=Module::CPANTS::ProcessCPAN::ConfigData->config('home');
my $outpath=shift(@ARGV) || catdir($home,'root','static');
my $mcp=bless {},'Module::CPANTS::ProcessCPAN';
my $DBH=$mcp->db->storage->dbh;
my $now=localtime();
my @bar_defaults=(
bar_spacing => 8,
# shadow_depth => 4,
# shadowclr => 'dred',
transparent => 0,
show_values=>1,
);
# make kwalitee overview
{
my @ok;
my @fail;
my @lable;
my $mck=Module::CPANTS::Kwalitee->new;
my @metrics=$mck->get_indicators;
my $total_dists=$DBH->selectrow_array("select count(*) from kwalitee");
foreach (sort {$a->{name} cmp $b->{name}} @metrics) {
my $m=$_->{name};
my $ok=$DBH->selectrow_array("select count(*) from kwalitee where $m=1 group by $m") || 0;
push(@ok,$ok);
push(@fail,$total_dists-$ok);
push(@lable,$m);
}
my $graph=GD::Graph::bars->new(600,600);
$graph->set(
cumulate=>1,
x_label=>'metric',
'y_label'=>'dists',
title=>"Kwalitee Overview ($now)",
x_labels_vertical=>1,
'y_max_value'=>$total_dists,
dclrs=>[qw(green red)],
);
my $gd=$graph->plot([\@lable,\@ok,\@fail]) || die $graph->error;
my $outfile=catfile($outpath,"kwalitee_overview.png");
open(IMG, ">",$outfile) or die "$outfile: $!";
binmode IMG;
print IMG $gd->png;
}
foreach (
{
title=>'Kwalitee Distribution',
sql=>'select abs_kw,count(abs_kw) as cnt from kwalitee group by abs_kw order by abs_kw',
lablex=>'Kwalitee',
labley=>'Distributions',
width=>800,
},
{
title=>'Active PAUSE IDs',
sql=>[
q{select 'active',count(*) from author where num_dists>0},
q{select 'inactive',count(*) from author where num_dists=0},
],
lablex=>'Status',
labley=>'Authors',
},
{
title=>'Dists per Author',
sql=>'select num_dists,count(num_dists) as cnt from author where num_dists > 0 group by num_dists order by num_dists',
lablex=>'Dists',
labley=>'Authors',
width=>800,
bar_spacing => 2,
},
{
title=>'Dists released per year',
sql=>'select extract(year from released) as year,count(*) from dist group by year order by year',
lablex=>'Year',
labley=>'Dists',
},
) {
make_graph($_);
}
sub make_graph {
my $c=shift;
my $title=$c->{title};
my $filename=lc($title);
$filename=~s/ /_/g;
$filename=~s/\W//g;
$filename.=".png";
my (@x,@y);
my $maxy=0;
if (ref($c->{sql}) eq 'ARRAY') {
foreach my $sql (@{$c->{sql}}) {
my $sth=$DBH->prepare($sql);
$sth->execute;
while (my @r=$sth->fetchrow_array) {
my $x=shift(@r) || '';
push(@x,$x);
my $y=shift(@r);
push(@y,$y);
$maxy=$y if $y>$maxy;
}
$maxy=int($maxy*1.05);
}
} else {
my $sth=$DBH->prepare($c->{sql});
$sth->execute;
while (my @r=$sth->fetchrow_array) {
my $x=shift(@r) || '';
push(@x,$x);
my $y=shift(@r);
push(@y,$y);
$maxy=$y if $y>$maxy;
}
$maxy=int($maxy*1.05);
}
my $graph=GD::Graph::bars->new($c->{width} || 400,400);
$graph->set(
x_label=>$c->{lablex},
'y_label'=>$c->{labley},
title=>$title." ($now)",
'y_max_value'=>$maxy,
@bar_defaults,
);
my $gd=$graph->plot([\@x,\@y]);
return unless $gd;
my $outfile=catfile($outpath,$filename);
open(IMG, ">",$outfile) or die "$outfile: $!";
binmode IMG;
print IMG $gd->png;
return;
}
__END__