File Coverage

blib/lib/VS/Chart.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

package VS::Chart;

use strict;
use warnings;

use Cairo;
use Carp qw(croak);
use Scalar::Util qw(refaddr);

use VS::Chart::Dataset;
use VS::Chart::RowIterator;

our $VERSION = "0.08";

my %Datasets;
my %NextRow;
my %MaxCache;
my %MinCache;
my %SpanCache;

sub _clear_cache {
    my $self = shift;
    my $id = refaddr $self;

    delete $MaxCache{$id};
    delete $MinCache{$id};
    delete $SpanCache{$id};

    1;
}

sub new {
    my ($pkg, %attrs) = @_;

    my $defaults = 1 - (delete $attrs{no_defaults} || 0);

    my $self = bless {
        _defaults => $defaults,
        %attrs,
    }, $pkg;

    $Datasets{refaddr $self} = [];
    $NextRow{refaddr $self} = 0;

    return $self;
}

sub has {
    my ($self, $key) = @_;
    return exists $self->{$key};
}

sub get {
    my ($self, $key) = @_;
    return $self->{$key};
}

sub set {
    my ($self, %attrs) = @_;

    while (my ($key, $value) = each %attrs) {
        if ($key eq 'min') {
            $self->_clear_cache;
            my $min = $self->_min;
            $self->{_min} = $value if $value < $min;
            next;
        }
        elsif ($key eq 'max') {
            $self->_clear_cache;
            my $max = $self->_max;
            $self->{_max} = $value if $value > $max;
            next;
        }
        elsif ($key eq 'y_grid_steps') {
            $value = 1 if $value < 1;
            $value = 10 if $value > 10;
        }

        if ($key =~ /^(\d+)\s*:\s*(.*)$/) {
            my $id = $1;
            $key = $2;
            my $ds = $self->_dataset($id);
            if (defined $ds) {
                $ds->set($key => $value);
            }
        }
        else {
            $self->{$key} = $value;
        }
    }
}

sub dataset {
    my ($self, $id) = @_;
    return $self->_dataset($id, 0);
}

sub _dataset {
    my ($self, $idx, $create) = @_;
    my $ptr = refaddr $self;
    return $Datasets{$ptr}->[$idx] if defined $Datasets{$ptr}->[$idx];
    return undef if !$create;

    $Datasets{$ptr}->[$idx] = VS::Chart::Dataset->new();

    return $self->_dataset($idx);
}

sub _datasets {
    my ($self) = @_;
    return $Datasets{refaddr $self};
};

sub rows {
    my ($self) = @_;

    return $NextRow{refaddr $self};
}

sub add {
    my ($self, @data) = @_;

    my $id = refaddr $self;

    delete $self->{_max};
    delete $self->{_min};

    $self->_clear_cache;

    my $row = $self->rows;

    if (ref $data[0]) {
        $self->set(x_column => 1);
    }

    for (my $ds = 0; $ds < @data; $ds++) {
        my $dataset = $self->_dataset($ds, 1);
        $dataset->insert($row, $data[$ds]);
    }

    $NextRow{$id}++;

    1;
}

sub _max {
    my ($self) = @_;

    return $self->{_max} if exists $self->{_max};

    my $id = refaddr $self;
    return $MaxCache{$id} if exists $MaxCache{$id};

    my $datasets = $self->_datasets;
    return 0 unless @$datasets;

    my $x_column = $self->get("x_column") || 0;

    my $max = $datasets->[$x_column]->max;
    for (($x_column + 1)..@$datasets - 1) {
        my $ds_max = $datasets->[$_]->max;
        next if !defined $ds_max;
        $max = $ds_max if $ds_max > $max;
    }

    $MaxCache{$id} = $max;

    return $max;
}

sub _min {
    my ($self) = @_;

    return $self->{_min} if exists $self->{_min};

    my $id = refaddr $self;
    return $MinCache{$id} if exists $MinCache{$id};

    my $datasets = $self->_datasets;
    return 0 unless @$datasets;

    my $x_column = $self->get("x_column") || 0;
    my $min = $datasets->[$x_column]->min;
    for (($x_column + 1)..@$datasets - 1) {
        my $ds_min = $datasets->[$_]->min;
        next if !defined $ds_min;
        $min = $ds_min if $ds_min < $min;
    }

    $MinCache{$id} = $min;

    return $min;
}

sub _span {
    my ($self) = @_;

    my $id = refaddr $self;
    return $SpanCache{$id} if exists $SpanCache{$id};

    my $span = $self->_max - $self->_min;
    $SpanCache{$id} = $span;

    return $span;
}

sub _row_iterator {
    my ($self) = @_;
    my $x_column = $self->get("x_column") || 0;
    if ($x_column) {
        return VS::Chart::RowIterator->new($self->_dataset(0)->data);
    }
    return VS::Chart::RowIterator->new([1..$self->rows]);
}

sub _offset {
    my ($self, $value) = @_;

    if ($value < $self->_min || $value > $self->_max) {
        croak "Value '${value}' is outside value range (", $self->_min, ", ", $self->_max, ")";
    }

    return ($value - $self->_min) / $self->_span;
}

sub _offsets {
    my ($self, @values) = @_;

    my $min = $self->_min;
    my $span = $self->_span;

    for (@values) {
        $_ = ($_ - $min) / $self->_span;
    }

    return @values;
}

{
    use Module::Pluggable
        search_path => [qw(VS::Chart::Renderer)],
        require     => 1,
        sub_name    => 'renderers',
        inner       => 0;

    my %Renderer;
    BEGIN {
        for (__PACKAGE__->renderers) {
            if ($_->can("type")) {
                my $type = lc($_->type);
                $Renderer{$type} = $_;
            }
        }
    }

    sub supported_types {
        return sort keys %Renderer;
    }

    my %Create = (
        'png' => sub {
            my $self = shift;
            return Cairo::ImageSurface->create("argb32", $self->get("width"), $self->get("height"));
        },
        'svg' => sub {
            my ($self, $path) = @_;
            return Cairo::SvgSurface->create($path, $self->get("width"), $self->get("height"));
        },
        'pdf' => sub {
            my ($self, $path) = @_;
            return Cairo::PdfSurface->create($path, $self->get("width"), $self->get("height"));
        },
    );

    my %Save = (
        'png' => sub {
            my ($surface, $target) = @_;

            if (ref $target eq "CODE") {
                $surface->write_to_png_stream($target)
            }
            else {
                $surface->write_to_png($target);
            }
        },
        'svg' => sub {
        },
        'pdf' => sub {
        },
    );

    sub render {
        my ($self, %args) = @_;

        croak "Missing argument 'type'" if !exists $args{type};
        my $type = $args{type};
        croak "Unsupported chart type: $type" if !exists $Renderer{$type};

        croak "Missing argument 'to'" if !exists $args{to};
        my $to = $args{to};

        my $as;
        if (exists $args{as}) {
            $as = $args{as};
        }
        else {
            ($as) = $to =~ /\.(\w+)$/;
            $as = lc $as;
        }

        croak "Unsupported output: $as" if !exists $Create{$as};

        local $self->{width} = 640 unless $self->{width};
        local $self->{height} = 480 unless $self->{height};
        local $self->{width} = $args{width} if $args{width};
        local $self->{height} = $args{height} if $args{height};

        my $renderer        = $Renderer{$type}->new;
        my @default_keys    = $renderer->set_defaults($self);

        my $surface = $Create{$as}->($self, $to);
        $renderer->render($self, $surface);
        $Save{$as}->($surface, $to);
    }
}

1;
__END__