File Coverage

blib/lib/App/sdview/Parser/Pod.pm
Criterion Covered Total %
statement 91 108 84.2
branch 38 40 95.0
condition 20 24 83.3
subroutine 15 17 88.2
pod 1 5 20.0
total 165 194 85.0


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   707759 use v5.26;
  7         54  
7 7     4   150 use warnings;
  4         8  
  4         143  
8              
9 4     4   1861 use Object::Pad 0.800;
  4         25498  
  4         287  
10              
11             package App::sdview::Parser::Pod 0.12;
12             class App::sdview::Parser::Pod
13             :isa(Pod::Simple)
14             :does(App::sdview::Parser)
15 4     4   3319 :strict(params);
  4         124608  
  4         244  
16              
17 4     4   2926 use List::Keywords qw( any );
  4         6846  
  4         26  
18 4     4   276 use List::Util qw( min );
  4         9  
  4         330  
19              
20 4     4   26 use String::Tagged;
  4         10  
  4         136  
21              
22 4     4   37 use constant format => "POD";
  4         9  
  4         336  
23 4     4   25 use constant sort_order => 10;
  4         9  
  4         13773  
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 0         0 require Pod::Perldoc;
29 0         0 my ( $found ) = Pod::Perldoc->new->searchfor( 0, $name, @INC );
30 0         0 return $found;
31             }
32              
33 2         6 sub can_parse_file ( $class, $file )
34 2     2 0 6702 {
  2         4  
  2         4  
35 2         22 return $file =~ m/\.pm$|\.pl$|\.pod$/;
36             }
37              
38             ADJUST
39             {
40             $self->nix_X_codes( 1 );
41             }
42              
43             field @_indentstack;
44             field @_parastack;
45              
46             field %_curtags;
47             field $_curpara;
48              
49 0         0 method parse_file ( $fh )
  0         0  
  0         0  
50 0     0 1 0 {
51 0         0 push @_indentstack, 0;
52 0         0 push @_parastack, [];
53 0         0 $self->SUPER::parse_file( $fh );
54 0         0 return $_parastack[0]->@*;
55             }
56              
57 20         36 method parse_string ( $str )
  20         37  
  20         29  
58 20     20 0 250 {
59 20         44 push @_indentstack, 0;
60 20         37 push @_parastack, [];
61 20         90 $self->SUPER::parse_string_document ( $str );
62 20         280 return $_parastack[0]->@*;
63             }
64              
65             my %PARA_TYPES = (
66             Para => "App::sdview::Para::Plain",
67             Verbatim => "App::sdview::Para::Verbatim",
68             );
69             my @FORMAT_TYPES = qw( B I F C L );
70              
71 126         200 method _handle_element_start ( $type, $attrs )
  126         190  
  126         182  
  126         167  
72 126     126   28723 {
73 126 100 100     799 if( $type eq "Document" ) {
    100 100        
    100 66        
    100 100        
    100          
    100          
    100          
    100          
    100          
    50          
74 20         104 %_curtags = ();
75             }
76             elsif( $type =~ m/^head(\d+)$/ ) {
77 9         59 push $_parastack[-1]->@*, $_curpara = App::sdview::Para::Heading->new(
78             level => $1,
79             text => String::Tagged->new,
80             );
81 9         299 %_curtags = ();
82             }
83             elsif( $type eq "Para" and $_curpara and
84             $_curpara->type eq "item" and $_curpara->listtype eq "text" and !length $_curpara->text ) {
85 9         68 %_curtags = ();
86             }
87             elsif( my $class = $PARA_TYPES{$type} ) {
88 23         113 push $_parastack[-1]->@*, $_curpara = $class->new(
89             text => String::Tagged->new,
90             indent => $_indentstack[-1],
91             );
92 23         328 %_curtags = ();
93             }
94             elsif( $type eq "L" ) {
95 6         18 my $target = $attrs->{to};
96             # TODO: more customizable
97 6 100 66     34 if( defined $target and $target !~ m(^\w+://) ) {
98 3         56 $target = "https://metacpan.org/pod/$target";
99             }
100 6         120 $_curtags{L} = { target => $target };
101             }
102 248         611 elsif( any { $type eq $_ } @FORMAT_TYPES ) {
103 18         57 ++$_curtags{$type};
104             }
105             elsif( $type eq "over-block" ) {
106 1         6 push @_indentstack, $_indentstack[-1] + $attrs->{indent};
107             }
108             elsif( $type =~ m/^over-(.*)/ ) {
109             push $_parastack[-1]->@*, App::sdview::Para::List->new(
110             listtype => $1,
111             indent => $_indentstack[-1] + $attrs->{indent},
112 11         143 );
113 11         27 push @_parastack, [];
114 11         36 undef $_curpara;
115             }
116             elsif( $type eq "item-text" ) {
117 9         39 push $_parastack[-1]->@*, $_curpara = App::sdview::Para::ListItem->new(
118             listtype => "text",
119             term => String::Tagged->new,
120             text => String::Tagged->new,
121             );
122             }
123             elsif( $type =~ m/^item-(.*)/ ) {
124 20         102 push $_parastack[-1]->@*, $_curpara = App::sdview::Para::ListItem->new(
125             listtype => "$1",
126             text => String::Tagged->new,
127             );
128             }
129             else {
130 0         0 print STDERR "START $type\n";
131             }
132             }
133              
134 126         183 method _handle_element_end ( $type, @ )
  126         192  
  126         155  
135 126     126   5931 {
136 126 100       488 if( $type eq "Document" ) {
    100          
    100          
    100          
    100          
    100          
    50          
137             # nothing
138             }
139             elsif( $type =~ m/^head\d+$/ ) {
140             # nothing
141             }
142             elsif( $PARA_TYPES{$type} ) {
143 32 100       138 $type eq "Verbatim" and
144             $_parastack[-1][-1] = $self->trim_leading_whitespace( $_parastack[-1][-1] );
145             }
146 278         663 elsif( any { $type eq $_ } @FORMAT_TYPES ) {
147 24         84 delete $_curtags{$type};
148             }
149             elsif( $type eq "over-block" ) {
150 1         6 pop @_indentstack;
151             }
152             elsif( $type =~ m/^over-(.*)/ ) {
153 11         34 my @items = ( pop @_parastack )->@*;
154 11         58 $_parastack[-1][-1]->push_item( $_ ) for @items;
155             }
156             elsif( $type =~ m/^item-.*/ ) {
157             # nothing
158             }
159             else {
160 0         0 print STDERR "END $type\n";
161             }
162             }
163              
164             method _handle_text
165 94     94   1337 {
166 94 100 100     245 if( $_curpara->type eq "item" and
      100        
167             $_curpara->listtype eq "text" and !length $_curpara->term ) {
168 9         72 $_curpara->term->append_tagged( $_[0], %_curtags );
169             }
170             else {
171 85         257 $_curpara->text->append_tagged( $_[0], %_curtags );
172             }
173             }
174              
175 3         8 method trim_leading_whitespace ( $para )
  3         6  
  3         5  
176 3     3 0 8 {
177 3         12 my @lines = $para->text->split( qr/\n/ );
178              
179 3         352 my $trimlen = min map { m/^(\s*)/; $+[1] } grep { length } @lines;
  9         34  
  9         79  
  9         46  
180              
181 3   33     14 length and $_ = $_->substr( $trimlen, length $_ ) for @lines;
182              
183 3         285 my $text = shift @lines;
184 3         16 $text .= "\n" . $_ for @lines;
185              
186 3         1088 return (ref $para)->new(
187             text => $text,
188             );
189             }
190              
191             0x55AA;