File Coverage

blib/lib/Markdent/Role/HTMLStream.pm
Criterion Covered Total %
statement 82 180 45.5
branch 3 22 13.6
condition 0 3 0.0
subroutine 29 60 48.3
pod 0 46 0.0
total 114 311 36.6


line stmt bran cond sub pod time code
1             package Markdent::Role::HTMLStream;
2              
3 34     34   28108 use strict;
  34         98  
  34         1228  
4 34     34   203 use warnings;
  34         112  
  34         1157  
5 34     34   207 use namespace::autoclean;
  34         81  
  34         254  
6              
7             our $VERSION = '0.40';
8              
9 34     34   21723 use HTML::Entities qw( encode_entities );
  34         214067  
  34         4351  
10 34     34   18262 use Markdent::CheckedOutput;
  34         104  
  34         1144  
11 34     34   1532 use Markdent::Types;
  34         82  
  34         313  
12 34     34   900280 use Params::ValidationCompiler qw( validation_for );
  34         544917  
  34         2587  
13              
14 34     34   363 use Moose::Role;
  34         87  
  34         471  
15              
16             with 'Markdent::Role::EventsAsMethods';
17              
18             requires qw( start_document end_document );
19              
20             has _output => (
21             is => 'ro',
22             isa => t('OutputStream'),
23             required => 1,
24             init_arg => 'output',
25             );
26              
27             has _encodable_entities => (
28             is => 'ro',
29             isa => t('Str'),
30             default => q{<>&"\x00-\x09\x11\x12\x14-\x1f},
31             init_arg => 'encodable_entities',
32             );
33              
34             override BUILDARGS => sub {
35             my $self = shift;
36              
37             my $args = super();
38              
39             my $output = $args->{output};
40              
41             # This will blow up soon if there's no output.
42             return $args unless $output;
43              
44             # If the user supplied a non IO::Handle object we won't wrap it.
45             return $args if blessed $output && !$output->isa('IO::Handle');
46              
47             $args->{output} = Markdent::CheckedOutput->new($output);
48              
49             return $args;
50             };
51              
52             {
53             my $validator = validation_for(
54             params => [
55             level => { type => t('HeaderLevel') },
56             ],
57             named_to_list => 1,
58             );
59              
60             sub start_header {
61 3     3 0 6 my $self = shift;
62 3         61 my ($level) = $validator->(@_);
63              
64 3         100 $self->_stream_start_tag( 'h' . $level );
65             }
66             }
67              
68             {
69             my $validator = validation_for(
70             params => [
71             level => { type => t('HeaderLevel') },
72             ],
73             named_to_list => 1,
74             );
75              
76             sub end_header {
77 3     3 0 8 my $self = shift;
78 3         64 my ($level) = $validator->(@_);
79              
80 3         99 $self->_stream_end_tag( 'h' . $level );
81             }
82             }
83              
84             sub start_blockquote {
85 0     0 0 0 my $self = shift;
86              
87 0         0 $self->_stream_start_tag('blockquote');
88             }
89              
90             sub end_blockquote {
91 0     0 0 0 my $self = shift;
92              
93 0         0 $self->_stream_end_tag('blockquote');
94             }
95              
96             sub start_unordered_list {
97 3     3 0 9 my $self = shift;
98              
99 3         13 $self->_stream_start_tag('ul');
100             }
101              
102             sub end_unordered_list {
103 3     3 0 9 my $self = shift;
104              
105 3         13 $self->_stream_end_tag('ul');
106             }
107              
108             sub start_ordered_list {
109 0     0 0 0 my $self = shift;
110              
111 0         0 $self->_stream_start_tag('ol');
112             }
113              
114             sub end_ordered_list {
115 0     0 0 0 my $self = shift;
116              
117 0         0 $self->_stream_end_tag('ol');
118             }
119              
120             sub start_list_item {
121 6     6 0 17 my $self = shift;
122              
123 6         18 $self->_stream_start_tag('li');
124             }
125              
126             sub end_list_item {
127 6     6 0 28 my $self = shift;
128              
129 6         21 $self->_stream_end_tag('li');
130             }
131              
132             {
133             my $validator = validation_for(
134             params => [
135             code => { type => t('Str') },
136             language => {
137             type => t('Str'),
138             optional => 1,
139             },
140             ],
141             named_to_list => 1,
142             );
143              
144             sub code_block {
145 0     0 0 0 my $self = shift;
146 0         0 my ( $code, $language ) = $validator->(@_);
147              
148 0         0 $self->_stream_start_tag('pre');
149              
150 0 0       0 my %class = $language ? ( class => 'language-' . $language ) : ();
151 0         0 $self->_stream_start_tag( 'code', \%class );
152              
153 0         0 $self->_stream_text($code);
154              
155 0         0 $self->_stream_end_tag('code');
156 0         0 $self->_stream_end_tag('pre');
157             }
158             }
159              
160             {
161             my $validator = validation_for(
162             params => [
163             text => { type => t('Str') },
164             ],
165             named_to_list => 1,
166             );
167              
168             sub preformatted {
169 0     0 0 0 my $self = shift;
170 0         0 my ($text) = $validator->(@_);
171              
172 0         0 $self->_stream_start_tag('pre');
173 0         0 $self->_stream_start_tag('code');
174 0         0 $self->_stream_text($text);
175 0         0 $self->_stream_end_tag('code');
176 0         0 $self->_stream_end_tag('pre');
177             }
178             }
179              
180             sub start_paragraph {
181 9     9 0 20 my $self = shift;
182              
183 9         34 $self->_stream_start_tag('p');
184             }
185              
186             sub end_paragraph {
187 7     7 0 15 my $self = shift;
188              
189 7         23 $self->_stream_end_tag('p');
190             }
191              
192             {
193             my $validator = validation_for(
194             params => [
195             caption => {
196             type => t('Str'),
197             optional => 1,
198             },
199             ],
200             named_to_list => 1,
201             );
202              
203             sub start_table {
204 0     0 0 0 my $self = shift;
205 0         0 my ($caption) = $validator->(@_);
206              
207 0         0 $self->_stream_start_tag('table');
208              
209 0 0 0     0 if ( defined $caption && length $caption ) {
210 0         0 $self->_stream_start_tag('caption');
211 0         0 $self->_stream_text($caption);
212 0         0 $self->_stream_end_tag('caption');
213             }
214             }
215             }
216              
217             sub end_table {
218 0     0 0 0 my $self = shift;
219              
220 0         0 $self->_stream_end_tag('table');
221             }
222              
223             sub start_table_header {
224 0     0 0 0 my $self = shift;
225              
226 0         0 $self->_stream_start_tag('thead');
227             }
228              
229             sub end_table_header {
230 0     0 0 0 my $self = shift;
231              
232 0         0 $self->_stream_end_tag('thead');
233             }
234              
235             sub start_table_body {
236 0     0 0 0 my $self = shift;
237              
238 0         0 $self->_stream_start_tag('tbody');
239             }
240              
241             sub end_table_body {
242 0     0 0 0 my $self = shift;
243              
244 0         0 $self->_stream_end_tag('tbody');
245             }
246              
247             sub start_table_row {
248 0     0 0 0 my $self = shift;
249              
250 0         0 $self->_stream_start_tag('tr');
251             }
252              
253             sub end_table_row {
254 0     0 0 0 my $self = shift;
255              
256 0         0 $self->_stream_end_tag('tr');
257             }
258              
259             {
260             my $validator = validation_for(
261             params => [
262             alignment => {
263             type => t('TableCellAlignment'),
264             optional => 1,
265             },
266             colspan => { type => t('PositiveInt') },
267             is_header_cell => { type => t('Bool') },
268             ],
269             named_to_list => 1,
270             );
271              
272             sub start_table_cell {
273 0     0 0 0 my $self = shift;
274 0         0 my ( $alignment, $colspan, $is_header ) = $validator->(@_);
275              
276 0 0       0 my $tag = $is_header ? 'th' : 'td';
277              
278 0         0 my %attr;
279 0 0       0 $attr{style} = "text-align: $alignment"
280             if $alignment;
281              
282 0 0       0 $attr{colspan} = $colspan
283             if $colspan != 1;
284              
285 0         0 $self->_stream_start_tag( $tag, \%attr );
286             }
287             }
288              
289             {
290             my $validator = validation_for(
291             params => [
292             is_header_cell => { type => t('Bool') },
293             ],
294             named_to_list => 1,
295             );
296              
297             sub end_table_cell {
298 0     0 0 0 my $self = shift;
299 0         0 my ($is_header) = $validator->(@_);
300              
301 0 0       0 $self->_stream_end_tag( $is_header ? 'th' : 'td' );
302             }
303             }
304              
305             sub start_emphasis {
306 3     3 0 8 my $self = shift;
307              
308 3         12 $self->_stream_start_tag('em');
309             }
310              
311             sub end_emphasis {
312 3     3 0 8 my $self = shift;
313              
314 3         14 $self->_stream_end_tag('em');
315             }
316              
317             sub start_strong {
318 3     3 0 7 my $self = shift;
319              
320 3         14 $self->_stream_start_tag('strong');
321             }
322              
323             sub end_strong {
324 3     3 0 8 my $self = shift;
325              
326 3         9 $self->_stream_end_tag('strong');
327             }
328              
329             sub start_strikethrough {
330 0     0 0 0 my $self = shift;
331              
332 0         0 $self->_stream_start_tag('del');
333             }
334              
335             sub end_strikethrough {
336 0     0 0 0 my $self = shift;
337              
338 0         0 $self->_stream_end_tag('del');
339             }
340              
341             sub start_code {
342 0     0 0 0 my $self = shift;
343              
344 0         0 $self->_stream_start_tag('code');
345             }
346              
347             sub end_code {
348 0     0 0 0 my $self = shift;
349              
350 0         0 $self->_stream_end_tag('code');
351             }
352              
353             {
354             my $validator = validation_for(
355             params => [
356             uri => { type => t('Str') },
357             ],
358             named_to_list => 1,
359             );
360              
361             sub auto_link {
362 0     0 0 0 my $self = shift;
363 0         0 my ($uri) = $validator->(@_);
364              
365 0         0 $self->_stream_start_tag( 'a', { href => $uri } );
366 0         0 $self->_stream_text($uri);
367 0         0 $self->_stream_end_tag('a');
368             }
369             }
370              
371             {
372             my $validator = validation_for(
373             params => {
374             uri => { type => t('Str') },
375             title => {
376             type => t('Str'),
377             optional => 1,
378             },
379             id => {
380             type => t('Str'),
381             optional => 1,
382             },
383             is_implicit_id => {
384             type => t('Bool'),
385             optional => 1,
386             },
387             }
388             );
389              
390             sub start_link {
391 0     0 0 0 my $self = shift;
392 0         0 my %p = $validator->(@_);
393              
394 0         0 delete @p{ grep { !defined $p{$_} } keys %p };
  0         0  
395              
396             $self->_stream_start_tag(
397             'a', {
398             href => $p{uri},
399 0 0       0 exists $p{title} ? ( title => $p{title} ) : (),
400             },
401             );
402             }
403             }
404              
405             sub end_link {
406 0     0 0 0 my $self = shift;
407              
408 0         0 $self->_stream_end_tag('a');
409             }
410              
411             sub line_break {
412 0     0 0 0 my $self = shift;
413              
414 0         0 $self->_stream_start_tag('br');
415             }
416              
417             {
418             my $validator = validation_for(
419             params => [
420             text => { type => t('Str') },
421             ],
422             named_to_list => 1,
423             );
424              
425             sub text {
426 29     29 0 55 my $self = shift;
427 29         498 my ($text) = $validator->(@_);
428              
429 29         697 $self->_stream_text($text);
430             }
431             }
432              
433             {
434             my $validator = validation_for(
435             params => [
436             tag => { type => t('Str') },
437             attributes => { type => t('HashRef') },
438             ],
439             named_to_list => 1,
440             );
441              
442             sub start_html_tag {
443 1     1 0 3 my $self = shift;
444 1         24 my ( $tag, $attributes ) = $validator->(@_);
445              
446 1         47 $self->_stream_start_tag( $tag, $attributes );
447             }
448             }
449              
450             {
451             my $validator = validation_for(
452             params => [
453             text => { type => t('Str') },
454             ],
455             named_to_list => 1,
456             );
457              
458             sub html_comment_block {
459 0     0 0 0 my $self = shift;
460 0         0 my ($text) = $validator->(@_);
461              
462 0         0 $self->_stream_raw( '<!--' . $text . '-->' . "\n" );
463             }
464             }
465              
466             {
467             my $validator = validation_for(
468             params => [
469             text => { type => t('Str') },
470             ],
471             named_to_list => 1,
472             );
473              
474             sub html_comment {
475 0     0 0 0 my $self = shift;
476 0         0 my ($text) = $validator->(@_);
477              
478 0         0 $self->_stream_raw( '<!--' . $text . '-->' );
479             }
480             }
481              
482             {
483             my $validator = validation_for(
484             params => [
485             tag => { type => t('Str') },
486             attributes => { type => t('HashRef') },
487             ],
488             named_to_list => 1,
489             );
490              
491             sub html_tag {
492 0     0 0 0 my $self = shift;
493 0         0 my ( $tag, $attributes ) = $validator->(@_);
494              
495 0         0 $self->_stream_start_tag( $tag, $attributes );
496             }
497             }
498              
499             {
500             my $validator = validation_for(
501             params => [
502             tag => { type => t('Str') },
503             ],
504             named_to_list => 1,
505             );
506              
507             sub end_html_tag {
508 1     1 0 4 my $self = shift;
509 1         27 my ($tag) = $validator->(@_);
510              
511 1         33 $self->_stream_end_tag($tag);
512             }
513             }
514              
515             {
516             my $validator = validation_for(
517             params => [
518             entity => { type => t('Str') },
519             ],
520             named_to_list => 1,
521             );
522              
523             sub html_entity {
524 0     0 0 0 my $self = shift;
525 0         0 my ($entity) = $validator->(@_);
526              
527 0         0 $self->_stream_raw( '&' . $entity . ';' );
528             }
529             }
530              
531             {
532             my $validator = validation_for(
533             params => [
534             html => { type => t('Str') },
535             ],
536             named_to_list => 1,
537             );
538              
539             sub html_block {
540 0     0 0 0 my $self = shift;
541 0         0 my ($html) = $validator->(@_);
542              
543 0         0 $self->_output->print($html);
544             }
545             }
546              
547             {
548             my $validator = validation_for(
549             params => {
550             alt_text => { type => t('Str') },
551             uri => {
552             type => t('Str'),
553             optional => 1,
554             },
555             title => {
556             type => t('Str'),
557             optional => 1,
558             },
559             id => {
560             type => t('Str'),
561             optional => 1,
562             },
563             is_implicit_id => {
564             type => t('Bool'),
565             optional => 1,
566             },
567             },
568             );
569              
570             sub image {
571 0     0 0 0 my $self = shift;
572 0         0 my %p = $validator->(@_);
573              
574 0         0 delete @p{ grep { !defined $p{$_} } keys %p };
  0         0  
575              
576             $self->_stream_start_tag(
577             'img', {
578             src => $p{uri},
579             ( exists $p{alt_text} ? ( alt => $p{alt_text} ) : () ),
580 0 0       0 ( exists $p{title} ? ( title => $p{title} ) : () ),
    0          
581             },
582             );
583             }
584             }
585              
586             sub horizontal_rule {
587 0     0 0 0 my $self = shift;
588              
589 0         0 $self->_stream_start_tag('hr');
590             }
591              
592             sub _stream_start_tag {
593 32     32   56 my $self = shift;
594 32         64 my $tag = shift;
595 32         53 my $attr = shift;
596              
597             $self->_output->print(
598             '<'
599             . $tag
600             . (
601 32 100       941 keys %{$attr}
  32         177  
602             ? q{ } . $self->_attributes($attr)
603             : q{}
604             )
605             . '>'
606             );
607             }
608              
609             sub _stream_end_tag {
610 30     30   49 my $self = shift;
611 30         76 my $tag = shift;
612              
613 30         957 $self->_output->print( '</' . $tag . '>' );
614             }
615              
616             sub _stream_text {
617 30     30   54 my $self = shift;
618              
619 30         865 $self->_output->print(
620             encode_entities(
621             shift,
622             $self->_encodable_entities,
623             )
624             );
625             }
626              
627             sub _stream_raw {
628 1     1   2 my $self = shift;
629              
630 1         34 $self->_output->print(shift);
631             }
632              
633             sub _attributes {
634 1     1   2 my $self = shift;
635 1         3 my $attr = shift;
636              
637             return join q{ },
638 2         52 map { $self->_attribute( $_, $attr->{$_} ) }
639 1         2 sort { $a cmp $b } keys %{$attr};
  1         7  
  1         8  
640             }
641              
642             sub _attribute {
643 2     2   4 my $self = shift;
644 2         5 my $key = shift;
645 2         4 my $value = shift;
646              
647 2 50       7 return $key unless defined $value;
648              
649 2         65 return join '=', $key,
650             q{"} . encode_entities(
651             $value,
652             $self->_encodable_entities,
653             ) . q{"};
654             }
655              
656             1;
657              
658             # ABSTRACT: A role for handlers which generate HTML
659              
660             __END__
661              
662             =pod
663              
664             =encoding UTF-8
665              
666             =head1 NAME
667              
668             Markdent::Role::HTMLStream - A role for handlers which generate HTML
669              
670             =head1 VERSION
671              
672             version 0.40
673              
674             =head1 DESCRIPTION
675              
676             This role implements most of the code needed for event receivers which generate
677             a stream of HTML output based on those events.
678              
679             =head1 REQUIRED METHODS
680              
681             This role requires that consuming classes implement two methods, C<<
682             $handler->start_document >> and C<< $handler->end_document >>.
683              
684             =head1 ROLES
685              
686             This role does the L<Markdent::Role::EventsAsMethods> and
687             L<Markdent::Role::Handler> roles.
688              
689             =head1 BUGS
690              
691             See L<Markdent> for bug reporting details.
692              
693             Bugs may be submitted at L<https://github.com/houseabsolute/Markdent/issues>.
694              
695             I am also usually active on IRC as 'autarch' on C<irc://irc.perl.org>.
696              
697             =head1 SOURCE
698              
699             The source code repository for Markdent can be found at L<https://github.com/houseabsolute/Markdent>.
700              
701             =head1 AUTHOR
702              
703             Dave Rolsky <autarch@urth.org>
704              
705             =head1 COPYRIGHT AND LICENSE
706              
707             This software is copyright (c) 2021 by Dave Rolsky.
708              
709             This is free software; you can redistribute it and/or modify it under
710             the same terms as the Perl 5 programming language system itself.
711              
712             The full text of the license can be found in the
713             F<LICENSE> file included with this distribution.
714              
715             =cut