File Coverage

blib/lib/HTML/TagCloud/Extended/TagColors.pm
Criterion Covered Total %
statement 33 33 100.0
branch 12 12 100.0
condition 3 3 100.0
subroutine 6 6 100.0
pod 0 2 0.0
total 54 56 96.4


line stmt bran cond sub pod time code
1             package HTML::TagCloud::Extended::TagColors;
2 2     2   29417 use strict;
  2         5  
  2         85  
3 2     2   918 use Readonly;
  2         3713  
  2         134  
4 2     2   1574 use HTML::TagCloud::Extended::Exception;
  2         6  
  2         1831  
5              
6             Readonly my $DEFAULT_EARLIEST_LINK => "cccccc";
7             Readonly my $DEFAULT_EARLIEST_VISITED => "cccccc";
8             Readonly my $DEFAULT_EARLIEST_HOVER => "cccccc";
9             Readonly my $DEFAULT_EARLIEST_ACTIVE => "cccccc";
10             Readonly my $DEFAULT_EARLIER_LINK => "9999cc";
11             Readonly my $DEFAULT_EARLIER_VISITED => "9999cc";
12             Readonly my $DEFAULT_EARLIER_HOVER => "9999cc";
13             Readonly my $DEFAULT_EARLIER_ACTIVE => "9999cc";
14             Readonly my $DEFAULT_LATER_LINK => "9999ff";
15             Readonly my $DEFAULT_LATER_VISITED => "9999ff";
16             Readonly my $DEFAULT_LATER_HOVER => "9999ff";
17             Readonly my $DEFAULT_LATER_ACTIVE => "9999ff";
18             Readonly my $DEFAULT_LATEST_LINK => "0000ff";
19             Readonly my $DEFAULT_LATEST_VISITED => "0000ff";
20             Readonly my $DEFAULT_LATEST_HOVER => "0000ff";
21             Readonly my $DEFAULT_LATEST_ACTIVE => "0000ff";
22             Readonly my $DEFAULT_HOT_LINK => "ff0000";
23             Readonly my $DEFAULT_HOT_VISITED => "ff0000";
24             Readonly my $DEFAULT_HOT_HOVER => "ff0000";
25             Readonly my $DEFAULT_HOT_ACTIVE => "ff0000";
26              
27             sub new {
28 1     1 0 15 my $class = shift;
29 1         10 my $self = bless {
30             earliest => {
31             link => $DEFAULT_EARLIEST_LINK,
32             visited => $DEFAULT_EARLIEST_VISITED,
33             hover => $DEFAULT_EARLIEST_HOVER,
34             active => $DEFAULT_EARLIEST_ACTIVE,
35             },
36             earlier => {
37             link => $DEFAULT_EARLIER_LINK,
38             visited => $DEFAULT_EARLIER_VISITED,
39             hover => $DEFAULT_EARLIER_HOVER,
40             active => $DEFAULT_EARLIER_ACTIVE,
41             },
42             later => {
43             link => $DEFAULT_LATER_LINK,
44             visited => $DEFAULT_LATER_VISITED,
45             hover => $DEFAULT_LATER_HOVER,
46             active => $DEFAULT_LATER_ACTIVE,
47             },
48             latest => {
49             link => $DEFAULT_LATEST_LINK,
50             visited => $DEFAULT_LATEST_VISITED,
51             hover => $DEFAULT_LATEST_HOVER,
52             active => $DEFAULT_LATEST_ACTIVE,
53             },
54             hot => {
55             link => $DEFAULT_HOT_LINK,
56             visited => $DEFAULT_HOT_VISITED,
57             hover => $DEFAULT_HOT_HOVER,
58             active => $DEFAULT_HOT_ACTIVE,
59             }
60             }, $class;
61 1         135 return $self;
62             }
63              
64             sub set {
65 10     10 0 12297 my ($self, @args) = @_;
66 10         42 while ( my($type, $color) = splice(@args, 0, 2) ) {
67 12 100       76 unless ( $type =~ /(?:earliest|earlier|later|latest|hot)/ ) {
68 1         5 HTML::TagCloud::Extended::Exception->throw(
69             qq/Choose type from [earliest earlier later latest]./
70             );
71             }
72 11 100       30 if (ref $color eq 'HASH') {
73 6         27 while ( my($attr, $code) = each %$color ) {
74 15 100       695 unless ( $attr =~ /(?:link|visited|hover|active)/ ) {
75 1         13 HTML::TagCloud::Extended::Exception->throw(
76             qq/Choose attribute from [link visited hover active]./
77             );
78             }
79 14         22 $code =~ s/\#//;
80 14 100       29 if ( $self->_check_color_code($code) ) {
81 13         78 $self->{$type}{$attr} = $code;
82             } else {
83 1         8 HTML::TagCloud::Extended::Exception->throw(
84             qq/Wrong color-code format "$code"./
85             );
86             }
87             }
88             } else {
89 5         17 $color =~ s/\#//;
90 5 100       14 if ( $self->_check_color_code($color) ) {
91 4         14 $self->{$type}{link} = $color;
92 4         8 $self->{$type}{visited} = $color;
93 4         10 $self->{$type}{hover} = $color;
94 4         20 $self->{$type}{active} = $color;
95             } else {
96 1         15 HTML::TagCloud::Extended::Exception->throw(
97             qq/Wrong color-code format "$color"./
98             );
99             }
100             }
101             }
102             }
103              
104             sub _check_color_code {
105 19     19   27 my ($self, $code) = @_;
106 19 100 100     105 return ( $code =~ /^[0-9a-fA-F]{6}$/ || $code =~ /^[0-9a-fA-F]{3}$/ )
107             ? 1 : undef;
108             }
109              
110             1;
111             __END__