File Coverage

blib/lib/Gnuplot/Builder/JoinDict.pm
Criterion Covered Total %
statement 66 69 95.6
branch 16 20 80.0
condition 4 6 66.6
subroutine 19 20 95.0
pod 11 12 91.6
total 116 127 91.3


line stmt bran cond sub pod time code
1             package Gnuplot::Builder::JoinDict;
2 17     17   1193325 use strict;
  17         36  
  17         642  
3 17     17   79 use warnings;
  17         86  
  17         1026  
4 17     17   5399 use Gnuplot::Builder::PartiallyKeyedList;
  17         44  
  17         599  
5 17     17   114 use Carp;
  17         35  
  17         1417  
6 17     17   107 use Exporter 5.57 qw(import);
  17         466  
  17         686  
7 17     17   6941 use overload '""' => "to_string";
  17         22162  
  17         113  
8              
9             our @EXPORT_OK = qw(joind);
10              
11             sub new {
12 197     197 1 1861583 my ($class, %args) = @_;
13             my $self = bless {
14             separator => defined($args{separator}) ? $args{separator} : "",
15             pkl => Gnuplot::Builder::PartiallyKeyedList->new,
16             filter => $args{filter},
17             validator => $args{validator},
18 197 100       1012 }, $class;
19 197 50 66     1255 croak "filter must be a code-ref" if defined($self->{filter}) && ref($self->{filter}) ne "CODE";
20 197 50 66     537 croak "validator must be a code-ref" if defined($self->{validator}) && ref($self->{validator}) ne "CODE";
21 197         321 my $content = $args{content};
22 197 100       420 $content = [] if not defined $content;
23 197 50       2037 croak "content must be an array-ref" if ref($content) ne "ARRAY";
24 197         617 $self->_set_destructive(@$content);
25 194         531 return $self;
26             }
27              
28             sub joind {
29 2     2 1 249990 my ($separator, @content) = @_;
30 2         17 return __PACKAGE__->new(
31             separator => $separator,
32             content => \@content
33             );
34             }
35              
36             sub get_all_keys {
37 153     153 1 14281 return $_[0]->{pkl}->get_all_keys;
38             }
39              
40             sub get_all_values {
41             return $_[0]->{pkl}->get_all_values
42 52     52 1 244 }
43              
44             sub to_string {
45 240     240 1 19417 my ($self) = @_;
46             my @vals = defined($self->{filter})
47             ? $self->{filter}->($self)
48 240 100       936 : $self->{pkl}->get_all_values;
49 239         1436 return join($self->{separator}, grep { defined($_) } @vals);
  4396         6918  
50             }
51              
52             sub get {
53 22     22 1 2477 my ($self, $key) = @_;
54 22 50       65 return undef if not defined $key;
55 22         100 return $self->{pkl}->get($key);
56             }
57              
58             sub set {
59 143     143 1 13729 my ($self, @content) = @_;
60 143         361 return $self->clone->_set_destructive(@content);
61             }
62              
63             sub set_all {
64 6     6 1 6829 my ($self, $value) = @_;
65 6         33 return $self->set(map { $_ => $value } $self->{pkl}->get_all_keys);
  13         45  
66             }
67              
68             sub _validate {
69 344     344   542 my ($self) = @_;
70 344 100       985 $self->{validator}->($self) if defined $self->{validator};
71             }
72              
73             sub _set_destructive {
74 340     340   866 my ($self, @content) = @_;
75 340 100       1174 croak "odd number of elements in content" if @content % 2 != 0;
76 338         1070 foreach my $i (0 .. (@content / 2 - 1)) {
77 703         1367 my ($key, $value) = @content[2*$i, 2*$i+1];
78 703 100       1244 croak "undefined key in content" if not defined $key;
79 701         1320 $self->{pkl}->set($key, $value);
80             }
81 336         892 $self->_validate();
82 331         1372 return $self;
83             }
84              
85             sub clone {
86 154     154 1 4553 my ($self) = @_;
87 154         705 my $clone = ref($self)->new(separator => $self->{separator}, filter => $self->{filter});
88 154         570 $clone->{pkl}->merge($self->{pkl});
89 154         844 $clone->{validator} = $self->{validator};
90 154         422 return $clone;
91             }
92              
93             sub delete {
94 8     8 1 7176 my ($self, @keys) = @_;
95 8         27 my $clone = $self->clone;
96 8         21 $clone->{pkl}->delete($_) foreach grep { defined($_) } @keys;
  11         49  
97 8         24 $clone->_validate();
98 8         27 return $clone;
99             }
100              
101             sub separator {
102 14     14 1 7905 my ($self) = @_;
103 14         73 return $self->{separator};
104             }
105              
106             sub Lens {
107 0     0 0   my ($self, $key) = @_;
108 0           require Gnuplot::Builder::Lens;
109 0           return Gnuplot::Builder::Lens->new(
110             "get", "set", $key
111             );
112             }
113              
114             1;
115             __END__