line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Pod::Abstract::Parser; |
2
|
3
|
|
|
3
|
|
16
|
use strict; |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
93
|
|
3
|
|
|
|
|
|
|
|
4
|
3
|
|
|
3
|
|
15
|
use Pod::Parser; |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
115
|
|
5
|
3
|
|
|
3
|
|
15
|
use Pod::Abstract::Node; |
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
59
|
|
6
|
3
|
|
|
3
|
|
15
|
use Data::Dumper; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
284
|
|
7
|
3
|
|
|
3
|
|
17
|
use base qw(Pod::Parser); |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
8021
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
our $VERSION = '0.20'; |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
=head1 NAME |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
Pod::Abstract::Parser - Internal Parser class of Pod::Abstract. |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
=head1 DESCRIPTION |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
This is a C subclass, used by C to convert Pod |
18
|
|
|
|
|
|
|
text into a Node tree. You do not need to use this class yourself, the |
19
|
|
|
|
|
|
|
C class will do the work of creating the parser and running |
20
|
|
|
|
|
|
|
it for you. |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
=head1 METHODS |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
=head2 new |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
Pod::Abstract::Parser->new( $pod_abstract ); |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
Requires a Pod::Abstract object to load Pod data into. Should only be |
29
|
|
|
|
|
|
|
called internally by Pod::Abstract. |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
=cut |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
sub new { |
34
|
9
|
|
|
9
|
1
|
14
|
my $class = shift; |
35
|
9
|
|
|
|
|
13
|
my $p_a = shift; |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
# Always accept non-POD paras, so that the input document can |
38
|
|
|
|
|
|
|
# always be reproduced exactly as entered. These will be stored in |
39
|
|
|
|
|
|
|
# the tree but will be available through distinct methods. |
40
|
9
|
|
|
|
|
153
|
my $self = $class->SUPER::new(); |
41
|
9
|
|
|
|
|
227
|
$self->parseopts( |
42
|
|
|
|
|
|
|
-want_nonPODs => 1, |
43
|
|
|
|
|
|
|
-process_cut_cmd => 1, |
44
|
|
|
|
|
|
|
); |
45
|
9
|
|
|
|
|
30
|
$self->{pod_abstract} = $p_a; |
46
|
9
|
|
|
|
|
50
|
my $root_node = Pod::Abstract::Node->new( |
47
|
|
|
|
|
|
|
type => "[ROOT]", |
48
|
|
|
|
|
|
|
); |
49
|
9
|
|
|
|
|
21
|
$self->{cmd_stack} = [ $root_node ]; |
50
|
9
|
|
|
|
|
18
|
$self->{root} = $root_node; |
51
|
|
|
|
|
|
|
|
52
|
9
|
|
|
|
|
25
|
return $self; |
53
|
|
|
|
|
|
|
} |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
sub root { |
56
|
15
|
|
|
15
|
0
|
22
|
my $self = shift; |
57
|
15
|
|
|
|
|
102
|
return $self->{root}; |
58
|
|
|
|
|
|
|
} |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
# Automatically nest these items: A head1 section continues until the |
61
|
|
|
|
|
|
|
# next head1, list items continue until the next item or end of list, |
62
|
|
|
|
|
|
|
# etc. POD doesn't specify these relationships, but they are natural |
63
|
|
|
|
|
|
|
# and make sense in the whole document context. |
64
|
|
|
|
|
|
|
# |
65
|
|
|
|
|
|
|
# SPECIAL: Start node with < to pull the end node out of the tree and |
66
|
|
|
|
|
|
|
# into the opening node - e.g, pull a "back" into an "over", but not |
67
|
|
|
|
|
|
|
# into an "item". Pulling a command stops it from closing any more |
68
|
|
|
|
|
|
|
# elements, so begin/end style blocks need to use a pull, or one end |
69
|
|
|
|
|
|
|
# will close all begins. |
70
|
|
|
|
|
|
|
my %section_commands = ( |
71
|
|
|
|
|
|
|
'head1' => [ 'head1' ], |
72
|
|
|
|
|
|
|
'head2' => [ 'head2', 'head1' ], |
73
|
|
|
|
|
|
|
'head3' => [ 'head3', 'head2', 'head1' ], |
74
|
|
|
|
|
|
|
'head4' => [ 'head4', 'head3', 'head2', 'head1' ], |
75
|
|
|
|
|
|
|
'over' => [ '
|
76
|
|
|
|
|
|
|
'item' => [ 'item', 'back' ], |
77
|
|
|
|
|
|
|
'begin' => [ '
|
78
|
|
|
|
|
|
|
); |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
# Don't parse anything inside these. |
81
|
|
|
|
|
|
|
my %no_parse = ( |
82
|
|
|
|
|
|
|
'begin' => 1, |
83
|
|
|
|
|
|
|
'for' => 1, |
84
|
|
|
|
|
|
|
); |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
my %attr_names = ( |
87
|
|
|
|
|
|
|
head1 => 'heading', |
88
|
|
|
|
|
|
|
head2 => 'heading', |
89
|
|
|
|
|
|
|
head3 => 'heading', |
90
|
|
|
|
|
|
|
head4 => 'heading', |
91
|
|
|
|
|
|
|
item => 'label', |
92
|
|
|
|
|
|
|
); |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
sub command { |
95
|
4
|
|
|
4
|
0
|
7
|
my ($self, $command, $paragraph, $line_num) = @_; |
96
|
4
|
|
50
|
|
|
14
|
my $cmd_stack = $self->{cmd_stack} || [ ]; |
97
|
|
|
|
|
|
|
|
98
|
4
|
|
|
|
|
11
|
my $p_break = "\n\n"; |
99
|
4
|
100
|
|
|
|
18
|
if($paragraph =~ s/([ \t]*\n[ \t]*\n)$//s) { |
100
|
2
|
|
|
|
|
6
|
$p_break = $1; |
101
|
|
|
|
|
|
|
} |
102
|
|
|
|
|
|
|
|
103
|
4
|
50
|
|
|
|
16
|
if($self->cutting) { |
104
|
|
|
|
|
|
|
# Treat as non-pod - i.e, verbatim program text block. |
105
|
0
|
|
|
|
|
0
|
my $element_node = Pod::Abstract::Node->new( |
106
|
|
|
|
|
|
|
type => "#cut", |
107
|
|
|
|
|
|
|
body => "=$command $paragraph$p_break", |
108
|
|
|
|
|
|
|
); |
109
|
0
|
|
|
|
|
0
|
my $top = $cmd_stack->[$#$cmd_stack]; |
110
|
0
|
|
|
|
|
0
|
$top->push($element_node); |
111
|
|
|
|
|
|
|
} else { |
112
|
|
|
|
|
|
|
# Treat as command. |
113
|
4
|
|
|
|
|
5
|
my $pull = undef; |
114
|
4
|
|
|
|
|
56
|
while(@$cmd_stack > 0) { |
115
|
5
|
|
|
|
|
8
|
my $last = scalar(@$cmd_stack) - 1; |
116
|
5
|
|
|
|
|
7
|
my @should_end = ( ); |
117
|
5
|
|
|
|
|
13
|
@should_end = |
118
|
5
|
|
|
|
|
13
|
grep { $command eq $_ } |
119
|
5
|
|
|
|
|
6
|
@{$section_commands{$cmd_stack->[$last]->type}}; |
120
|
5
|
|
|
|
|
9
|
my @should_pull = ( ); |
121
|
5
|
|
|
|
|
12
|
@should_pull = |
122
|
5
|
|
|
|
|
12
|
grep { "<$command" eq $_ } |
123
|
5
|
|
|
|
|
9
|
@{$section_commands{$cmd_stack->[$last]->type}}; |
124
|
5
|
100
|
|
|
|
22
|
if(@should_end) { |
|
|
100
|
|
|
|
|
|
125
|
1
|
|
|
|
|
4
|
my $end_cmd = pop @$cmd_stack; |
126
|
|
|
|
|
|
|
} elsif(@should_pull) { |
127
|
1
|
|
|
|
|
2
|
$pull = pop @$cmd_stack; |
128
|
1
|
|
|
|
|
3
|
last; |
129
|
|
|
|
|
|
|
} else { |
130
|
3
|
|
|
|
|
5
|
last; |
131
|
|
|
|
|
|
|
} |
132
|
|
|
|
|
|
|
} |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
# Don't do anything special if we're on a no_parse node |
135
|
4
|
|
|
|
|
7
|
my $top = $cmd_stack->[$#$cmd_stack]; |
136
|
4
|
50
|
33
|
|
|
12
|
if($no_parse{$top->type} && !$top->param('parse_me')) { |
137
|
0
|
0
|
|
|
|
0
|
my $t_node = Pod::Abstract::Node->new( |
138
|
|
|
|
|
|
|
type => ':text', |
139
|
|
|
|
|
|
|
body => ($paragraph ne '' ? |
140
|
|
|
|
|
|
|
"=$command $paragraph$p_break" : |
141
|
|
|
|
|
|
|
"=$command$p_break"), |
142
|
|
|
|
|
|
|
); |
143
|
0
|
|
|
|
|
0
|
$top->push($t_node); |
144
|
0
|
|
|
|
|
0
|
return; |
145
|
|
|
|
|
|
|
} |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
# Some commands have to get expandable interior sequences |
148
|
4
|
|
|
|
|
6
|
my $attr_node = undef; |
149
|
4
|
|
|
|
|
6
|
my $attr_name = $attr_names{$command}; |
150
|
4
|
|
|
|
|
9
|
my %attr = ( parse_me => 0 ); |
151
|
4
|
100
|
|
|
|
12
|
if($attr_name) { |
|
|
50
|
|
|
|
|
|
152
|
2
|
|
|
|
|
7
|
$attr_node = Pod::Abstract::Node->new( |
153
|
|
|
|
|
|
|
type => '@attribute', |
154
|
|
|
|
|
|
|
); |
155
|
2
|
|
|
|
|
83
|
my $pt = $self->parse_text($paragraph); |
156
|
2
|
|
|
|
|
6
|
$self->load_pt($attr_node, $pt); |
157
|
2
|
|
|
|
|
4
|
$attr{$attr_name} = $attr_node; |
158
|
2
|
|
|
|
|
15
|
$attr{body_attr} = $attr_name; |
159
|
|
|
|
|
|
|
} elsif($paragraph =~ m/^\:/) { |
160
|
0
|
|
|
|
|
0
|
$attr{parse_me} = 1; |
161
|
|
|
|
|
|
|
} |
162
|
|
|
|
|
|
|
|
163
|
4
|
100
|
|
|
|
21
|
my $element_node = Pod::Abstract::Node->new( |
164
|
|
|
|
|
|
|
type => $command, |
165
|
|
|
|
|
|
|
body => ($attr_name ? undef : $paragraph), |
166
|
|
|
|
|
|
|
p_break => $p_break, |
167
|
|
|
|
|
|
|
%attr, |
168
|
|
|
|
|
|
|
); |
169
|
4
|
100
|
|
|
|
10
|
if($pull) { |
170
|
1
|
|
|
|
|
5
|
$pull->param('close_element', $element_node); |
171
|
|
|
|
|
|
|
} else { |
172
|
3
|
|
|
|
|
14
|
$top->push($element_node); |
173
|
|
|
|
|
|
|
} |
174
|
4
|
100
|
|
|
|
13
|
if($section_commands{$command}) { |
175
|
3
|
|
|
|
|
8
|
push @$cmd_stack, $element_node; |
176
|
|
|
|
|
|
|
} else { |
177
|
|
|
|
|
|
|
# No push |
178
|
|
|
|
|
|
|
} |
179
|
|
|
|
|
|
|
} |
180
|
|
|
|
|
|
|
|
181
|
4
|
|
|
|
|
51
|
$self->{cmd_stack} = $cmd_stack; |
182
|
|
|
|
|
|
|
} |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
sub verbatim { |
185
|
0
|
|
|
0
|
0
|
0
|
my ($self, $paragraph, $line_num) = @_; |
186
|
|
|
|
|
|
|
|
187
|
0
|
|
|
|
|
0
|
my $cmd_stack = $self->{cmd_stack}; |
188
|
0
|
|
|
|
|
0
|
my $top = $cmd_stack->[$#$cmd_stack]; |
189
|
|
|
|
|
|
|
|
190
|
0
|
|
|
|
|
0
|
my $type = ':verbatim'; |
191
|
0
|
0
|
0
|
|
|
0
|
if($no_parse{$top->type} && !$top->param('parse_me')) { |
192
|
0
|
|
|
|
|
0
|
$type = ':text'; |
193
|
|
|
|
|
|
|
} |
194
|
|
|
|
|
|
|
|
195
|
0
|
|
|
|
|
0
|
my $element_node = Pod::Abstract::Node->new( |
196
|
|
|
|
|
|
|
type => ':verbatim', |
197
|
|
|
|
|
|
|
body => $paragraph, |
198
|
|
|
|
|
|
|
); |
199
|
0
|
|
|
|
|
0
|
$top->push($element_node); |
200
|
|
|
|
|
|
|
} |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
sub preprocess_paragraph { |
203
|
10
|
|
|
10
|
0
|
510
|
my ($self, $text, $line_num) = @_; |
204
|
10
|
100
|
|
|
|
196
|
return $text unless $self->cutting; |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
# This is a non-pod text segment |
207
|
4
|
|
|
|
|
16
|
my $element_node = Pod::Abstract::Node->new( |
208
|
|
|
|
|
|
|
type => "#cut", |
209
|
|
|
|
|
|
|
body => $text, |
210
|
|
|
|
|
|
|
); |
211
|
4
|
|
|
|
|
8
|
my $cmd_stack = $self->{cmd_stack}; |
212
|
4
|
|
|
|
|
10
|
my $top = $cmd_stack->[$#$cmd_stack]; |
213
|
4
|
|
|
|
|
16
|
$top->push($element_node); |
214
|
|
|
|
|
|
|
} |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
sub textblock { |
217
|
2
|
|
|
2
|
0
|
3
|
my ($self, $paragraph, $line_num) = @_; |
218
|
2
|
|
|
|
|
3
|
my $p_break = "\n\n"; |
219
|
2
|
50
|
|
|
|
11
|
if($paragraph =~ s/([ \t]*\n[ \t]*\n)$//s) { |
220
|
2
|
|
|
|
|
4
|
$p_break = $1; |
221
|
|
|
|
|
|
|
} |
222
|
2
|
|
|
|
|
7
|
my $cmd_stack = $self->{cmd_stack}; |
223
|
2
|
|
|
|
|
3
|
my $top = $cmd_stack->[$#$cmd_stack]; |
224
|
2
|
50
|
33
|
|
|
6
|
if($no_parse{$top->type} && !$top->param('parse_me')) { |
225
|
0
|
|
|
|
|
0
|
my $element_node = Pod::Abstract::Node->new( |
226
|
|
|
|
|
|
|
type => ':text', |
227
|
|
|
|
|
|
|
body => "$paragraph$p_break", |
228
|
|
|
|
|
|
|
); |
229
|
0
|
|
|
|
|
0
|
$top->push($element_node); |
230
|
0
|
|
|
|
|
0
|
return; |
231
|
|
|
|
|
|
|
} |
232
|
|
|
|
|
|
|
|
233
|
2
|
|
|
|
|
14
|
my $element_node = Pod::Abstract::Node->new( |
234
|
|
|
|
|
|
|
type => ':paragraph', |
235
|
|
|
|
|
|
|
p_break => $p_break, |
236
|
|
|
|
|
|
|
); |
237
|
2
|
|
|
|
|
119
|
my $pt = $self->parse_text($paragraph); |
238
|
2
|
|
|
|
|
5
|
$self->load_pt($element_node, $pt); |
239
|
|
|
|
|
|
|
|
240
|
2
|
|
|
|
|
23
|
$top->push($element_node); |
241
|
|
|
|
|
|
|
} |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
# Recursive load |
244
|
|
|
|
|
|
|
sub load_pt { |
245
|
10
|
|
|
10
|
0
|
14
|
my $self = shift; |
246
|
10
|
|
|
|
|
12
|
my $elt = shift; |
247
|
10
|
|
|
|
|
11
|
my $pt = shift; |
248
|
|
|
|
|
|
|
|
249
|
10
|
|
|
|
|
45
|
my @c = $pt->children; |
250
|
10
|
|
|
|
|
16
|
foreach my $c(@c) { |
251
|
12
|
100
|
|
|
|
25
|
if(ref $c) { |
252
|
|
|
|
|
|
|
# Object; |
253
|
2
|
50
|
|
|
|
14
|
if($c->isa('Pod::InteriorSequence')) { |
254
|
2
|
|
|
|
|
10
|
my $cmd = $c->cmd_name; |
255
|
2
|
|
|
|
|
21
|
my $i_node = Pod::Abstract::Node->new( |
256
|
|
|
|
|
|
|
type => ":$cmd", |
257
|
|
|
|
|
|
|
left_delimiter => $c->left_delimiter, |
258
|
|
|
|
|
|
|
right_delimiter => $c->right_delimiter, |
259
|
|
|
|
|
|
|
); |
260
|
2
|
|
|
|
|
15
|
$self->load_pt($i_node, $c->parse_tree); |
261
|
2
|
|
|
|
|
5
|
$elt->push($i_node); |
262
|
|
|
|
|
|
|
} else { |
263
|
0
|
|
|
|
|
0
|
die "$c not an interior sequence!"; |
264
|
|
|
|
|
|
|
} |
265
|
|
|
|
|
|
|
} else { |
266
|
|
|
|
|
|
|
# text |
267
|
10
|
|
|
|
|
27
|
my $t_node = Pod::Abstract::Node->new( |
268
|
|
|
|
|
|
|
type => ':text', |
269
|
|
|
|
|
|
|
body => $c, |
270
|
|
|
|
|
|
|
); |
271
|
10
|
|
|
|
|
26
|
$elt->push($t_node); |
272
|
|
|
|
|
|
|
} |
273
|
|
|
|
|
|
|
} |
274
|
10
|
|
|
|
|
76
|
return $elt; |
275
|
|
|
|
|
|
|
} |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
sub end_pod { |
278
|
5
|
|
|
5
|
0
|
50
|
my $self = shift; |
279
|
5
|
|
|
|
|
11
|
my $cmd_stack = $self->{cmd_stack}; |
280
|
|
|
|
|
|
|
|
281
|
5
|
|
|
|
|
9
|
my $end_cmd; |
282
|
5
|
|
66
|
|
|
34
|
while(defined $cmd_stack && @$cmd_stack) { |
283
|
6
|
|
|
|
|
30
|
$end_cmd = pop @$cmd_stack; |
284
|
|
|
|
|
|
|
} |
285
|
5
|
50
|
|
|
|
25
|
die "Last node was not root node" unless $end_cmd->type eq '[ROOT]'; |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
# Replace the root node. |
288
|
5
|
|
|
|
|
100
|
push @$cmd_stack, $end_cmd; |
289
|
|
|
|
|
|
|
} |
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
=head1 AUTHOR |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
Ben Lilburne |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
Copyright (C) 2009 Ben Lilburne |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify |
300
|
|
|
|
|
|
|
it under the same terms as Perl itself. |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
=cut |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
1; |