#!/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; }