blib/lib/HTML/FromArrayref.pm | |||
---|---|---|---|
Criterion | Covered | Total | % |
statement | 34 | 36 | 94.4 |
branch | 12 | 12 | 100.0 |
condition | 5 | 6 | 83.3 |
subroutine | 11 | 13 | 84.6 |
pod | 5 | 8 | 62.5 |
total | 67 | 75 | 89.3 |
line | stmt | bran | cond | sub | pod | time | code | |||
---|---|---|---|---|---|---|---|---|---|---|
1 | package HTML::FromArrayref; | |||||||||
2 | ||||||||||
3 | 3 | 3 | 63948 | use 5.006; | ||||||
3 | 12 | |||||||||
3 | 118 | |||||||||
4 | 3 | 3 | 17 | use strict; | ||||||
3 | 7 | |||||||||
3 | 115 | |||||||||
5 | 3 | 3 | 17 | use warnings; | ||||||
3 | 11 | |||||||||
3 | 110 | |||||||||
6 | ||||||||||
7 | 3 | 3 | 18 | use base qw( Exporter ); | ||||||
3 | 5 | |||||||||
3 | 522 | |||||||||
8 | our @EXPORT = qw( HTML ); | |||||||||
9 | our @EXPORT_OK = qw( start_tag end_tag html_strict html_transitional html_frameset ); | |||||||||
10 | our %EXPORT_TAGS = ( | |||||||||
11 | TAGS => [qw( start_tag end_tag )], | |||||||||
12 | DOCTYPES => [qw( html_strict html_transitional html_frameset )] | |||||||||
13 | ); | |||||||||
14 | ||||||||||
15 | 3 | 3 | 2798 | use HTML::Entities; | ||||||
3 | 18945 | |||||||||
3 | 1838 | |||||||||
16 | ||||||||||
17 | =head1 NAME | |||||||||
18 | ||||||||||
19 | HTML::FromArrayref - Output HTML described by a Perl data structure | |||||||||
20 | ||||||||||
21 | =head1 VERSION | |||||||||
22 | ||||||||||
23 | Version 1.06 | |||||||||
24 | ||||||||||
25 | =cut | |||||||||
26 | ||||||||||
27 | our $VERSION = '1.06'; | |||||||||
28 | ||||||||||
29 | =head1 SYNOPSIS | |||||||||
30 | ||||||||||
31 | use HTML::FromArrayref; | |||||||||
32 | print HTML [ html => [ head => [ title => 'My Web page' ] ], [ body => 'Hello' ] ]; | |||||||||
33 | ||||||||||
34 | =head1 EXPORT | |||||||||
35 | ||||||||||
36 | This module exports an HTML() function that lets you easily print valid HTML without embedding it in your Perl code. | |||||||||
37 | ||||||||||
38 | =head1 SUBROUTINES/METHODS | |||||||||
39 | ||||||||||
40 | =head2 HTML(@) | |||||||||
41 | ||||||||||
42 | Takes a list of strings and arrayrefs describing HTML content and returns the HTML string. The strings are encoded; each arrayref represents an HTML element, as follows: | |||||||||
43 | ||||||||||
44 | [ $tag_name, $attributes, @content ] | |||||||||
45 | ||||||||||
46 | =head3 $tag_name | |||||||||
47 | ||||||||||
48 | evaluates to a tag name such as 'html', 'head', 'title', 'body', 'table', 'tr', 'td', 'p', &c. If $tag_name is false then the whole element is replaced by its content. | |||||||||
49 | ||||||||||
50 | If an arrayref's first element is another arrayref instead of an tag name, then the value of the first item of that array will be included in the HTML string but will not be encoded. This lets you include text in the HTML that has already been entity-encoded. | |||||||||
51 | ||||||||||
52 | =head3 $attributes | |||||||||
53 | ||||||||||
54 | is an optional hashref defining the element's attributes. If an attribute's value is undefined then the attribute will not appear in the generated HTML string. Attribute values will be encoded. If there isn't a hashref in the second spot in the element-definition list then the element won't have any attributes in the generated HTML. | |||||||||
55 | ||||||||||
56 | =head3 @content | |||||||||
57 | ||||||||||
58 | is another list of strings and arrayrefs, which will be used to generate the content of the element. If the content list is empty, then the element has no content and will be represented in the generated HTML string by adjacent start and end tags. The content of elements that are defined in the HTML 4.01 specification as "void" will be discarded, and only their start tag will be printed. | |||||||||
59 | ||||||||||
60 | =cut | |||||||||
61 | ||||||||||
62 | sub HTML (@) { | |||||||||
63 | 20 | 100 | 127 | join '', grep defined $_, map { | ||||||
64 | 17 | 17 | 1 | 2976 | ref $_ eq 'ARRAY' ? element( @$_ ) : encode_entities( $_ ) | |||||
65 | } @_; | |||||||||
66 | } | |||||||||
67 | ||||||||||
68 | =head2 element() | |||||||||
69 | ||||||||||
70 | Recursively renders HTML elements from arrayrefs | |||||||||
71 | ||||||||||
72 | =cut | |||||||||
73 | ||||||||||
74 | my %void; @void{ qw( | |||||||||
75 | area base br col command embed hr img input | |||||||||
76 | keygen link meta param source track wbr | |||||||||
77 | ) } = (1)x16; | |||||||||
78 | ||||||||||
79 | sub element { | |||||||||
80 | 12 | 12 | 1 | 29 | my ( $tag_name, $attributes, @content ) = @_; | |||||
81 | ||||||||||
82 | # If an element's name is an array ref then it's | |||||||||
83 | # really text to print without encoding | |||||||||
84 | 12 | 100 | 46 | return $tag_name->[0] if ref $tag_name eq 'ARRAY'; | ||||||
85 | ||||||||||
86 | # If the second item in the list is not a hashref, | |||||||||
87 | # then the element has no attributes | |||||||||
88 | 11 | 100 | 100 | 51 | if ( defined $attributes and ref $attributes ne 'HASH' ) { | |||||
89 | 6 | 14 | unshift @content, $attributes; | |||||||
90 | 6 | 11 | undef $attributes; | |||||||
91 | } | |||||||||
92 | ||||||||||
93 | # If the first expression in the list is false, then skip | |||||||||
94 | # the element and return its content instead | |||||||||
95 | 11 | 100 | 24 | return HTML( @content ) if not $tag_name; | ||||||
96 | ||||||||||
97 | # Return the element start tag with its formatted and | |||||||||
98 | # encoded attributes, and (optionally) content and | |||||||||
99 | # end tag | |||||||||
100 | 10 | 66 | 34 | join '', '<', $tag_name, attributes( %$attributes ), '>', | ||||||
101 | ! $void{ lc $tag_name } && ( HTML( @content ), "$tag_name>" ); | |||||||||
102 | } | |||||||||
103 | ||||||||||
104 | =head2 start_tag() | |||||||||
105 | ||||||||||
106 | Takes a list with an element name and an optional hashref defining the element's attributes, and returns just the opening tag of the element. This and end_tag() are useful in those occasions when you really want to print out HTML piecewise procedurally, rather than building the whole page in memory. | |||||||||
107 | ||||||||||
108 | =cut | |||||||||
109 | ||||||||||
110 | sub start_tag { | |||||||||
111 | 3 | 3 | 1 | 12 | my ( $tag_name, $attributes ) = @_; | |||||
112 | ||||||||||
113 | 3 | 14 | join '', grep $_, | |||||||
114 | '<', $tag_name, attributes( %$attributes ), '>'; | |||||||||
115 | } | |||||||||
116 | ||||||||||
117 | =head2 end_tag() | |||||||||
118 | ||||||||||
119 | Just takes an element name and returns the end tag for that element. | |||||||||
120 | ||||||||||
121 | =cut | |||||||||
122 | ||||||||||
123 | 1 | 1 | 1 | 5 | sub end_tag { "$_[0]>" } | |||||
124 | ||||||||||
125 | =head2 attributes() | |||||||||
126 | ||||||||||
127 | Takes a hash of HTML element attributes and returns an encoded string for use in a tag | |||||||||
128 | ||||||||||
129 | =cut | |||||||||
130 | ||||||||||
131 | sub attributes { | |||||||||
132 | ||||||||||
133 | 13 | 100 | 13 | 1 | 92 | return unless my %attributes = @_; | ||||
134 | ||||||||||
135 | 5 | 6 | my @html; | |||||||
136 | 5 | 13 | for ( keys %attributes ) { | |||||||
137 | 5 | 100 | 17 | if ( defined $attributes{$_} ) { | ||||||
138 | 4 | 19 | push @html, join '', $_, '="', encode_entities( $attributes{$_} ), '"'; | |||||||
139 | } | |||||||||
140 | } | |||||||||
141 | 5 | 101 | join ' ', '', @html; | |||||||
142 | } | |||||||||
143 | ||||||||||
144 | =head2 DOCTYPEs | |||||||||
145 | ||||||||||
146 | These make it easy to add a valid doctype declaration to your document | |||||||||
147 | ||||||||||
148 | =cut | |||||||||
149 | ||||||||||
150 | 1 | 1 | 0 | 14 | sub html_strict { << '' } | |||||
151 | ||||||||||
152 | "http://www.w3.org/TR/html4/strict.dtd"> | |||||||||
153 | ||||||||||
154 | 0 | 0 | 0 | sub html_transitional { << '' } | ||||||
155 | ||||||||||
156 | "http://www.w3.org/TR/html4/loose.dtd"> | |||||||||
157 | ||||||||||
158 | 0 | 0 | 0 | sub html_frameset { << '' } | ||||||
159 | ||||||||||
160 | "http://www.w3.org/TR/html4/frameset.dtd"> | |||||||||
161 | ||||||||||
162 | =head1 EXAMPLES | |||||||||
163 | ||||||||||
164 | Note that I've formatted the output HTML for clarity - the html() function returns it all machine-readable and compact. | |||||||||
165 | ||||||||||
166 | =head2 Simple content | |||||||||
167 | ||||||||||
168 | Strings are just encoded and printed, so | |||||||||
169 | ||||||||||
170 | print HTML 'Hi there, this & that'; | |||||||||
171 | ||||||||||
172 | would print | |||||||||
173 | ||||||||||
174 | Hi there, this & that | |||||||||
175 | ||||||||||
176 | =head2 Literal content | |||||||||
177 | ||||||||||
178 | If an element's name is an arrayref, its first item is printed without being encoded; this lets you include text that is already encoded by double-bracketing it: | |||||||||
179 | ||||||||||
180 | print HTML [ p => [[ '© Angel Networks™' ]] ]; | |||||||||
181 | ||||||||||
182 | would print | |||||||||
183 | ||||||||||
184 | © Angel Networks™ |
|||||||||
185 | ||||||||||
186 | =head2 Using map to iterate, and optional elements | |||||||||
187 | ||||||||||
188 | You can map any element over a list to iterate it, and by testing the value being mapped over can wrap some values in sub-elements: | |||||||||
189 | ||||||||||
190 | print HTML map [ p => [ $_ > 100 && 'b' => $_ ] ], 4, 450, 12, 44, 74, 102; | |||||||||
191 | ||||||||||
192 | would print | |||||||||
193 | ||||||||||
194 | 4 |
|||||||||
195 | 450 |
|||||||||
196 | 12 |
|||||||||
197 | 44 |
|||||||||
198 | 74 |
|||||||||
199 | 102 |
|||||||||
200 | ||||||||||
201 | =head2 Optional attributes | |||||||||
202 | ||||||||||
203 | Similarly, by testing the value being mapped over in the attributes hash, you can set an attribute for only some values. Note that you have to explicitly return undef to skip the attribute since 0 is a valid value for an attribute. | |||||||||
204 | ||||||||||
205 | print HTML [ select => { name => 'State' }, | |||||||||
206 | map | |||||||||
207 | [ option => { selected => $_ eq $c{state} || undef }, $_ ], | |||||||||
208 | @states | |||||||||
209 | ]; | |||||||||
210 | ||||||||||
211 | would print | |||||||||
212 | ||||||||||
213 | ||||||||||
214 | ||||||||||
215 | ||||||||||
216 | ||||||||||
217 | ... | |||||||||
218 | ||||||||||
219 | ||||||||||
220 | assuming $c{state} equalled 'Alaska'. | |||||||||
221 | ||||||||||
222 | =head2 Printing HTML tags one at a time | |||||||||
223 | ||||||||||
224 | Sometimes you really don't want to build the whole page before printing it; you'd rather loop through some data and print an element at a time. The start_tag and end_tag functions will help you do this: | |||||||||
225 | ||||||||||
226 | print start_tag( [ td => { colspan => 3 } ] ); | |||||||||
227 | print end_tag( 'td' ); | |||||||||
228 | ||||||||||
229 | would print | |||||||||
230 | ||||||||||
231 | ||||||||||
232 | ||||||||||
233 | ||||||||||
234 | =head1 SEE ALSO | |||||||||
235 | ||||||||||
236 | L |
|||||||||
237 | ||||||||||
238 | =head1 AUTHOR | |||||||||
239 | ||||||||||
240 | Nic Wolff, |
|||||||||
241 | ||||||||||
242 | =head1 BUGS | |||||||||
243 | ||||||||||
244 | Please report any bugs or feature requests through the web interface at L |
|||||||||
245 | ||||||||||
246 | =head1 SUPPORT | |||||||||
247 | ||||||||||
248 | You can find documentation for this module with the perldoc command. | |||||||||
249 | ||||||||||
250 | perldoc HTML::FromArrayref | |||||||||
251 | ||||||||||
252 | You can also look for information at: | |||||||||
253 | ||||||||||
254 | =over 4 | |||||||||
255 | ||||||||||
256 | =item * This module on GitHub | |||||||||
257 | ||||||||||
258 | L |
|||||||||
259 | ||||||||||
260 | =item * GitHub request tracker (report bugs here) | |||||||||
261 | ||||||||||
262 | L |
|||||||||
263 | ||||||||||
264 | =item * AnnoCPAN: Annotated CPAN documentation | |||||||||
265 | ||||||||||
266 | L |
|||||||||
267 | ||||||||||
268 | =item * Search CPAN | |||||||||
269 | ||||||||||
270 | L |
|||||||||
271 | ||||||||||
272 | =back | |||||||||
273 | ||||||||||
274 | =head1 LICENSE AND COPYRIGHT | |||||||||
275 | ||||||||||
276 | Copyright 2012 Nic Wolff. | |||||||||
277 | ||||||||||
278 | This program is free software; you can redistribute it and/or modify it | |||||||||
279 | under the terms of either: the GNU General Public License as published | |||||||||
280 | by the Free Software Foundation; or the Artistic License. | |||||||||
281 | ||||||||||
282 | See http://dev.perl.org/licenses/ for more information. | |||||||||
283 | ||||||||||
284 | =cut | |||||||||
285 | ||||||||||
286 | 1; # End of HTML::FromArrayref |