File Coverage

blib/lib/Text/HyperScript.pm
Criterion Covered Total %
statement 87 91 95.6
branch 20 22 90.9
condition 4 6 66.6
subroutine 14 15 93.3
pod 5 5 100.0
total 130 139 93.5


line stmt bran cond sub pod time code
1 6     6   1445408 use 5.008001;
  6         66  
2 6     6   41 use strict;
  6         13  
  6         124  
3 6     6   28 use warnings;
  6         14  
  6         317  
4              
5             package Text::HyperScript;
6              
7             our $VERSION = "0.08";
8              
9 6     6   2983 use Exporter::Lite;
  6         4457  
  6         41  
10              
11             our @EXPORT = qw(raw true false text h);
12              
13             sub raw {
14 2     2 1 96 my $html = $_[0];
15 2         12 return bless \$html, 'Text::HyperScript::NodeString';
16             }
17              
18             sub true {
19 4     4 1 102 my $true = !!1;
20 4         29 return bless \$true, 'Text::HyperScript::Boolean';
21             }
22              
23             sub false {
24 1     1 1 3 my $false = !!0;
25 1         6 return bless \$false, 'Text::HyperScript::Boolean';
26             }
27              
28             # copied from HTML::Escape::PurePerl
29             my %escape = (
30             '&' => '&',
31             '>' => '>',
32             '<' => '<',
33             q{"} => '"',
34             q{'} => ''',
35             q{`} => '`',
36             '{' => '{',
37             '}' => '}',
38             );
39              
40             sub text {
41 524     524 1 1014 my ($src) = @_;
42 524         952 $src =~ s/([&><"'`{}])/$escape{$1}/ge;
  24         82  
43 524         1220 return $src;
44             }
45              
46             sub h {
47 137     137 1 407 my $tag = text(shift);
48 137         305 my $html = qq(<${tag});
49              
50 137         223 my %attrs;
51             my @contents;
52              
53 137         257 for my $data (@_) {
54 251 100       577 if ( ref $data eq 'Text::HyperScript::NodeString' ) {
55 3         6 push @contents, ${$data};
  3         5  
56 3         6 next;
57             }
58              
59 248 100       489 if ( ref $data eq 'HASH' ) {
60 127         240 %attrs = ( %attrs, %{$data} );
  127         447  
61 127         272 next;
62             }
63              
64 121 100       215 if ( ref $data eq 'ARRAY' ) {
65 2         4 push @contents, @{$data};
  2         5  
66 2         5 next;
67             }
68              
69 119         208 push @contents, text($data);
70             }
71              
72 137         379 for my $prefix ( sort keys %attrs ) {
73 128         219 my $data = $attrs{$prefix};
74 128 100       271 if ( !ref $data ) {
75 117         213 $html .= q{ } . text($prefix) . q{="} . text($data) . q{"};
76              
77 117         258 next;
78             }
79              
80 11 100 66     35 if ( ref $data eq 'Text::HyperScript::Boolean' && ${$data} ) {
  2         58  
81 2         8 $html .= " " . text($prefix);
82              
83 2         6 next;
84             }
85              
86 9 100       20 if ( ref $data eq 'HASH' ) {
87             PREFIX:
88 7         10 for my $suffix ( sort keys %{$data} ) {
  7         18  
89 8         15 my $key = text($prefix) . '-' . text($suffix);
90 8         17 my $value = $data->{$suffix};
91              
92 8 100       17 if ( !ref $value ) {
93 5         12 $html .= qq( ${key}=") . text($value) . qq(");
94              
95 5         11 next PREFIX;
96             }
97              
98 3 100 66     11 if ( ref $value eq 'Text::HyperScript::Boolean' && ${$value} ) {
  1         5  
99 1         3 $html .= qq( ${key});
100              
101 1         2 next PREFIX;
102             }
103              
104 2 50       6 if ( ref $value eq 'ARRAY' ) {
105 2         5 $html .= qq( ${key}=") . ( join q{ }, map { text($_) } sort @{$value} ) . qq(");
  4         7  
  2         6  
106              
107 2         5 next PREFIX;
108             }
109              
110 0         0 $html .= qq( ${key}=") . text($value) . qq(");
111             }
112              
113 7         15 next;
114             }
115              
116 2 50       5 if ( ref $data eq 'ARRAY' ) {
117 2         6 $html .= q( ) . text($prefix) . q(=") . ( join q{ }, map { text($_) } sort @{$data} ) . q(");
  4         17  
  2         7  
118              
119 2         5 next;
120             }
121              
122 0         0 $html .= q{ } . text($prefix) . q(=") . text($data) . q(");
123             }
124              
125 137 100       319 if ( @contents == 0 ) {
126 14         22 $html .= " />";
127 14         104 return bless \$html, 'Text::HyperScript::NodeString';
128             }
129              
130 123         373 $html .= q(>) . join( q{}, @contents ) . qq();
131 123         1141 return bless \$html, 'Text::HyperScript::NodeString';
132             }
133              
134             package Text::HyperScript::NodeString;
135              
136 6     6   4954 use overload q("") => \&to_string;
  6         13  
  6         56  
137              
138             sub new {
139 0     0   0 my ( $class, $html ) = @_;
140 0         0 return bless \$html, $class;
141             }
142              
143             sub to_string {
144 137     137   80176 return ${ $_[0] };
  137         697  
145             }
146              
147             package Text::HyperScript::Boolean;
148              
149 6     6   973 use overload ( q(bool) => \&is_true, q(==) => \&is_true );
  6         23  
  6         42  
150              
151             sub is_true {
152 4     4   14 return !!${ $_[0] };
  4         50  
153             }
154              
155             sub is_false {
156 2     2   5 return !${ $_[0] };
  2         12  
157             }
158              
159             package Text::HyperScript;
160              
161             1;
162              
163             =encoding utf-8
164              
165             =head1 NAME
166              
167             Text::HyperScript - Let's write html/xml templates as perl code!
168              
169             =head1 SYNOPSIS
170              
171             use feature qw(say);
172             use Text::HyperScript qw(h true);
173              
174             # tag only
175             say h('hr'); # => '
'
176             say h(script => q{}); # => ''
177              
178             # tag with content
179             say h('p', 'hi,'); # => '

hi,

'
180             say h('p', ['hi,']); # => '

hi,

'
181              
182             say h('p', 'hi', h('b', ['anonymous'])); # => '

hi,anonymous

'
183             say h('p', 'foo', ['bar'], 'baz'); # => '

foobarbarz

'
184              
185             # tag with attributes
186             say h('hr', { id => 'foo' }); # => '
'
187             say h('hr', { id => 'foo', class => 'bar'}); # => '
'
188             say h('hr', { class => ['foo', 'bar', 'baz'] }); # => '
'
189              
190             # tag with prefixed attributes
191             say h('hr', { data => { foo => 'bar' } }); # => '
'
192             say h('hr', { data => { foo => [qw(foo bar baz)] } }); # => '
'
193              
194             # tag with value-less attribute
195             say h('script', { crossorigin => true }, ""); #
196              
197             =head1 DESCRIPTION
198              
199             This module is a html/xml tags generator like as hyperscript-ish style.
200              
201             =head1 FEATURES
202              
203             =over
204              
205             =item All html/xml tags write as perl code!
206              
207             We're able to write html/xml templates witout raw markup.
208              
209             =item Generates automatic escaped html/xml tags
210              
211             This module generates automatic escaped html/xml tags by default.
212              
213             Like this:
214              
215             use feature qw(say);
216            
217             say h('p', 'hello, ')
218             # =>

hello, <scrip>alert("XSS!")</script>

219              
220             =item Includes shorthand for multiple class name and prefixed attributes
221              
222             This module has shorthand multiple class name, and data or aria and others prefixed attributes.
223              
224             For examples:
225              
226             use feature qw(say);
227            
228             say h('h1', { class => [qw/ C B A /] }, 'msg');
229             # =>

msg

230            
231             say h('button', { data => { click => '1' } }, 'label');
232             # =>
233            
234             say h('a', { href => '#', aria => {label => 'label' } }, 'link');
235             # => link
236              
237             =item Enable to generate empty and empty content tags
238              
239             This module supports empty element and empty content tags.
240              
241             Like that:
242              
243             use feature qw(say);
244            
245             say h('hr'); # empty tag
246             # =>
247            
248             say h('script', '') # empty content tag
249             # =>
250              
251             =back
252              
253             =head1 TAGSETS
254              
255             This modules includes shorthand modules for writes tag name as subroutine.
256              
257             Currently Supported:
258              
259             HTML5: L
260              
261             =head1 MODULE FUNCTIONS
262              
263             =head2 text
264              
265             This function generates html/xml escaped text.
266              
267             =head2 raw
268              
269             This function generates raw text B.
270              
271             This function B.
272              
273             =head2 true / false (constants)
274              
275             This constants use for value-less attributes.
276              
277             For examples, if we'd like to use C attriute on C
284              
285             C constants exists for override value-less attributes.
286             If set C to value-less attribute, that attribute ignored.
287              
288             =head2 h
289              
290             This function makes html/xml text from perl code.
291              
292             The first argument is tag name, and after argument could be passed these values as repeatable.
293              
294             NOTICE:
295              
296             The all element attributes sorted by ascendant.
297              
298             This behaviour is intentional for same result of reproducible output.
299              
300             =over
301              
302             =item $text : Str
303              
304             The text string uses as a element content.
305              
306             For example:
307              
308             use feature qw(say);
309              
310             say h('p', 'hi,') # <- 'hi,' is a plain text string
311             # =>

hi,

312              
313             =item \%attributes : HashRef[Str | ArrayRef[Str] | HashRef[Str] ]
314              
315             The element attributes could be defined by these styles:
316              
317             =over
318              
319             =item \%attributes contains Str
320              
321             In this case, Str value uses for single value of attribute.
322              
323             use feature qw(say);
324            
325             say h('p', { id => 'msg' }, 'hi,')
326             # =>

hi,

327              
328             =item \%attributes contains ArrayRef[Str]
329              
330             If attribute is ArrayRef[Str], these Str values joined by whitespace and sorted ascendant.
331              
332             use feature qw(say);
333            
334             say h('p', { class => [qw/ foo bar baz /] }, 'hi,')
335             # =>

hi,

336              
337             =item HashRef[Str]
338              
339             If attribute is HashRef[Str], this code means shorthand for prefixed attribute.
340              
341             use feature qw(say);
342              
343             say h('p', { data => { label => 'foo' } }, 'hi,')
344             # =>

345              
346             =back
347              
348             =item \@nested : ArrayRef
349              
350             The all ArrayRef passed to C function is flatten by internally.
351              
352             This ArrayRef supported all content type of C function.
353              
354             =back
355              
356             =head1 LICENSE
357              
358             Copyright (C) OKAMURA Naoki a.k.a nyarla.
359              
360             This library is free software; you can redistribute it and/or modify
361             it under the same terms as Perl itself.
362              
363             =head1 AUTHOR
364              
365             OKAMURA Naoki a.k.a nyarla: Enyarla@kalaclista.comE
366              
367             =cut