Smoke output to colored graphs

colored-smoke.pl

use 5.014;
use warnings;
use JSON qw/decode_json/;
use Date::Simple qw/date today/;;
use autodie;
use GD;

my $report_date = date('2013-05-06');
my $date = $report_date;

my $days_to_show = 7;
my $rect_size    = 15;

sub filename {
    my $d = shift;
    $d =~ s/-//g;
    return "results-$d.json";
}

my $days_shown = 0;

my %projects;

while ($days_shown < $days_to_show) {
    my $fn = filename($date);
    last unless -e $fn;
    open my $IN, '<:encoding(UTF-8)', $fn;
    my $raw_json = do { local $/; <$IN> };
    close $IN;
    my %smoke = %{ decode_json($raw_json) };
    while (my ($project, $result) = each %smoke) {
        $projects{$project}{$date} = $result;
    }
    say "read $fn";
}
continue {
    $days_shown++; $date--
};

for my $project (keys %projects) {
    write_smoke($project, $projects{$project});
}

sub write_smoke {
    my ($name, $result_by_date) = @_;
    my $image = GD::Image->new($days_to_show * $rect_size, $rect_size);
    $image->setThickness(2);
    $image->colorAllocate(255, 255, 255); # magically sets the background color
    my %color = (
        ok      => $image->colorAllocate(0,   255, 0),
        black   => $image->colorAllocate(0,     0, 0),
        test    => $image->colorAllocate(255,   0, 0),
        build   => $image->colorAllocate(122,   0, 0),
        prereq  => $image->colorAllocate(255, 255, 0),
    );
    for my $delta (1 .. $days_to_show) {
        my $date = $report_date - ($delta - 1);
        say "$name - $delta - $date";
        my $x1 = $rect_size * ($days_to_show - $delta);
        my $x2 = $rect_size * ($days_to_show - $delta + 1);
        my $res  = $result_by_date->{$date};
        if ($res) {
            my $failed = 0;
            for my $state (qw(prereq build test)) {
                unless ($res->{$state}) {
                    $image->filledRectangle($x1, 0, $x2, $rect_size, $color{$state});
                    $failed = 1;
                    last;
                }
            }
            unless ($failed) {
                $image->filledRectangle($x1, 0, $x2, $rect_size, $color{ok});
            }
        }
        $image->line($x2, 0, $x2, $rect_size, $color{black});
    }
    open my $OUT, '>:raw', "$name.png";
    binmode $OUT;
    print $OUT $image->png;
    close $OUT;
}