File Coverage

blib/lib/App/sdview/Parser/Pod.pm
Criterion Covered Total %
statement 91 110 82.7
branch 38 42 90.4
condition 20 24 83.3
subroutine 15 17 88.2
pod 1 5 20.0
total 165 198 83.3


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-2022 -- leonerd@leonerd.org.uk
5              
6 7     7   742305 use v5.26;
  7         47  
7 7     4   140 use warnings;
  4         8  
  4         134  
8              
9 4     4   1915 use Object::Pad 0.800;
  4         26104  
  4         280  
10              
11             package App::sdview::Parser::Pod 0.11;
12             class App::sdview::Parser::Pod
13             :isa(Pod::Simple)
14             :does(App::sdview::Parser)
15 4     4   3473 :strict(params);
  4         126481  
  4         272  
16              
17 4     4   2984 use List::Keywords qw( any );
  4         6832  
  4         23  
18 4     4   271 use List::Util qw( min );
  4         9  
  4         304  
19              
20 4     4   33 use String::Tagged;
  4         7  
  4         135  
21              
22 4     4   33 use constant format => "POD";
  4         8  
  4         346  
23 4     4   31 use constant sort_order => 10;
  4         10  
  4         13658  
24              
25 0         0 sub find_file ( $class, $name )
26 0     0 0 0 {
  0         0  
  0         0  
27             # We could use `perldoc -l` but it's slow and noisy when it fails
28              
29 0         0 my $filebase = $name =~ s(::)(/)gr;
30              
31 0         0 foreach my $dir ( @INC ) {
32             # .pod should take precedence over .pm
33 0         0 foreach my $file ( "$dir/$filebase.pod", "$dir/$filebase.pm" ) {
34 0 0       0 -r $file and return $file;
35             }
36             }
37              
38 0         0 return undef;
39             }
40              
41 2         5 sub can_parse_file ( $class, $file )
42 2     2 0 7068 {
  2         5  
  2         3  
43 2         19 return $file =~ m/\.pm$|\.pl$|\.pod$/;
44             }
45              
46             ADJUST
47             {
48             $self->nix_X_codes( 1 );
49             }
50              
51             field @_indentstack;
52             field @_parastack;
53              
54             field %_curtags;
55             field $_curpara;
56              
57 0         0 method parse_file ( $fh )
  0         0  
  0         0  
58 0     0 1 0 {
59 0         0 push @_indentstack, 0;
60 0         0 push @_parastack, [];
61 0         0 $self->SUPER::parse_file( $fh );
62 0         0 return $_parastack[0]->@*;
63             }
64              
65 20         38 method parse_string ( $str )
  20         36  
  20         38  
66 20     20 0 244 {
67 20         43 push @_indentstack, 0;
68 20         39 push @_parastack, [];
69 20         90 $self->SUPER::parse_string_document ( $str );
70 20         292 return $_parastack[0]->@*;
71             }
72              
73             my %PARA_TYPES = (
74             Para => "App::sdview::Para::Plain",
75             Verbatim => "App::sdview::Para::Verbatim",
76             );
77             my @FORMAT_TYPES = qw( B I F C L );
78              
79 126         195 method _handle_element_start ( $type, $attrs )
  126         199  
  126         188  
  126         183  
