File Coverage

blib/lib/App/sdview/Output/Pod.pm
Criterion Covered Total %
statement 105 115 91.3
branch 23 26 88.4
condition n/a
subroutine 16 18 88.8
pod 0 9 0.0
total 144 168 85.7


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, 2021-2023 -- leonerd@leonerd.org.uk
5              
6 2     2   1009 use v5.26;
  2         7  
7 2     2   13 use warnings;
  2         4  
  2         67  
8              
9 2     2   11 use Object::Pad 0.800;
  2         32  
  2         91  
10              
11             package App::sdview::Output::Pod 0.11;
12             class App::sdview::Output::Pod
13             :does(App::sdview::Output)
14 2     2   1233 :strict(params);
  2         5  
  2         94  
15              
16 2     2   323 use constant format => "POD";
  2         12  
  2         5491  
17              
18             =head1 NAME
19              
20             C - generate POD output from L
21              
22             =head1 SYNOPSIS
23              
24             $ sdview README.md -o POD > README.pod
25              
26             =head1 DESCRIPTION
27              
28             This output module adds to L the ability to output text in POD
29             formatting. Given a POD file as input, the output should be relatively
30             similar, up to minor details like whitespacing. Given input in some other
31             format, it will do a reasonable job attempting to represent most of the
32             structure and formatting.
33              
34             =cut
35              
36             field $_printed_pod;
37              
38 2     2 0 4 method output_head1 ( $para ) { $self->_output_head( "=head1", $para ); }
  2         6  
  2         4  
  2         2  
  2         11  
39 1     1 0 9 method output_head2 ( $para ) { $self->_output_head( "=head2", $para ); }
  1         3  
  1         2  
  1         1  
  1         7  
40 0     0 0 0 method output_head3 ( $para ) { $self->_output_head( "=head3", $para ); }
  0         0  
  0         0  
  0         0  
  0         0  
41 0     0 0 0 method output_head4 ( $para ) { $self->_output_head( "=head4", $para ); }
  0         0  
  0         0  
  0         0  
  0         0  
42              
43 3         6 method _output_head ( $leader, $para )
  3         5  
  3         4  
  3         4  
44 3     3   8 {
45 3         10 $self->maybe_blank;
46              
47 3         18 $self->say( $leader, " ", $self->_convert_str( $para->text ) );
48 3         13 $_printed_pod = 1;
49             }
50              
51 5         7 method output_plain ( $para )
  5         11  
  5         8  
52 5     5 0 23 {
53 5 100       26 $self->say( "=pod" ), $_printed_pod = 1 unless $_printed_pod;
54 5         14 $self->maybe_blank;
55              
56 5         15 $self->say( $self->_convert_str( $para->text ) );
57             }
58              
59 1         3 method output_verbatim ( $para )
  1         2  
  1         2  
60 1     1 0 3 {
61 1 50       3 $self->say( "=pod" ), $_printed_pod = 1 unless $_printed_pod;
62 1         3 $self->maybe_blank;
63              
64 1         5 $self->say( " ", $_ ) for split m/\n/, $para->text;
65             }
66              
67 1     1 0 3 method output_list_bullet ( $para ) { $self->_output_list( $para ); }
  1         2  
  1         2  
  1         1  
  1         4  
68 1     1 0 3 method output_list_number ( $para ) { $self->_output_list( $para ); }
  1         2  
  1         2  
  1         2  
  1         3  
69 1     1 0 3 method output_list_text ( $para ) { $self->_output_list( $para ); }
  1         3  
  1         6  
  1         2  
  1         5  
70              
71 3         6 method _output_list ( $para )
  3         4  
  3         4  
72 3     3   5 {
73 3         10 $self->maybe_blank;
74              
75 3         9 $self->say( "=over ", $para->indent );
76 3         12 $self->say;
77              
78 3         12 my @items = $para->items;
79 3         11 foreach my $idx ( 0 .. $#items ) {
80 10         21 my $item = $items[$idx];
81              
82 10 100       36 if( $item->type ne "item" ) {
    100          
    100          
    50          
83             # Non-item has no leader
84             }
85             elsif( $para->listtype eq "bullet" ) {
86 3         10 $self->say( "=item *" );
87 3         7 $self->say;
88             }
89             elsif( $para->listtype eq "number" ) {
90 3         18 $self->say( sprintf "=item %d.", $idx + 1 );
91 3         8 $self->say;
92             }
93             elsif( $para->listtype eq "text" ) {
94 3         17 $self->say( sprintf "=item %s", $self->_convert_str( $item->term ) );
95 3         9 $self->say;
96             }
97              
98 10         30 $self->say( $self->_convert_str( $item->text ) );
99 10         31 $self->say;
100             }
101              
102 3         8 $self->say( "=back" );
103             }
104              
105 21         26 method _convert_str ( $s )
  21         32  
  21         31  
106 21     21   38 {
107 21         31 my $ret = "";
108              
109             # TODO: This sucks for nested tags
110 27         42 $s->iter_substr_nooverlap(
111 27     27   33 sub ( $substr, %tags ) {
  27         1575  
  27         36  
112             # Escape any literal '<'s that would otherwise break
113 27         56 my $pod = $substr =~ s/[A-Z]\K/gr;
114              
115 27         66 my $count = 1;
116 27         103 $count++ while index( $pod, ">"x$count ) > -1;
117              
118 27 100       75 my ( $open, $close ) =
119             ( $count == 1 ) ? ( "<", ">" ) : ( "<"x$count . " ", " " . ">"x$count );
120              
121 27 100       59 if( my $link = $tags{L} ) {
122             # TODO: This is even suckier than the bit in the parser
123 2 100       18 if( $link->{target} eq "https://metacpan.org/pod/$substr" ) {
124 1         2 $pod = "L$open$substr$close";
125             }
126             else {
127 1         20 $pod = "L$open$pod|$link->{target}$close";
128             }
129             }
130              
131 27 100       78 $pod = "C$open$pod$close" if $tags{C};
132 27 100       50 $pod = "B$open$pod$close" if $tags{B};
133 27 100       52 $pod = "I$open$pod$close" if $tags{I};
134 27 50       51 $pod = "F$open$pod$close" if $tags{F};
135              
136 27         82 $ret .= $pod;
137             }
138 21         159 );
139              
140 21         378 return $ret;
141             }
142              
143             =head1 TODO
144              
145             =over 4
146              
147             =item *
148              
149             Some handling of tables. POD does not (currently?) support tables, but at
150             least we could emit some kind of plain-text rendering of the contents.
151              
152             =back
153              
154             =cut
155              
156             =head1 AUTHOR
157              
158             Paul Evans
159              
160             =cut
161              
162             0x55AA;