File Coverage

lib/Graphics/Toolkit/Color/Space/Basis.pm
Criterion Covered Total %
statement 125 125 100.0
branch 67 80 83.7
condition 27 36 75.0
subroutine 32 32 100.0
pod 0 29 0.0
total 251 302 83.1


line stmt bran cond sub pod time code
1 20     20   77911 use v5.12;
  20         94  
2 20     20   99 use warnings;
  20         37  
  20         42062  
3              
4             # logic of value hash keys for all color spacs
5              
6             package Graphics::Toolkit::Color::Space::Basis;
7              
8             sub new {
9 74     74 0 2398 my ($pkg, $axis_names, $name_shortcuts, $prefix) = @_;
10 74 100       270 return unless ref $axis_names eq 'ARRAY';
11 71 50 33     287 return if defined $name_shortcuts and (ref $name_shortcuts ne 'ARRAY' or @$axis_names != @$name_shortcuts);
      66        
12 71         170 my @keys = map {lc} @$axis_names;
  222         506  
13 71 100       198 my @shortcuts = map { _color_key_shortcut($_) } (defined $name_shortcuts) ? @$name_shortcuts : @keys;
  222         350  
14 71 50       179 return unless @keys > 0;
15              
16 71         183 my @iterator = 0 .. $#keys;
17 71         114 my %key_order = map { $keys[$_] => $_ } @iterator;
  222         539  
18 71         145 my %shortcut_order = map { $shortcuts[$_] => $_ } @iterator;
  222         454  
19 71         769 bless { keys => [@keys], shortcuts => [@shortcuts],
20             key_order => \%key_order, shortcut_order => \%shortcut_order,
21             name => uc (join('', @shortcuts)), count => int @keys, iterator => \@iterator }
22             }
23              
24 267     267 0 319 sub keys { @{$_[0]{'keys'}} }
  267         827  
25 26     26 0 34 sub shortcuts{ @{$_[0]{'shortcuts'}} }
  26         100  
26 2575     2575 0 2667 sub iterator { @{$_[0]{'iterator'}} }
  2575         4968  
