The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl
use strict;
use warnings;
 
use GD::Graph;
use GD::Graph::linespoints;
use Module::CPANTS::Schema;
use Module::CPANTS::Kwalitee;
use Module::CPANTS::ProcessCPAN;
use File::Spec::Functions;

my $home=Module::CPANTS::ProcessCPAN::ConfigData->config('home');
my $outpath=shift(@ARGV) || catdir($home,'root','static','graphs');

my $mck=Module::CPANTS::Kwalitee->new;
my $max_y=int(($mck->total_kwalitee / $mck->available_kwalitee)*100);

my $mcp=bless {},'Module::CPANTS::ProcessCPAN';
my $db=$mcp->db;

my @runs=$db->resultset('Run')->search({},
    {
        order_by=>'date desc',
        rows=>1,
    }
);
my $run=$runs[0];
my $dists=$db->resultset('HistoryDist')->search({run=>$run->id});

print "making distgraphs\n";
while (my $dist=$dists->next) {
    make_distgraph($dist);
}

print "making authorgraphs\n";
my $authors=$db->resultset('Author')->search({
    'dists.run'=>$run->id
    }, {
        join=>'dists',
        prefetch=>'dists',
    });
while (my $author=$authors->next) {
    make_authorgraph($author);
}


sub make_distgraph {
    my ($dist)=@_;   
    
    my $results=$db->resultset('HistoryDist')->search(distname=>$dist->distname);
    
    my $graph=GD::Graph::linespoints->new(800,300);
    $graph->set(
        x_label=>'CPANTS Run (Release of Dist)',
		'y_label'=>'Kwalitee',
		title=>"Kwalitee History for ".$dist->distname,
		'y_max_value'=>$max_y,
        y_min_value=>0,
        x_labels_vertical=>1,
        show_values=>1,
        values_vertical=>1,
        values_space=>-35,
    );
    
    my @date; my @kw;
    while (my $set=$results->next) {
        my $date=$set->run ? $set->run->date : '?';
        push(@date,"$date (".($set->version || '?').")");
        push(@kw,sprintf("%.2f",$set->kwalitee));
    }
    my $gd=$graph->plot([\@date,\@kw]) || die $graph->error;
    open(IMG, ">",catfile($outpath,$dist->distname.".png")) or die $!;
    binmode IMG;
    print IMG $gd->png;
    return;
}

sub make_authorgraph {
    my $author=shift;
    my $results=$db->resultset('HistoryAuthor')->search(author=>$author->id);

    my @date; my @kw; my @dists;
    my $max_dists=0;
    my %seen;   # hack - there seems to be bad data in the DB
    while (my $set=$results->next) {
        next if $seen{$set->run->id}++;
        my $date=substr($set->run->date,0,10) || '?';
        push(@date,$date);
        push(@kw,$set->average_kwalitee);
        my $num_dists=$set->num_dists;
        push(@dists,$num_dists);
        $max_dists=$num_dists if $num_dists>$max_dists; 
    }
    
    print_graph('dists','Number of Dists',$author,\@date,\@dists,$max_dists+1+(int $max_dists*0.1));
    print_graph('kw','Average Kwalitte',$author,\@date,\@kw,$max_y);
}


sub print_graph {
    my ($file,$label,$author,$dates,$data,$max)=@_;
    my $graph=GD::Graph::linespoints->new(800,250);
    $graph->set(
        x_label=>'CPANTS Run',
        title=>$label.' '.$author->pauseid,
        'y_max_value'=>$max,
        'y_min_value'=>0,
        x_labels_vertical=>1,
        values_vertical=>1,
        show_values=>1,
        values_space=>7,
    );

    my $gd=$graph->plot([$dates,$data]) || die $graph->error;
    open(IMG, ">",catfile($outpath,$author->pauseid.'_'.$file.".png")) or die $!;
    binmode IMG;
    print IMG $gd->png;
     
}