80 126     126   28920 {
81 126 100 100     868 if( $type eq "Document" ) {
    100 100        
    100 66        
    100 100        
    100          
    100          
    100          
    100          
    100          
    50          
82 20         88 %_curtags = ();
83             }
84             elsif( $type =~ m/^head(\d+)$/ ) {
85 9         56 push $_parastack[-1]->@*, $_curpara = App::sdview::Para::Heading->new(
86             level => $1,
87             text => String::Tagged->new,
88             );
89 9         302 %_curtags = ();
90             }
91             elsif( $type eq "Para" and $_curpara and
92             $_curpara->type eq "item" and $_curpara->listtype eq "text" and !length $_curpara->text ) {
93 9         71 %_curtags = ();
94             }
95             elsif( my $class = $PARA_TYPES{$type} ) {
96 23         111 push $_parastack[-1]->@*, $_curpara = $class->new(
97             text => String::Tagged->new,
98             indent => $_indentstack[-1],
99             );
100 23         345 %_curtags = ();
101             }
102             elsif( $type eq "L" ) {
103 6         17 my $target = $attrs->{to};
104             # TODO: more customizable
105 6 100 66     32 if( defined $target and $target !~ m(^\w+://) ) {
106 3         62 $target = "https://metacpan.org/pod/$target";
107             }
108 6         137 $_curtags{L} = { target => $target };
109             }
110 248         673 elsif( any { $type eq $_ } @FORMAT_TYPES ) {
111 18         61 ++$_curtags{$type};
112             }
113             elsif( $type eq "over-block" ) {
114 1         6 push @_indentstack, $_indentstack[-1] + $attrs->{indent};
115             }
116             elsif( $type =~ m/^over-(.*)/ ) {
117             push $_parastack[-1]->@*, App::sdview::Para::List->new(
118             listtype => $1,
119             indent => $_indentstack[-1] + $attrs->{indent},
120 11         133 );
121 11         27 push @_parastack, [];
122 11         37 undef $_curpara;
123             }
124             elsif( $type eq "item-text" ) {
125 9         60 push $_parastack[-1]->@*, $_curpara = App::sdview::Para::ListItem->new(
126             listtype => "text",
127             term => String::Tagged->new,
128             text => String::Tagged->new,
129             );
130             }
131             elsif( $type =~ m/^item-(.*)/ ) {
132 20         105 push $_parastack[-1]->@*, $_curpara = App::sdview::Para::ListItem->new(
133             listtype => "$1",
134             text => String::Tagged->new,
135             );
136             }
137             else {
138 0         0 print STDERR "START $type\n";
139             }
140             }
141              
142 126         197 method _handle_element_end ( $type, @ )
  126         199  
  126         167  
143 126     126   6275 {
144 126 100       471 if( $type eq "Document" ) {
    100          
    100          
    100          
    100          
    100          
    50          
145             # nothing
146             }
147             elsif( $type =~ m/^head\d+$/ ) {
148             # nothing
149             }
150             elsif( $PARA_TYPES{$type} ) {
151 32 100       131 $type eq "Verbatim" and
152             $_parastack[-1][-1] = $self->trim_leading_whitespace( $_parastack[-1][-1] );
153             }
154 278         725 elsif( any { $type eq $_ } @FORMAT_TYPES ) {
155 24         76 delete $_curtags{$type};
156             }
157             elsif( $type eq "over-block" ) {
158 1         9 pop @_indentstack;
159             }
160             elsif( $type =~ m/^over-(.*)/ ) {
161 11         35 my @items = ( pop @_parastack )->@*;
162 11         66 $_parastack[-1][-1]->push_item( $_ ) for @items;
163             }
164             elsif( $type =~ m/^item-.*/ ) {
165             # nothing
166             }
167             else {
168 0         0 print STDERR "END $type\n";
169             }
170             }
171              
172             method _handle_text
173 94     94   1354 {
174 94 100 100     268 if( $_curpara->type eq "item" and
      100        
175             $_curpara->listtype eq "text" and !length $_curpara->term ) {
176 9         75 $_curpara->term->append_tagged( $_[0], %_curtags );
177             }
178             else {
179 85         302 $_curpara->text->append_tagged( $_[0], %_curtags );
180             }
181             }
182              
183 3         18 method trim_leading_whitespace ( $para )
  3         9  
  3         6  
184 3     3 0 32 {
185 3         17 my @lines = $para->text->split( qr/\n/ );
186              
187 3         433 my $trimlen = min map { m/^(\s*)/; $+[1] } grep { length } @lines;
  9         70  
  9         148  
  9         48  
188              
189 3   33     20 length and $_ = $_->substr( $trimlen, length $_ ) for @lines;
190              
191 3         294 my $text = shift @lines;
192 3         22 $text .= "\n" . $_ for @lines;
193              
194 3         1143 return (ref $para)->new(
195             text => $text,
196             );
197             }
198              
199             0x55AA;