File Coverage

blib/lib/Tags/HTML/Icon.pm
Criterion Covered Total %
statement 59 59 100.0
branch 20 20 100.0
condition 3 3 100.0
subroutine 12 12 100.0
pod 1 1 100.0
total 95 95 100.0


line stmt bran cond sub pod time code
1             package Tags::HTML::Icon;
2              
3 7     7   488552 use base qw(Tags::HTML);
  7         17  
  7         4822  
4 7     7   70896 use strict;
  7         18  
  7         228  
5 7     7   40 use warnings;
  7         15  
  7         3126  
6              
7 7     7   52 use Class::Utils qw(set_params split_params);
  7         29  
  7         459  
8 7     7   62 use Error::Pure qw(err);
  7         16  
  7         410  
9 7     7   3101 use Mo::utils::CSS 0.02 qw(check_css_class);
  7         52403  
  7         246  
10 7     7   463 use Scalar::Util qw(blessed);
  7         20  
  7         5065  
11              
12             our $VERSION = 0.01;
13              
14             # Constructor.
15             sub new {
16 18     18 1 1773037 my ($class, @params) = @_;
17              
18             # Create object.
19 18         92 my ($object_params_ar, $other_params_ar) = split_params(
20             ['css_class'], @params);
21 18         505 my $self = $class->SUPER::new(@{$other_params_ar});
  18         134  
22              
23             # CSS style for list.
24 18         668 $self->{'css_class'} = 'icon';
25              
26             # Process params.
27 18         32 set_params($self, @{$object_params_ar});
  18         63  
28              
29 18         234 check_css_class($self, 'css_class');
30              
31             # Object.
32 16         465 return $self;
33             }
34              
35             sub _cleanup {
36 1     1   8 my $self = shift;
37              
38 1         2 delete $self->{'_icon'};
39              
40 1         2 return;
41             }
42              
43             sub _init {
44 11     11   34125 my ($self, $icon) = @_;
45              
46 11 100       38 if (! defined $icon) {
47 1         7 err 'Icon object is required.';
48             }
49 10 100 100     95 if (! blessed($icon) || ! $icon->isa('Data::Icon')) {
50 2         45 err "Icon object must be a instance of 'Data::Icon'.";
51             }
52              
53 8         23 $self->{'_icon'} = $icon;
54              
55 8         17 return;
56             }
57              
58             # Process 'Tags'.
59             sub _process {
60 7     7   82 my $self = shift;
61              
62 7 100       21 if (! exists $self->{'_icon'}) {
63 1         3 return;
64             }
65              
66             $self->{'tags'}->put(
67             ['b', 'span'],
68 6         48 ['a', 'class', $self->{'css_class'}],
69             );
70 6 100       574 if (defined $self->{'_icon'}->url) {
71             $self->{'tags'}->put(
72             ['b', 'img'],
73             defined $self->{'_icon'}->alt ? (
74             ['a', 'alt', $self->{'_icon'}->alt],
75             ) : (),
76 2 100       53 ['a', 'src', $self->{'_icon'}->url],
77             ['e', 'img'],
78             );
79             } else {
80 4         39 my @style;
81 4 100       35 if (defined $self->{'_icon'}->bg_color) {
82 2         52 push @style, 'background-color:'.$self->{'_icon'}->bg_color.';';
83             }
84 4 100       39 if (defined $self->{'_icon'}->color) {
85 2         36 push @style, 'color:'.$self->{'_icon'}->color.';';
86             }
87             $self->{'tags'}->put(
88             @style ? (
89             ['b', 'span'],
90             ['a', 'style', (join '', @style)],
91             ) : (),
92 4 100       54 ['d', $self->{'_icon'}->char],
    100          
93             @style ? (
94             ['e', 'span'],
95             ) : (),
96             );
97             }
98 6         859 $self->{'tags'}->put(
99             ['e', 'span'],
100             );
101              
102 6         276 return;
103             }
104              
105             sub _process_css {
106 2     2   23 my $self = shift;
107              
108 2 100       5 if (! exists $self->{'_icon'}) {
109 1         2 return;
110             }
111              
112 1         12 $self->{'css'}->put(
113             # ['s', '.'.$self->{'css_class'}],
114             # No default CSS code.
115             # ['e'],
116             );
117              
118 1         7 return;
119             }
120              
121             1;
122              
123             __END__
124              
125             =pod
126              
127             =encoding utf8
128              
129             =head1 NAME
130              
131             Tags::HTML::Icon - Tags helper for HTML icon.
132              
133             =head1 DESCRIPTION
134              
135             L<Tags> helper to print HTML code of icon defined by L<Data::Icon>.
136              
137             The HTML code contains icon defined by URL and alternate text (optional)
138             or by UTF-8 character with foregroun and backround colors (optional).
139              
140             =head1 SYNOPSIS
141              
142             use Tags::HTML::Icon;
143              
144             my $obj = Tags::HTML::Icon->new(%params);
145             $obj->cleanup;
146             $obj->init($icon);
147             $obj->prepare;
148             $obj->process;
149             $obj->process_css;
150              
151             =head1 METHODS
152              
153             =head2 C<new>
154              
155             my $obj = Tags::HTML::Icon->new(%params);
156              
157             Constructor.
158              
159             =over 8
160              
161             =item * C<css>
162              
163             L<CSS::Struct::Output> object for L<process_css> processing.
164              
165             Default value is undef.
166              
167             =item * C<css_class>
168              
169             Default value is 'info-box'.
170              
171             =item * C<lang>
172              
173             Language in ISO 639-1 code.
174              
175             Default value is undef.
176              
177             =item * C<tags>
178              
179             L<Tags::Output> object.
180              
181             Default value is undef.
182              
183             =back
184              
185             =head2 C<cleanup>
186              
187             $obj->cleanup;
188              
189             Process cleanup after page run.
190              
191             In this case cleanup internal representation of a set by L<init>.
192              
193             Returns undef.
194              
195             =head2 C<init>
196              
197             $obj->init($icon);
198              
199             Process initialization in page run.
200              
201             Accepted C<$icon> is L<Data::Icon>.
202              
203             Returns undef.
204              
205             =head2 C<prepare>
206              
207             $obj->prepare;
208              
209             Do nothing in case of this object.
210              
211             Returns undef.
212              
213             =head2 C<process>
214              
215             $obj->process;
216              
217             Process L<Tags> structure for HTML a element to output.
218              
219             Do nothing in case without inicialization by L<init>.
220              
221             Returns undef.
222              
223             =head2 C<process_css>
224              
225             $obj->process_css;
226              
227             Process L<CSS::Struct> structure for HTML a element to output.
228              
229             Default CSS doesn't exist.
230              
231             Do nothing in case without inicialization by L<init>.
232              
233             Returns undef.
234              
235             =head1 ERRORS
236              
237             new():
238             From Mo::utils::CSS::check_css_class():
239             Parameter '%s' has bad CSS class name.
240             Value: %s
241             Parameter '%s' has bad CSS class name (number on begin).
242             Value: %s
243             From Tags::HTML::new():
244             Parameter 'css' must be a 'CSS::Struct::Output::*' class.
245             Parameter 'tags' must be a 'Tags::Output::*' class.
246              
247             init():
248             Icon object is required.
249             Icon object must be a instance of 'Data::Icon'.
250              
251             process():
252             From Tags::HTML::process():
253             Parameter 'tags' isn't defined.
254              
255             process_css():
256             From Tags::HTML::process_css():
257             Parameter 'css' isn't defined.
258              
259             =head1 EXAMPLE
260              
261             =for comment filename=create_and_print_icon.pl
262              
263             use strict;
264             use warnings;
265              
266             use CSS::Struct::Output::Indent;
267             use Data::Icon;
268             use Tags::HTML::Icon;
269             use Tags::Output::Indent;
270             use Unicode::UTF8 qw(decode_utf8 encode_utf8);
271              
272             # Object.
273             my $css = CSS::Struct::Output::Indent->new;
274             my $tags = Tags::Output::Indent->new(
275             'xml' => 1,
276             );
277             my $obj = Tags::HTML::Icon->new(
278             'css' => $css,
279             'tags' => $tags,
280             );
281              
282             # Data object for icon.
283             my $icon = Data::Icon->new(
284             'bg_color' => 'grey',
285             'char' => decode_utf8('†'),
286             'color' => 'red',
287             );
288              
289             # Initialize.
290             $obj->init($icon);
291              
292             # Process.
293             $obj->process;
294             $obj->process_css;
295              
296             # Print out.
297             print "HTML:\n";
298             print encode_utf8($tags->flush);
299             print "\n\n";
300             print "CSS:\n";
301             print $css->flush;
302              
303             # Output:
304             # HTML:
305             # <span class="icon">
306             # <span style="background-color:grey;color:red;">
307             # †
308             # </span>
309             # </span>
310             #
311             # CSS:
312             #
313              
314             =head1 DEPENDENCIES
315              
316             L<Class::Utils>,
317             L<Error::Pure>,
318             L<Mo::utils::CSS>,
319             L<Scalar::Util>,
320             L<Tags::HTML>.
321              
322             =head1 REPOSITORY
323              
324             L<https://github.com/michal-josef-spacek/Tags-HTML-Icon>
325              
326             =head1 AUTHOR
327              
328             Michal Josef Špaček L<mailto:skim@cpan.org>
329              
330             L<http://skim.cz>
331              
332             =head1 LICENSE AND COPYRIGHT
333              
334             © 2025 Michal Josef Špaček
335              
336             BSD 2-Clause License
337              
338             =head1 VERSION
339              
340             0.01
341              
342             =cut