Visualize::Graph::DensityCell

フックするのはPublishフェーズなんだけどPublishて感じでもないので勝手名前空間にしてみた.濃度が知りたかったから適当にDensityCellとかしたけどこういうグラフの正式名称知らないだけであるかもしれない.
ImagerはいざとなったらCで書けるのでプロトタイプをPerlで書いといて重かったらInline::CなりXSなりで書き直したりしやすそうな感触を受けました.GD::*は触ったこと無いのでGD::*と比べてどうなのかは今のところわからないけど.
もう少しconfパラメタチェックしたほうがいいか.

package Plagger::Plugin::Visualize::Graph::DensityCell;
use strict;
use base qw( Plagger::Plugin );
use Imager;
use File::Spec;

sub register {
    my ($self, $context) = @_;
    $context->register_hook(
                            $self,
                            'publish.entry.fixup' => \&fixup_entry,
                            'publish.finalize' => \&finalize,
                            );
}

sub fixup_entry {
    my ($self, $context, $args) = @_;

    my ($x, $y) = map {
        my $result = eval $self->conf->{vector}->{$_}->{value};
        if ( $@ ) {
            $context->log( error => "vector Error: $@ with　$self->conf->{vector}->{$_}->{value}" );
        }
        $result;
    } @{['x', 'y']};
    $context->log( debug => "x:$x, y:$y" );
        
    $self->{density}->[$y]->[$x] = ($self->{density}->[$y]->[$x])
        ? $self->{density}->[$y]->[$x] + 1 : 1;
}

sub finalize {
    my ($self, $context, $args) = @_;

    my ($x_sort, $y_sort) = map {
        my $sort = eval $self->conf->{vector}->{$_}->{sort};
        if ( $@ ) {
            $context->log( error => "sort Error: $@ with $self->conf->{vector}->{$_}->{sort}" );
        }
        $sort;
    } @{['x','y']};
    $context->log( debug => "x_sort: $#{$x_sort}, y_sort: $#{$y_sort}" );

    my $x_last = $#{$x_sort} + 1;
    my $y_last = $#{$y_sort} + 1;
    my $loop = sub {
        my $process = shift;
        for my $y ( @{$y_sort} ) {
            for my $x ( @{$x_sort} ) {
                $process->( $x, $y );
            }
        }
        };
        
    my $max = 1;
    $loop->( sub {
        my ($x, $y) = @_;
        if ( $max < $self->{density}->[$y]->[$x] ) {
            $max = $self->{density}->[$y]->[$x];
        }
    } );

    my $width = $self->conf->{cell}->{size};
    my $height = $width;
    my $image = Imager->new( xsize => $width  * $x_last,
                             ysize => $height * $y_last,
                             );
    my $color = Imager::Color->new( 0, 0, 255 );

    $loop->( sub {
        my ($x, $y) = @_;
        my $z = $self->{density}->[$y]->[$x] or 1;
        my $level = $z / $max;
        my $color_max = $self->conf->{cell}->{color}->{max};
        my $color_min = $self->conf->{cell}->{color}->{min};
        $color->set( abs($color_max->{r} - $color_min->{r}) * $level,
                     abs($color_max->{g} - $color_min->{g}) * $level,
                     abs($color_max->{b} - $color_min->{b}) * $level );

        my ($px,$py) = ($x - $x_sort->[0], $y - $y_sort->[0]);
        $image->box( color => $color,
                     xmin => $px * $width,
                     ymin => $py * $height,
                     xmax => ($px + 1) * $width,
                     ymax => ($py + 1) * $height,
                     filled => 1
                     );
        $context->log( debug => "x:$x, y:$y, z:$z" ) if ($z);
    } );

    my $dir = $self->conf->{dir};
    unless (-e $dir && -d _) {
        $context->log(info => "mkdir $dir");
        mkdir $dir, 0777;
    }
    my $file_name = $self->conf->{title} || 'density_cell';
    my $path = File::Spec->catfile( $dir, "$file_name.png" );
    $image->write( file => $path )
        or die "can\'t write image file. errstr:$image->errstr";

    $context->log( info => "write image file to: $path" );
}

1;