27 4211     4211 0 12091 sub count { $_[0]{'count'} }
28 2289     2289 0 6595 sub name { $_[0]{'name'} }
29              
30 87 50   87 0 279 sub key_pos { defined $_[1] ? $_[0]->{'key_order'}{ lc $_[1] } : undef}
31 197 50   197 0 628 sub shortcut_pos { defined $_[1] ? $_[0]->{'shortcut_order'}{ lc $_[1] } : undef }
32 539 100 100 539 0 2183 sub is_key { (defined $_[1] and exists $_[0]->{'key_order'}{ lc $_[1] }) ? 1 : 0 }
33 361 100 66 361 0 1551 sub is_shortcut { (defined $_[1] and exists $_[0]->{'shortcut_order'}{ lc $_[1] }) ? 1 : 0 }
34 220 100   220 0 329 sub is_key_or_shortcut { $_[0]->is_key($_[1]) or $_[0]->is_shortcut($_[1]) }
35             sub is_string {
36 610     610 0 869 my ($self, $string) = @_;
37 610 100 66     2273 return 0 unless defined $string and not ref $string;
38 101         154 $string = lc $string;
39 101         172 my $name = lc $self->name;
40 101 100       346 return 0 unless index($string, $name.':') == 0;
41 41         56 my $nr = '\s*-?\d+(?:\.\d+)?\s*';
42 41         69 my $nrs = join(',', ('\s*-?\d+(?:\.\d+)?\s*') x $self->count);
43 41 50       762 ($string =~ /^$name:$nrs$/) ? 1 : 0;
44             }
45             sub is_css_string {
46 560     560 0 800 my ($self, $string) = @_;
47 560 100 66     2103 return 0 unless defined $string and not ref $string;
48 88         139 $string = lc $string;
49 88         135 my $name = lc $self->name;
50 88 100       352 return 0 unless index($string, $name.'(') == 0;
51 2         6 my $nr = '\s*-?\d+(?:\.\d+)?\s*';
52 2         8 my $nrs = join(',', ('\s*-?\d+(?:\.\d+)?\s*') x $self->count);
53 2 50       80 ($string =~ /^$name\($nrs\)$/) ? 1 : 0;
54             }
55             sub is_array {
56 3011     3011 0 4009 my ($self, $value_array) = @_;
57 3011 100 100     14175 (ref $value_array eq 'ARRAY' and @$value_array == $self->{'count'}) ? 1 : 0;
58             }
59             sub is_named_array {
60 675     675 0 974 my ($self, $value_array) = @_;
61 675 100 100     2713 (ref $value_array eq 'ARRAY' and @$value_array == ($self->{'count'}+1)
62             and uc $value_array->[0] eq uc $self->name) ? 1 : 0;
63             }
64             sub is_hash {
65 578     578 0 888 my ($self, $value_hash) = @_;
66 578 100 100     1972 return 0 unless ref $value_hash eq 'HASH' and CORE::keys %$value_hash == $self->{'count'};
67 116         241 for (CORE::keys %$value_hash) {
68 201 100       325 return 0 unless $self->is_key_or_shortcut($_);
69             }
70 38         169 return 1;
71             }
72             sub is_partial_hash {
73 9     9 0 20 my ($self, $value_hash) = @_;
74 9 100       36 return 0 unless ref $value_hash eq 'HASH';
75 8         18 my $key_count = CORE::keys %$value_hash;
76 8 100 66     51 return 0 unless $key_count and $key_count <= $self->{'count'};
77 7         21 for (CORE::keys %$value_hash) {
78 15 100       33 return 0 unless $self->is_key_or_shortcut($_);
79             }
80 6         29 return 1;
81             }
82              
83             ########################################################################
84              
85             sub key_shortcut {
86 22     22 0 43 my ($self, $key) = @_;
87 22 50       43 return unless $self->is_key( $key );
88 22         62 ($self->shortcuts)[ $self->{'key_order'}{ lc $key } ];
89             }
90              
91             sub list_value_from_key {
92 6     6 0 367 my ($self, $key, @values) = @_;
93 6         12 $key = lc $key;
94 6 100       24 return unless @values == $self->{'count'};
95 4 100       19 return unless exists $self->{'key_order'}{ $key };
96 3         14 return $values[ $self->{'key_order'}{ $key } ];
97             }
98              
99             sub list_value_from_shortcut {
100 4     4 0 12 my ($self, $shortcut, @values) = @_;
101 4         8 $shortcut = lc $shortcut;
102 4 50       12 return unless @values == $self->{'count'};
103 4 100       14 return unless exists $self->{'shortcut_order'}{ $shortcut };
104 3         16 return $values[ $self->{'shortcut_order'}{ $shortcut } ];
105             }
106              
107             sub list_from_hash {
108 36     36 0 3194 my ($self, $value_hash) = @_;
109 36 50 33     166 return undef unless ref $value_hash eq 'HASH' and CORE::keys %$value_hash == $self->{'count'};
110 36         135 my @values = (0) x $self->{'count'};
111 36         84 for my $value_key (CORE::keys %$value_hash) {
112 111 100       169 if ($self->is_key( $value_key )) { $values[ $self->{'key_order'}{ lc $value_key } ] = $value_hash->{ $value_key } }
  15 100       36  
113 95         212 elsif ($self->is_shortcut( $value_key )) { $values[ $self->{'shortcut_order'}{ lc $value_key } ] = $value_hash->{ $value_key } }
114 1         5 else { return }
115             }
116 35         129 return @values;
117             }
118              
119             sub deformat_partial_hash {
120 87     87 0 4296 my ($self, $value_hash) = @_;
121 87 100       226 return unless ref $value_hash eq 'HASH';
122 86         159 my @keys_got = CORE::keys %$value_hash;
123 86 100 100     268 return unless @keys_got and @keys_got <= $self->{'count'};
124 76         108 my $result = {};
125 76         97 for my $key (@keys_got) {
126 88 100       144 if ($self->is_key( $key )) { $result->{ int $self->key_pos( $key ) } = $value_hash->{ $key } }
  16 100       41  
127 17         70 elsif ($self->is_shortcut( $key )){ $result->{ int $self->shortcut_pos( $key ) } = $value_hash->{ $key } }
128 55         129 else { return undef }
129             }
130 21         61 return $result;
131             }
132              
133             sub list_from_string {
134 41     41 0 98 my ($self, $string) = @_;
135 41         125 my @parts = split(/:/, $string);
136 41         124 return map {$_ + 0} split(/,/, $parts[1]);
  125         352  
137             }
138              
139             sub list_from_css {
140 2     2 0 10 my ($self, $string) = @_;
141 2         20 1 until chop($string) eq ')';
142 2         10 my @parts = split(/\(/, $string);
143 2         8 return map {$_ + 0} split(/,/, $parts[1]);
  6         24  
144             }
145              
146             sub key_hash_from_list {
147 21     21 0 52 my ($self, @values) = @_;
148 21 100       81 return unless @values == $self->{'count'};
149 19         30 return { map { $self->{'keys'}[$_] => $values[$_]} @{$self->{'iterator'}} };
  72         222  
  19         39  
150             }
151              
152             sub shortcut_hash_from_list {
153 8     8 0 22 my ($self, @values) = @_;
154 8 100       34 return unless @values == $self->{'count'};
155 6         12 return { map {$self->{'shortcuts'}[$_] => $values[$_]} @{$self->{'iterator'}} };
  18         72  
  6         15  
156             }
157              
158             sub named_array_from_list {
159 1     1 0 3 my ($self, @values) = @_;
160 1 50       6 return [lc $self->name, @values] if @values == $self->{'count'};
161             }
162              
163             sub named_string_from_list {
164 42     42 0 85 my ($self, @values) = @_;
165 42 50       144 return unless @values == $self->{'count'};
166 42         108 lc( $self->name).': '.join(', ', @values);
167             }
168              
169             sub css_string_from_list {
170 4     4 0 13 my ($self, @values) = @_;
171 4 50       14 return unless @values == $self->{'count'};
172 4         13 lc( $self->name).'('.join(',', @values).')';
173             }
174              
175 222 50   222   800 sub _color_key_shortcut { lc substr($_[0], 0, 1) if defined $_[0] }
176              
177             1;