File Coverage

blib/lib/App/sdview/Output/HTML.pm
Criterion Covered Total %
statement 114 124 91.9
branch 11 12 91.6
condition 3 3 100.0
subroutine 19 21 90.4
pod 0 11 0.0
total 147 171 85.9


line stmt bran cond sub pod time code
1             # You may distribute under the terms of either the GNU General Public License
2             # or the Artistic License (the same terms as Perl itself)
3             #
4             # (C) Paul Evans, 2023 -- leonerd@leonerd.org.uk
5              
6 2     2   413182 use v5.26;
  2         19  
7 2     2   11 use warnings;
  2         4  
  2         64  
8              
9 2     2   661 use Object::Pad 0.800;
  2         11273  
  2         125  
10              
11             package App::sdview::Output::HTML 0.02;
12             class App::sdview::Output::HTML
13             :does(App::sdview::Output 0.13)
14 2     2   1306 :strict(params);
  2         2657  
  2         108  
15              
16 2     2   326 use constant format => "HTML";
  2         4  
  2         151  
17              
18 2     2   1204 use String::Tagged::HTML;
  2         12510  
  2         5644  
19              
20             =head1 NAME
21              
22             C - generate HTML output from L
23              
24             =head1 SYNOPSIS
25              
26             $ sdview Some/File.pod -o HTML > index.html
27              
28             =head1 DESCRIPTION
29              
30             This output module adds to L the ability to output HTML; or at
31             least, a page fragment that might be used to construct a full HTML page.
32              
33             Currently, no header or CSS is generated, only the main body content by
34             relatively simple conversion - headers to C<<

>>, C<<

>>, etc.. and

35             inline formatting within paragraphs.
36              
37             =cut
38              
39 2     2 0 83 method output_head1 ( $para ) { $self->_output_para( "h1", $para ); }
  2         9  
  2         4  
  2         3  
  2         9  
40 1     1 0 480 method output_head2 ( $para ) { $self->_output_para( "h2", $para ); }
  1         2  
  1         2  
  1         2  
  1         3  
41 0     0 0 0 method output_head3 ( $para ) { $self->_output_para( "h3", $para ); }
  0         0  
  0         0  
  0         0  
  0         0  
42 0     0 0 0 method output_head4 ( $para ) { $self->_output_para( "h4", $para ); }
  0         0  
  0         0  
  0         0  
  0         0  
43              
44 8     8 0 2952 method output_plain ( $para, $prefix = "" ) { $self->_output_para( "p", $para, $prefix ); }
  8         12  
  8         22  
  8         14  
  8         14  
  8         19  
45              
46 22         37 method _output_para ( $tag, $para, $prefix = "" )
  22         30  
  22         39  
  22         28  
  22         32  
47 22     22   36 {
48 22         58 $self->say( $prefix, $self->_convert_str( $para->text, $tag ) );
49             }
50              
51 1         4 method output_verbatim ( $para, $prefix = "" )
  1         1  
  1         3  
  1         2  
52 1     1 0 243 {
53 1         5 $self->say( "$prefix
\n" . $self->_convert_str( $para->text ), "
" );
54             }
55              
56 11         19 method output_item ( $para, $prefix = "", $tag = "li" )
  11         14  
  11         19  
  11         17  
  11         15  
57 11     11 0 22 {
58 11         26 $self->_output_para( $tag, $para, $prefix );
59             }
60              
61 3     3 0 68 method output_list_bullet ( $para, $prefix = "" ) { $self->_output_list( "ul", $para, $prefix ); }
  3         6  
  3         5  
  3         7  
  3         3  
  3         21  
62 1     1 0 34 method output_list_number ( $para, $prefix = "" ) { $self->_output_list( "ol", $para, $prefix ); }
  1         3  
  1         2  
  1         4  
  1         2  
  1         4  
63 1     1 0 37 method output_list_text ( $para, $prefix = "" ) { $self->_output_list( "dl", $para, $prefix ); }
  1         2  
  1         3  
  1         2  
  1         2  
  1         4  
64              
65 5         7 method _output_list ( $tag, $para, $prefix )
  5         9  
  5         8  
  5         8  
  5         6  
66 5     5   10 {
67 5         20 $self->say( "$prefix<$tag>" );
68              
69 5         59 foreach my $item ( $para->items ) {
70 13 100 100     1879 if( $item->type eq "item" and $para->listtype eq "text" ) {
71 3         57 $self->say( "$prefix ", $self->_convert_str( $item->term, "dt" ) );
72 3         698 $self->output_item( $item, "$prefix ", "dd" );
73             }
74             else {
75 10 50       125 my $code = $self->can( "output_" . ( $item->type =~ s/-/_/gr ) ) or
76             die "TODO: Unhandled item type " . $item->type;
77 10         106 $self->$code( $item, "$prefix " );
78             }
79             }
80              
81 5         883 $self->say( "$prefix" );
82             }
83              
84 2         7 method output_table ( $para, $prefix = "" )
  2         5  
  2         4  
  2         7  
85 2     2 0 71 {
86 2         7 my @rows = $para->rows;
87              
88 2         20 $self->say( "$prefix" ); " ); " );
89              
90 2         18 my $first = 1;
91 2         10 foreach my $row ( @rows ) {
92 4 100       28 my $celltag = $first ? "th" : "td";
93 4         10 undef $first;
94              
95 4         14 $self->say( "$prefix
96              
97 4         36 foreach my $cell ( @$row ) {
98 10 100       1362 my $align =
    100          
99             $cell->align eq "centre" ? "center" :
100             $cell->align eq "right" ? "right" :
101             undef;
102              
103 10 100       116 my $openelem = defined $align ? "<$celltag style=\"text-align: $align;\">" :
104             "<$celltag>";
105 10         32 $self->say( "$prefix $openelem", $self->_convert_str( $cell->text ), "" );
106             }
107 4         892 $self->say( "$prefix
108             }
109              
110 2         22 $self->say( "$prefix
" );
111             }
112              
113 36         49 method _convert_str ( $s, $tag = undef )
  36         55  
  36         54  
  36         51  
114 36     36   197 {
115 2         4 return String::Tagged::HTML->clone(
116             $s,
117             only_tags => [qw( bold italic monospace underline strikethrough link )],
118             convert_tags => {
119             bold => "strong",
120             italic => "em",
121             monospace => "tt",
122             underline => "u",
123             strikethrough => "s",
124             # TODO: F
125 2     2   3 link => sub ($t, $v) { a => { href => $v->{target} };
  2         8  
  2         136  
  2         3  
126             },
127             },
128 36         293 )->as_html( $tag );
129             }
130              
131             =head1 TODO
132              
133             =over 4
134              
135             =item *
136              
137             Customisable page header, CSS, general page template?
138              
139             =back
140              
141             =cut
142              
143             =head1 AUTHOR
144              
145             Paul Evans
146              
147             =cut
148              
149             0x55AA;