File Coverage

blib/lib/Gnuplot/Builder/Dataset.pm

Criterion	Covered	Total	%
statement	114	119	95.8
branch	16	18	88.8
condition	1	3	33.3
subroutine	32	32	100.0
pod	19	21	90.4
total	182	193	94.3

package Gnuplot::Builder::Dataset;
use strict;
use warnings;
use Gnuplot::Builder::PrototypedData;
use Scalar::Util qw(weaken blessed);
use Carp;
use overload '""' => 'to_string';

sub new {
    my ($class, $source, @set_option_args) = @_;
    my $self = bless {
        pdata => undef,
        pdata_join => undef,  ## deprecated. should be removed in the future.
        parent => undef,
    }, $class;
    $self->_init_pdata();
    if(defined $source) {
        $self->set_source($source);
    }
    if(@set_option_args) {
        $self->set_option(@set_option_args);
    }
    return $self;
}

sub new_file {
    my ($class, $filename, @set_option_args) = @_;
    return $class->new->set_file($filename)->set_option(@set_option_args);
}

sub new_data {
    my ($class, $data_provider, @set_option_args) = @_;
    return $class->new->set_file('-')->set_data($data_provider)->set_option(@set_option_args);
}

sub _init_pdata {
    my ($self) = @_;
    weaken $self;
    $self->{pdata} = Gnuplot::Builder::PrototypedData->new(
        entry_evaluator => sub {
            my ($key, $coderef) = @_;
            return $coderef->($self, $key);
        },
        attribute_evaluator => { source => sub {
            my ($key, $coderef) = @_;
            return $coderef->($self);
        } },
    );
    $self->{pdata_join} = Gnuplot::Builder::PrototypedData->new();
}

sub to_string {
    my ($self) = @_;
    my @words = ();
    push @words, $self->get_source;
    $self->{pdata}->each_resolved_entry(sub {
        my ($name, $values_arrayref) = @_;
        my @values = grep { defined($_) } @$values_arrayref;
        return if !@values;
        my $join = $self->{pdata_join}->get_resolved_attribute($name);
        if(defined $join) {
            push @words, $name, join($join, @values);
        }else {
            push @words, $name, @values;
        }
    });
    return join " ", grep { defined($_) && "$_" ne "" } @words;
}

*params_string = *to_string;

sub set_source {
    my ($self, $source) = @_;
    $self->{pdata}->set_attribute(
        key => "source", value => $source
    );
    return $self;
}

sub setq_source {
    my ($self, $source) = @_;
    $self->{pdata}->set_attribute(
        key => "source", value => $source, quote => 1,
    );
    return $self;
}

*set_file = *setq_source;

sub get_source {
    my ($self) = @_;
    return $self->{pdata}->get_resolved_attribute("source");
}

sub delete_source {
    my ($self) = @_;
    $self->{pdata}->delete_attribute("source");
    return $self;
}

sub set_option {
    my ($self, @options) = @_;
    $self->{pdata}->set_entry(
        entries => \@options,
        quote => 0,
    );
    return $self;
}

*set = *set_option;

sub setq_option {
    my ($self, @options) = @_;
    $self->{pdata}->set_entry(
        entries => \@options,
        quote => 1,
    );
    return $self;
}

*setq = *setq_option;

sub unset {
    my ($self, @opt_names) = @_;
    return $self->set_option(map {$_ => undef} @opt_names);
}

sub get_option {
    my ($self, $name) = @_;
    return $self->{pdata}->get_resolved_entry($name);
}

sub delete_option {
    my ($self, @names) = @_;
    foreach my $name (@names) {
        $self->{pdata}->delete_entry($name);
    }
    return $self;
}

sub set_parent {
    my ($self, $parent) = @_;
    if(!defined($parent)) {
        $self->{parent} = undef;
        $self->{pdata}->set_parent(undef);
        $self->{pdata_join}->set_parent(undef);
        return $self;
    }
    if(!blessed($parent) || !$parent->isa("Gnuplot::Builder::Dataset")) {
        croak "parent must be a Gnuplot::Builder::Dataset";
    }
    $self->{parent} = $parent;
    $self->{pdata}->set_parent($parent->{pdata});
    $self->{pdata_join}->set_parent($parent->{pdata_join});
    return $self;
}

sub get_parent { return $_[0]->{parent} }

*parent = *get_parent;

sub new_child {
    my ($self) = @_;
    return Gnuplot::Builder::Dataset->new->set_parent($self);
}

sub set_data {
    my ($self, $data_provider) = @_;
    $self->{pdata}->set_attribute(
        key => "data", value => $data_provider
    );
    return $self;
}

sub write_data_to {
    my ($self, $writer) = @_;
    my $data_provider = $self->{pdata}->get_resolved_attribute("data");
    return $self if not defined $data_provider;
    if(ref($data_provider) eq "CODE") {
        $data_provider->($self, $writer);
    }else {
        $writer->($data_provider);
    }
    return $self;
}

sub delete_data {
    my ($self) = @_;
    $self->{pdata}->delete_attribute("data");
    return $self;
}

sub _deprecated {
    my ($msg) = @_;
    my $method = (caller(1))[3];
    carp "$method is deprecated. $msg";
}

sub set_join {
    my ($self, %joins) = @_;
    _deprecated("Use Gnuplot::Builder::JoinDict.");
    foreach my $name (keys %joins) {
        $self->{pdata_join}->set_attribute(
            key => $name, value => $joins{$name}, quote => 0
        );
    }
    return $self;
}

sub delete_join {
    my ($self, @names) = @_;
    _deprecated("Use Gnuplot::Builder::JoinDict.");
    foreach my $name (@names) {
        $self->{pdata_join}->delete_attribute($name);
    }
    return $self;
}

1;

__END__