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__ |