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   196037 use strict;
  17         38  
  17         432  
3 17     17   84 use warnings;
  17         28  
  17         427  
4 17     17   5516 use Gnuplot::Builder::PartiallyKeyedList;
  17         46  
  17         424  
5 17     17   91 use Carp;
  17         32  
  17         1093  
6 17     17   82 use Exporter 5.57 qw(import);
  17         338  
  17         580  
7 17     17   15463 use overload '""' => "to_string";
  17         11162  
  17         184  
8              
9             our @EXPORT_OK = qw(joind);
10              
11             sub new {
12 197     197 1 14541 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       948 }, $class;
19 197 50 66     1244 croak "filter must be a code-ref" if defined($self->{filter}) && ref($self->{filter}) ne "CODE";
20 197 50 66     595 croak "validator must be a code-ref" if defined($self->{validator}) && ref($self->{validator}) ne "CODE";
21 197         283 my $content = $args{content};
22 197 100       485 $content = [] if not defined $content;
23 197 50       506 croak "content must be an array-ref" if ref($content) ne "ARRAY";
24 197         460 $self->_set_destructive(@$content);
25 194         501 return $self;
26             }
27              
28             sub joind {
29 2     2 1 399 my ($separator, @content) = @_;
30 2         13 return __PACKAGE__->new(
31             separator => $separator,
32             content => \@content
33             );
34             }
35              
36             sub get_all_keys {
37 153     153 1 6882 return $_[0]->{pkl}->get_all_keys;
38             }
39              
40             sub get_all_values {
41             return $_[0]->{pkl}->get_all_values
42 52     52 1 181 }
43              
44             sub to_string {
45 240     240 1 10591 my ($self) = @_;
46             my @vals = defined($self->{filter})
47             ? $self->{filter}->($self)
48 240 100       957 : $self->{pkl}->get_all_values;
49 239         1216 return join($self->{separator}, grep { defined($_) } @vals);
  4396         7821  
50             }
51              
52             sub get {
53 22     22 1 1681 my ($self, $key) = @_;
54 22 50       64 return undef if not defined $key;
55 22         79 return $self->{pkl}->get($key);
56             }
57              
58             sub set {
59 143     143 1 7306 my ($self, @content) = @_;
60 143         333 return $self->clone->_set_destructive(@content);
61             }
62              
63             sub set_all {
64 6     6 1 5224 my ($self, $value) = @_;
65 6         25 return $self->set(map { $_ => $value } $self->{pkl}->get_all_keys);
  13         36  
66             }
67              
68             sub _validate {
69 344     344   558 my ($self) = @_;
70 344 100       1106 $self->{validator}->($self) if defined $self->{validator};
71             }
72              
73             sub _set_destructive {
74 340     340   770 my ($self, @content) = @_;
75 340 100       1131 croak "odd number of elements in content" if @content % 2 != 0;
76 338         963 foreach my $i (0 .. (@content / 2 - 1)) {
77 703         1506 my ($key, $value) = @content[2*$i, 2*$i+1];
78 703 100       1556 croak "undefined key in content" if not defined $key;
79 701         1958 $self->{pkl}->set($key, $value);
80             }
81 336         689 $self->_validate();
82 331         1003 return $self;
83             }
84              
85             sub clone {
86 154     154 1 3230 my ($self) = @_;
87 154         610 my $clone = ref($self)->new(separator => $self->{separator}, filter => $self->{filter});
88 154         538 $clone->{pkl}->merge($self->{pkl});
89 154         652 $clone->{validator} = $self->{validator};
90 154         398 return $clone;
91             }
92              
93             sub delete {
94 8     8 1 4314 my ($self, @keys) = @_;
95 8         22 my $clone = $self->clone;
96 8         19 $clone->{pkl}->delete($_) foreach grep { defined($_) } @keys;
  11         54  
97 8         20 $clone->_validate();
98 8         22 return $clone;
99             }
100              
101             sub separator {
102 14     14 1 5850 my ($self) = @_;
103 14         66 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__