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   687265 use strict;
  17         31  
  17         488  
3 17     17   59 use warnings;
  17         26  
  17         679  
4 17     17   3676 use Gnuplot::Builder::PartiallyKeyedList;
  17         29  
  17         391  
5 17     17   66 use Carp;
  17         23  
  17         1052  
6 17     17   78 use Exporter 5.57 qw(import);
  17         304  
  17         559  
7 17     17   6374 use overload '""' => "to_string";
  17         13582  
  17         136  
8              
9             our @EXPORT_OK = qw(joind);
10              
11             sub new {
12 197     197 1 1073799 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       885 }, $class;
19 197 50 66     1031 croak "filter must be a code-ref" if defined($self->{filter}) && ref($self->{filter}) ne "CODE";
20 197 50 66     439 croak "validator must be a code-ref" if defined($self->{validator}) && ref($self->{validator}) ne "CODE";
21 197         278 my $content = $args{content};
22 197 100       374 $content = [] if not defined $content;
23 197 50       2020 croak "content must be an array-ref" if ref($content) ne "ARRAY";
24 197         532 $self->_set_destructive(@$content);
25 194         452 return $self;
26             }
27              
28             sub joind {
29 2     2 1 125001 my ($separator, @content) = @_;
30 2         11 return __PACKAGE__->new(
31             separator => $separator,
32             content => \@content
33             );
34             }
35              
36             sub get_all_keys {
37 153     153 1 11430 return $_[0]->{pkl}->get_all_keys;
38             }
39              
40             sub get_all_values {
41             return $_[0]->{pkl}->get_all_values
42 52     52 1 175 }
43              
44             sub to_string {
45 240     240 1 15377 my ($self) = @_;
46             my @vals = defined($self->{filter})
47             ? $self->{filter}->($self)
48 240 100       760 : $self->{pkl}->get_all_values;
49 239         1337 return join($self->{separator}, grep { defined($_) } @vals);
  4396         5791  
50             }
51              
52             sub get {
53 22     22 1 2452 my ($self, $key) = @_;
54 22 50       71 return undef if not defined $key;
55 22         93 return $self->{pkl}->get($key);
56             }
57              
58             sub set {
59 143     143 1 7775 my ($self, @content) = @_;
60 143         324 return $self->clone->_set_destructive(@content);
61             }
62              
63             sub set_all {
64 6     6 1 4616 my ($self, $value) = @_;
65 6         42 return $self->set(map { $_ => $value } $self->{pkl}->get_all_keys);
  13         35  
66             }
67              
68             sub _validate {
69 344     344   505 my ($self) = @_;
70 344 100       782 $self->{validator}->($self) if defined $self->{validator};
71             }
72              
73             sub _set_destructive {
74 340     340   730 my ($self, @content) = @_;
75 340 100       988 croak "odd number of elements in content" if @content % 2 != 0;
76 338         954 foreach my $i (0 .. (@content / 2 - 1)) {
77 703         1103 my ($key, $value) = @content[2*$i, 2*$i+1];
78 703 100       1122 croak "undefined key in content" if not defined $key;
79 701         1051 $self->{pkl}->set($key, $value);
80             }
81 336         645 $self->_validate();
82 331         1300 return $self;
83             }
84              
85             sub clone {
86 154     154 1 2778 my ($self) = @_;
87 154         608 my $clone = ref($self)->new(separator => $self->{separator}, filter => $self->{filter});
88 154         531 $clone->{pkl}->merge($self->{pkl});
89 154         771 $clone->{validator} = $self->{validator};
90 154         341 return $clone;
91             }
92              
93             sub delete {
94 8     8 1 6088 my ($self, @keys) = @_;
95 8         25 my $clone = $self->clone;
96 8         18 $clone->{pkl}->delete($_) foreach grep { defined($_) } @keys;
  11         41  
97 8         19 $clone->_validate();
98 8         23 return $clone;
99             }
100              
101             sub separator {
102 14     14 1 5617 my ($self) = @_;
103 14         53 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__