File Coverage

blib/lib/Gnuplot/Builder/JoinDict.pm

Criterion	Covered	Total	%
statement	66	66	100.0
branch	16	20	80.0
condition	4	6	66.6
subroutine	19	19	100.0
pod	11	11	100.0
total	116	122	95.0

package Gnuplot::Builder::JoinDict;
use strict;
use warnings;
use Gnuplot::Builder::PartiallyKeyedList;
use Carp;
use Exporter 5.57 qw(import);
use overload '""' => "to_string";

our @EXPORT_OK = qw(joind);

sub new {
    my ($class, %args) = @_;
    my $self = bless {
        separator => defined($args{separator}) ? $args{separator} : "",
        pkl => Gnuplot::Builder::PartiallyKeyedList->new,
        filter => $args{filter},
        validator => $args{validator},
    }, $class;
    croak "filter must be a code-ref" if defined($self->{filter}) && ref($self->{filter}) ne "CODE";
    croak "validator must be a code-ref" if defined($self->{validator}) && ref($self->{validator}) ne "CODE";
    my $content = $args{content};
    $content = [] if not defined $content;
    croak "content must be an array-ref" if ref($content) ne "ARRAY";
    $self->_set_destructive(@$content);
    return $self;
}

sub joind {
    my ($separator, @content) = @_;
    return __PACKAGE__->new(
        separator => $separator,
        content => \@content
    );
}

sub get_all_keys {
    return $_[0]->{pkl}->get_all_keys;
}

sub get_all_values {
    return $_[0]->{pkl}->get_all_values
}

sub to_string {
    my ($self) = @_;
    my @vals = defined($self->{filter})
        ? $self->{filter}->($self)
        : $self->{pkl}->get_all_values;
    return join($self->{separator}, grep { defined($_) } @vals);
}

sub get {
    my ($self, $key) = @_;
    return undef if not defined $key;
    return $self->{pkl}->get($key);
}

sub set {
    my ($self, @content) = @_;
    return $self->clone->_set_destructive(@content);
}

sub set_all {
    my ($self, $value) = @_;
    return $self->set(map { $_ => $value } $self->{pkl}->get_all_keys);
}

sub _validate {
    my ($self) = @_;
    $self->{validator}->($self) if defined $self->{validator};
}

sub _set_destructive {
    my ($self, @content) = @_;
    croak "odd number of elements in content" if @content % 2 != 0;
    foreach my $i (0 .. (@content / 2 - 1)) {
        my ($key, $value) = @content[2*$i, 2*$i+1];
        croak "undefined key in content" if not defined $key;
        $self->{pkl}->set($key, $value);
    }
    $self->_validate();
    return $self;
}

sub clone {
    my ($self) = @_;
    my $clone = ref($self)->new(separator => $self->{separator}, filter => $self->{filter});
    $clone->{pkl}->merge($self->{pkl});
    $clone->{validator} = $self->{validator};
    return $clone;
}

sub delete {
    my ($self, @keys) = @_;
    my $clone = $self->clone;
    $clone->{pkl}->delete($_) foreach grep { defined($_) } @keys;
    $clone->_validate();
    return $clone;
}

sub separator {
    my ($self) = @_;
    return $self->{separator};
}

1;
__END__