File Coverage

blib/lib/HTML/Declare.pm
Criterion Covered Total %
statement 69 146 47.2
branch 12 14 85.7
condition 7 8 87.5
subroutine 18 93 19.3
pod 87 87 100.0
total 193 348 55.4


line stmt bran cond sub pod time code
1             package HTML::Declare;
2              
3 2     2   29867 use strict;
  2         4  
  2         78  
4 2     2   10 use warnings;
  2         3  
  2         62  
5 2     2   22 use base 'Exporter';
  2         5  
  2         200  
6 2     2   2172 use HTML::Entities 'encode_entities';
  2         14107  
  2         234  
7              
8 2     2   2087 use overload '""' => sub { shift->as_html };
  2     10   1248  
  2         24  
  10         45  
9              
10             our $VERSION = '2.4';
11              
12             sub TAG (@) {
13 10     10 1 17 my $attributes = shift;
14              
15 10         63 my $sub = ( caller(1) )[3];
16 10         49 $sub =~ /.*::(.*)$/;
17 10         18 my $tag = lc $1;
18              
19 10         33 my $html = HTML::Declare->new;
20 10         25 $html->tag($tag);
21              
22 10   50     24 $attributes ||= {};
23 10         15 my $children = [];
24              
25 10         29 for my $key ( keys %$attributes ) {
26              
27 11         40 my $value = $attributes->{$key};
28              
29 11 100       23 if ( $key eq '_' ) {
30              
31 10 100       27 if ( ref $value eq 'ARRAY' ) { $children = $value }
  4 100       10  
32 1         5 elsif ( ref $value eq 'HTML::Declare' ) { $children = [$value] }
33 5         23 else { $children = [ encode_entities("$value") ] }
34              
35             }
36 1         2 else { push @{ $html->attributes }, [ $key, $value ] }
  1         3  
37             }
38              
39 10         110 $html->children($children);
40              
41 10         49 return $html;
42             }
43              
44             our @EXPORT_OK = qw/
45             A
46             ABBR
47             ACRONYM
48             ADDRESS
49             AREA
50             B
51             BASE
52             BDO
53             BIG
54             BLOCKQUOTE
55             BODY
56             BR
57             BUTTON
58             CAPTION
59             CITE
60             CODE
61             COL
62             COLGROUP
63             DD
64             DEL
65             DIV
66             DFN
67             DL
68             DT
69             EM
70             FIELDSET
71             FORM
72             FRAME
73             FRAMESET
74             H1
75             H2
76             H3
77             H4
78             H5
79             H6
80             HEAD
81             HR
82             HTML
83             I
84             IFRAME
85             IMG
86             INPUT
87             INS
88             KBD
89             LABEL
90             LEGEND
91             LI
92             LINK
93             MAP
94             META
95             NOFRAMES
96             NOSCRIPT
97             OBJECT
98             OL
99             OPTGROUP
100             OPTION
101             P
102             PARAM
103             PRE
104             Q
105             SAMP
106             SCRIPT
107             SELECT
108             SMALL
109             SPAN
110             STRONG
111             STYLE
112             SUB
113             SUP
114             TABLE
115             TAG
116             TBODY
117             TD
118             TEXTAREA
119             TFOOT
120             TH
121             THEAD
122             TITLE
123             TR
124             TT
125             UL
126             VAR
127             /;
128             our %EXPORT_TAGS = ( all => \@EXPORT_OK );
129              
130 1     1 1 3 sub A ($) { TAG @_ }
131 0     0 1 0 sub ABBR ($) { TAG @_ }
132 0     0 1 0 sub ACRONYM ($) { TAG @_ }
133 0     0 1 0 sub ADDRESS ($) { TAG @_ }
134 0     0 1 0 sub AREA ($) { TAG @_ }
135 0     0 1 0 sub B ($) { TAG @_ }
136 0     0 1 0 sub BASE ($) { TAG @_ }
137 0     0 1 0 sub BDO ($) { TAG @_ }
138 0     0 1 0 sub BIG ($) { TAG @_ }
139 0     0 1 0 sub BLOCKQUOTE ($) { TAG @_ }
140 2     2 1 5 sub BODY ($) { TAG @_ }
141 0     0 1 0 sub BR ($) { TAG @_ }
142 0     0 1 0 sub BUTTON ($) { TAG @_ }
143 0     0 1 0 sub CAPTION ($) { TAG @_ }
144 0     0 1 0 sub CITE ($) { TAG @_ }
145 0     0 1 0 sub CODE ($) { TAG @_ }
146 0     0 1 0 sub COL ($) { TAG @_ }
147 0     0 1 0 sub COLGROUP ($) { TAG @_ }
148 0     0 1 0 sub DD ($) { TAG @_ }
149 0     0 1 0 sub DEL ($) { TAG @_ }
150 1     1 1 3 sub DIV ($) { TAG @_ }
151 0     0 1 0 sub DFN ($) { TAG @_ }
152 0     0 1 0 sub DL ($) { TAG @_ }
153 0     0 1 0 sub DT ($) { TAG @_ }
154 0     0 1 0 sub EM ($) { TAG @_ }
155 0     0 1 0 sub FIELDSET ($) { TAG @_ }
156 0     0 1 0 sub FORM ($) { TAG @_ }
157 0     0 1 0 sub FRAME ($) { TAG @_ }
158 0     0 1 0 sub FRAMESET ($) { TAG @_ }
159 0     0 1 0 sub H1 ($) { TAG @_ }
160 0     0 1 0 sub H2 ($) { TAG @_ }
161 0     0 1 0 sub H3 ($) { TAG @_ }
162 0     0 1 0 sub H4 ($) { TAG @_ }
163 0     0 1 0 sub H5 ($) { TAG @_ }
164 0     0 1 0 sub H6 ($) { TAG @_ }
165 2     2 1 6 sub HEAD ($) { TAG @_ }
166 0     0 1 0 sub HR ($) { TAG @_ }
167 2     2 1 5 sub HTML ($) { TAG @_ }
168 0     0 1 0 sub I ($) { TAG @_ }
169 0     0 1 0 sub IFRAME ($) { TAG @_ }
170 0     0 1 0 sub IMG ($) { TAG @_ }
171 0     0 1 0 sub INPUT ($) { TAG @_ }
172 0     0 1 0 sub INS ($) { TAG @_ }
173 0     0 1 0 sub KBD ($) { TAG @_ }
174 0     0 1 0 sub LABEL ($) { TAG @_ }
175 0     0 1 0 sub LEGEND ($) { TAG @_ }
176 0     0 1 0 sub LI ($) { TAG @_ }
177 0     0 1 0 sub LINK ($) { TAG @_ }
178 0     0 1 0 sub MAP ($) { TAG @_ }
179 0     0 1 0 sub META ($) { TAG @_ }
180 0     0 1 0 sub NOFRAMES ($) { TAG @_ }
181 0     0 1 0 sub NOSCRIPT ($) { TAG @_ }
182 0     0 1 0 sub OBJECT ($) { TAG @_ }
183 0     0 1 0 sub OL ($) { TAG @_ }
184 0     0 1 0 sub OPTGROUP ($) { TAG @_ }
185 0     0 1 0 sub OPTION ($) { TAG @_ }
186 0     0 1 0 sub P ($) { TAG @_ }
187 0     0 1 0 sub PARAM ($) { TAG @_ }
188 0     0 1 0 sub PRE ($) { TAG @_ }
189 0     0 1 0 sub Q ($) { TAG @_ }
190 0     0 1 0 sub SAMP ($) { TAG @_ }
191 0     0 1 0 sub SCRIPT ($) { TAG @_ }
192 0     0 1 0 sub SELECT ($) { TAG @_ }
193 0     0 1 0 sub SMALL ($) { TAG @_ }
194 0     0 1 0 sub SPAN ($) { TAG @_ }
195 0     0 1 0 sub STRONG ($) { TAG @_ }
196 0     0 1 0 sub STYLE ($) { TAG @_ }
197 0     0 1 0 sub SUB ($) { TAG @_ }
198 0     0 1 0 sub SUP ($) { TAG @_ }
199 0     0 1 0 sub TABLE ($) { TAG @_ }
200 0     0 1 0 sub TBODY ($) { TAG @_ }
201 0     0 1 0 sub TD ($) { TAG @_ }
202 0     0 1 0 sub TEXTAREA ($) { TAG @_ }
203 0     0 1 0 sub TFOOT ($) { TAG @_ }
204 0     0 1 0 sub TH ($) { TAG @_ }
205 0     0 1 0 sub THEAD ($) { TAG @_ }
206 2     2 1 17 sub TITLE ($) { TAG @_ }
207 0     0 1 0 sub TR ($) { TAG @_ }
208 0     0 1 0 sub TT ($) { TAG @_ }
209 0     0 1 0 sub UL ($) { TAG @_ }
210 0     0 1 0 sub VAR ($) { TAG @_ }
211              
212 10     10 1 26 sub new { return bless {}, shift }
213              
214             sub as_html {
215 10     10 1 13 my $self = shift;
216              
217 10         26 my $tag = $self->tag;
218 10         21 my $html = "<$tag";
219              
220 10         10 for my $attribute ( @{ $self->attributes } ) {
  10         23  
221 1         3 my $key = $attribute->[0];
222 1         1 my $value = $attribute->[1];
223 1         4 $html .= qq/ $key="$value"/;
224             }
225              
226 10 50       14 if ( @{ $self->children } ) {
  10         38  
227              
228 10         13 $html .= '>';
229 10         12 for my $child ( @{ $self->children } ) {
  10         18  
230 12         27 $html .= "$child";
231             }
232 10         20 $html .= "";
233              
234             }
235 0         0 else { $html .= '/>' }
236              
237 10         41 return $html;
238             }
239              
240             sub attributes {
241 11     11 1 14 my ( $self, $attributes ) = @_;
242 11   100     48 $self->{attributes} ||= [];
243 11 50       41 return $self->{attributes} unless $attributes;
244 0         0 return $self->{attributes} = $attributes;
245             }
246              
247             sub children {
248 30     30 1 42 my ( $self, $children ) = @_;
249 30   100     84 $self->{children} ||= [];
250 30 100       90 return $self->{children} unless $children;
251 10         22 return $self->{children} = $children;
252             }
253              
254             sub tag {
255 20     20 1 27 my ( $self, $tag ) = @_;
256 20   100     147 $self->{tag} ||= '';
257 20 100       52 return $self->{tag} unless $tag;
258 10         22 return $self->{tag} = $tag;
259             }
260              
261             1;
262             __END__