File Coverage

blib/lib/Gnuplot/Builder/PartiallyKeyedList.pm
Criterion Covered Total %
statement 70 70 100.0
branch 17 24 70.8
condition 3 9 33.3
subroutine 16 16 100.0
pod 12 12 100.0
total 118 131 90.0


line stmt bran cond sub pod time code
1             package Gnuplot::Builder::PartiallyKeyedList;
2 72     72   121711 use strict;
  72         133  
  72         1795  
3 72     72   369 use warnings;
  72         130  
  72         1644  
4 72     72   343 use Carp;
  72         143  
  72         65649  
5              
6             sub new {
7 2248     2248 1 5507 my ($class) = @_;
8 2248         8730 my $self = bless {
9             index_for => {},
10             keys => [],
11             values => [],
12             }, $class;
13 2248         14929 return $self;
14             }
15              
16             sub set {
17 6074     6074 1 8888 my ($self, $key, $value) = @_;
18 6074 50       10902 croak "key must be defined" if not defined $key;
19 6074         8510 my $index = $self->{index_for}{$key};
20 6074 100       9368 if(defined($index)) {
21 515         1553 $self->{values}[$index] = $value;
22             }else {
23 5559         5619 push(@{$self->{keys}}, $key);
  5559         10748  
24 5559         6659 push(@{$self->{values}}, $value);
  5559         9260  
25 5559         6198 $self->{index_for}{$key} = $#{$self->{keys}};
  5559         20256  
26             }
27             }
28              
29             sub get {
30 211     211 1 5333 my ($self, $key) = @_;
31 211 50       462 croak "key must be defined" if not defined $key;
32 211         388 my $index = $self->{index_for}{$key};
33 211 100       872 return defined($index) ? $self->{values}[$index] : undef;
34             }
35              
36             sub get_at {
37 71     71 1 25578 my ($self, $index) = @_;
38 71 50 33     254 croak "index out of bounds" if $index < 0 || $index >= $self->size;
39 71         412 return ($self->{keys}[$index], $self->{values}[$index]);
40             }
41              
42             sub get_all_keys {
43 172     172 1 3884 my ($self) = @_;
44 172         219 return @{$self->{keys}};
  172         1098  
45             }
46              
47             sub get_all_values {
48 276     276 1 6118 my ($self) = @_;
49 276         303 return @{$self->{values}};
  276         1302  
50             }
51              
52             sub exists {
53 1539     1539 1 2264 my ($self, $key) = @_;
54 1539 50       2964 croak "key must be defined" if not defined $key;
55 1539         7277 return defined($self->{index_for}{$key});
56             }
57              
58             sub delete {
59 33     33 1 92 my ($self, $key) = @_;
60 33 50       100 croak "key must be defined" if not defined $key;
61 33         87 my $index = delete $self->{index_for}{$key};
62 33 100       117 return undef if not defined $index;
63 26         83 splice(@{$self->{keys}}, $index, 1);
  26         80  
64 26         47 my $value = splice(@{$self->{values}}, $index, 1);
  26         57  
65            
66 26         42 foreach my $existing_index (values %{$self->{index_for}}) {
  26         78  
67 66 100       181 $existing_index-- if $existing_index > $index;
68             }
69 26         140 return $value;
70             }
71              
72             sub add {
73 100     100 1 250 my ($self, $entry) = @_;
74 100         117 push(@{$self->{keys}}, undef);
  100         221  
75 100         128 push(@{$self->{values}}, $entry);
  100         377  
76             }
77              
78             sub each {
79 2127     2127 1 3171 my ($self, $code) = @_;
80 2127 50 33     9589 croak "code must be a code-ref" if !defined($code) || ref($code) ne "CODE";
81 2127         2363 foreach my $index (0 .. $#{$self->{keys}}) {
  2127         10769  
82 5554         12304 $code->($self->{keys}[$index], $self->{values}[$index]);
83             }
84             }
85              
86             sub merge {
87 1535     1535 1 2185 my ($self, $another) = @_;
88 1535 50 33     5067 croak "another_pkl must be an object" if !defined($another) || !ref($another);
89             $another->each(sub {
90 4723     4723   6104 my ($key, $value) = @_;
91 4723 100       7226 if(defined($key)) {
92 4676         8557 $self->set($key, $value);
93             }else {
94 47         96 $self->add($value);
95             }
96 1535         5645 });
97             }
98              
99 103     103 1 17943 sub size { scalar(@{ $_[0]->{keys} }) }
  103         434  
100              
101             1;
102              
103             __END__