line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Pod::Abstract::Node; |
2
|
3
|
|
|
3
|
|
16
|
use strict; |
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
85
|
|
3
|
3
|
|
|
3
|
|
151
|
use warnings; |
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
136
|
|
4
|
|
|
|
|
|
|
|
5
|
3
|
|
|
3
|
|
1635
|
use Pod::Abstract::Tree; |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
88
|
|
6
|
3
|
|
|
3
|
|
1903
|
use Pod::Abstract::Serial; |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
98
|
|
7
|
|
|
|
|
|
|
|
8
|
3
|
|
|
3
|
|
18
|
use Scalar::Util qw(weaken); |
|
3
|
|
|
|
|
4
|
|
|
3
|
|
|
|
|
9854
|
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
our $VERSION = '0.20'; |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
=head1 NAME |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
Pod::Abstract::Node - Pod Document Node. |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
=head1 SYNOPSIS |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
$node->nest( @list ); # Nests list as children of $node. If they |
19
|
|
|
|
|
|
|
# exist in a tree they will be detached. |
20
|
|
|
|
|
|
|
$node->clear; # Remove (detach) all children of $node |
21
|
|
|
|
|
|
|
$node->hoist; # Append all children of $node after $node. |
22
|
|
|
|
|
|
|
$node->detach; # Detaches intact subtree from parent |
23
|
|
|
|
|
|
|
$node->select( $path_exp ); # Selects the path expression under $node |
24
|
|
|
|
|
|
|
$node->select_into( $target, $path_exp ); |
25
|
|
|
|
|
|
|
# Selects into the children of the |
26
|
|
|
|
|
|
|
# target node. (copies) |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
$node->insert_before($target); # Inserts $node in $target's tree |
29
|
|
|
|
|
|
|
# before $target |
30
|
|
|
|
|
|
|
$node->insert_after($target); |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
$node->push($target); # Appends $target at the end of this node |
33
|
|
|
|
|
|
|
$node->unshift($target); # Prepends $target at the start of this node |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
$node->path(); # List of nodes leading to this one |
36
|
|
|
|
|
|
|
$node->children(); # All direct child nodes of this one |
37
|
|
|
|
|
|
|
$node->next(); # Following sibling if present |
38
|
|
|
|
|
|
|
$node->previous(); # Preceding sibling if present |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
$node->duplicate(); # Duplicate node and children in a new tree. |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
$node->pod; # Convert node back into literal POD |
43
|
|
|
|
|
|
|
$node->ptree; # Show visual (abbreviated) parse tree |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
=head1 METHODS |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
=for sorting |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
=cut |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
=head2 new |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
my $node = Pod::Abstract::Node->new( |
54
|
|
|
|
|
|
|
type => ':text', body => 'Some text', |
55
|
|
|
|
|
|
|
); |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
Creates a new, unattached Node object. This is NOT the recommended way |
58
|
|
|
|
|
|
|
to make nodes to add to a document, use Pod::Abstract::BuildNode for |
59
|
|
|
|
|
|
|
that. There are specific rules about how data must be set up for these |
60
|
|
|
|
|
|
|
nodes, and C lets you ignore them. |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
Apart from type and body, all other hash arguments will be converted |
63
|
|
|
|
|
|
|
into "params", which may be internal data or node attributes. |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
Type may be: |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
=over |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
=item * |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
A plain word, which is taken to be a command name. |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
=item * |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
C<:paragraph>, C<:text>, C<:verbatim> or <:X> (where X is an inline |
76
|
|
|
|
|
|
|
format letter). These will be treated as you would expect. |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
=item * |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
C<#cut>, meaning this is literal, non-pod text. |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
=back |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
Note that these do not guarantee the resulting document structure will |
85
|
|
|
|
|
|
|
match your types - types are derived from the document, not the other |
86
|
|
|
|
|
|
|
way around. If your types do not match your document they will mutate |
87
|
|
|
|
|
|
|
when it is reloaded. |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
See L if you want to make nodes easily for |
90
|
|
|
|
|
|
|
creating/modifying a document tree. |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
=cut |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
sub new { |
95
|
43
|
|
|
43
|
1
|
57
|
my $class = shift; |
96
|
43
|
|
|
|
|
124
|
my %args = @_; |
97
|
43
|
|
|
|
|
71
|
my $type = $args{type}; |
98
|
43
|
|
|
|
|
56
|
my $body = $args{body}; |
99
|
43
|
|
|
|
|
68
|
delete $args{type}; |
100
|
43
|
|
|
|
|
100
|
delete $args{body}; |
101
|
|
|
|
|
|
|
|
102
|
43
|
|
|
|
|
135
|
my $self = bless { |
103
|
|
|
|
|
|
|
tree => Pod::Abstract::Tree->new(), |
104
|
|
|
|
|
|
|
serial => Pod::Abstract::Serial->next, |
105
|
|
|
|
|
|
|
parent => undef, |
106
|
|
|
|
|
|
|
type => $type, |
107
|
|
|
|
|
|
|
body => $body, |
108
|
|
|
|
|
|
|
params => { %args }, |
109
|
|
|
|
|
|
|
}, $class; |
110
|
|
|
|
|
|
|
|
111
|
43
|
|
|
|
|
151
|
return $self; |
112
|
|
|
|
|
|
|
} |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
=head2 ptree |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
print $n->ptree; |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
Produces a formatted, readable, parse tree. Shows node types, nesting |
119
|
|
|
|
|
|
|
structure, abbreviated text. Does NOT show all information, but shows |
120
|
|
|
|
|
|
|
enough to help debug parsing/traversal problems. |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
=cut |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
sub ptree { |
125
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
126
|
0
|
|
0
|
|
|
0
|
my $indent = shift || 0; |
127
|
0
|
|
|
|
|
0
|
my $width = 72 - $indent; |
128
|
|
|
|
|
|
|
|
129
|
0
|
|
|
|
|
0
|
my $type = $self->type; |
130
|
0
|
|
|
|
|
0
|
my $body = $self->body; |
131
|
0
|
0
|
|
|
|
0
|
if(my $body_attr = $self->param('body_attr')) { |
132
|
0
|
|
|
|
|
0
|
$body = $self->param($body_attr)->pod; |
133
|
|
|
|
|
|
|
} |
134
|
0
|
0
|
|
|
|
0
|
$body =~ s/[\n\t]//g if $body; |
135
|
|
|
|
|
|
|
|
136
|
0
|
|
|
|
|
0
|
my $r = ' ' x $indent; |
137
|
0
|
0
|
|
|
|
0
|
if($body) { |
138
|
0
|
|
|
|
|
0
|
$r .= substr("[$type] $body",0,$width); |
139
|
|
|
|
|
|
|
} else { |
140
|
0
|
|
|
|
|
0
|
$r .= "[$type]"; |
141
|
|
|
|
|
|
|
} |
142
|
0
|
|
|
|
|
0
|
$r = sprintf("%3d %s",$self->serial, $r); |
143
|
0
|
|
|
|
|
0
|
$r .= "\n"; |
144
|
0
|
|
|
|
|
0
|
my @children = $self->children; |
145
|
0
|
|
|
|
|
0
|
foreach my $c (@children) { |
146
|
0
|
|
|
|
|
0
|
$r .= $c->ptree($indent + 2); |
147
|
|
|
|
|
|
|
} |
148
|
0
|
|
|
|
|
0
|
return $r; |
149
|
|
|
|
|
|
|
} |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
=head2 text |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
print $n->text; |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
Returns the text subnodes only of the given node, concatenated |
156
|
|
|
|
|
|
|
together - i,e, the text only with no formatting at all. |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
=cut |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
my %escapes = ( |
161
|
|
|
|
|
|
|
'gt' => '>', |
162
|
|
|
|
|
|
|
'lt' => '<', |
163
|
|
|
|
|
|
|
'sol' => '/', |
164
|
|
|
|
|
|
|
'verbar' => '|', |
165
|
|
|
|
|
|
|
); |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
sub text { |
168
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
169
|
|
|
|
|
|
|
|
170
|
0
|
|
|
|
|
0
|
my $r = ''; |
171
|
0
|
|
|
|
|
0
|
my $type = $self->type; |
172
|
0
|
|
|
|
|
0
|
my $body = $self->body; |
173
|
|
|
|
|
|
|
|
174
|
0
|
|
|
|
|
0
|
my @children = $self->children; |
175
|
0
|
0
|
|
|
|
0
|
if($type eq ':text') { |
|
|
0
|
|
|
|
|
|
176
|
0
|
|
|
|
|
0
|
$r .= $body; |
177
|
|
|
|
|
|
|
} elsif( $type eq ':E' ) { |
178
|
0
|
|
|
|
|
0
|
my $code = ''; |
179
|
0
|
|
|
|
|
0
|
foreach my $c (@children) { |
180
|
0
|
|
|
|
|
0
|
$code .= $c->text; |
181
|
|
|
|
|
|
|
} |
182
|
0
|
0
|
|
|
|
0
|
if($escapes{$code}) { |
183
|
0
|
|
|
|
|
0
|
$r .= $escapes{$code}; |
184
|
|
|
|
|
|
|
} |
185
|
0
|
|
|
|
|
0
|
return $r; |
186
|
|
|
|
|
|
|
} |
187
|
|
|
|
|
|
|
|
188
|
0
|
|
|
|
|
0
|
foreach my $c (@children) { |
189
|
0
|
|
|
|
|
0
|
$r .= $c->text; |
190
|
|
|
|
|
|
|
} |
191
|
|
|
|
|
|
|
|
192
|
0
|
|
|
|
|
0
|
return $r; |
193
|
|
|
|
|
|
|
} |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
=head2 pod |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
print $n->pod; |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
Returns the node (and all subnodes) formatted as POD. A newly loaded |
200
|
|
|
|
|
|
|
node should produce the original POD text when pod is requested. |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
=cut |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
sub pod { |
205
|
38
|
|
|
38
|
1
|
2675
|
my $self = shift; |
206
|
|
|
|
|
|
|
|
207
|
38
|
|
|
|
|
44
|
my $r = ''; |
208
|
38
|
|
|
|
|
70
|
my $body = $self->body; |
209
|
38
|
|
|
|
|
67
|
my $type = $self->type; |
210
|
38
|
|
|
|
|
45
|
my $should_para_break = 0; |
211
|
38
|
|
|
|
|
65
|
my $p_break = $self->param('p_break'); |
212
|
38
|
100
|
|
|
|
80
|
$p_break = "\n\n" unless defined $p_break; |
213
|
|
|
|
|
|
|
|
214
|
38
|
|
|
|
|
35
|
my $r_delim = undef; # Used if a interior sequence needs closing. |
215
|
|
|
|
|
|
|
|
216
|
38
|
100
|
100
|
|
|
292
|
if($type eq ':paragraph') { |
|
|
100
|
66
|
|
|
|
|
|
|
100
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
217
|
4
|
|
|
|
|
10
|
$should_para_break = 1; |
218
|
|
|
|
|
|
|
} elsif( $type eq ':text' or $type eq '#cut' or $type eq ':verbatim') { |
219
|
14
|
|
|
|
|
49
|
$r .= $body; |
220
|
|
|
|
|
|
|
} elsif( $type =~ m/^\:(.+)$/ ) { # Interior sequence |
221
|
2
|
|
|
|
|
5
|
my $cmd = $1; |
222
|
2
|
|
|
|
|
6
|
my $l_delim = $self->param('left_delimiter'); |
223
|
2
|
|
|
|
|
6
|
$r_delim = $self->param('right_delimiter'); |
224
|
2
|
|
|
|
|
3
|
$r .= "$cmd$l_delim"; |
225
|
|
|
|
|
|
|
} elsif( $type eq '[ROOT]' or $type =~ m/^@/) { |
226
|
|
|
|
|
|
|
# ignore |
227
|
|
|
|
|
|
|
} else { # command |
228
|
8
|
|
|
|
|
14
|
my $body_attr = $self->param('body_attr'); |
229
|
8
|
100
|
|
|
|
17
|
if($body_attr) { |
230
|
4
|
|
|
|
|
8
|
$body = $self->param($body_attr)->pod; |
231
|
|
|
|
|
|
|
} |
232
|
8
|
100
|
100
|
|
|
29
|
if(defined $body && $body ne '') { |
233
|
4
|
|
|
|
|
9
|
$r .= "=$type $body$p_break"; |
234
|
|
|
|
|
|
|
} else { |
235
|
4
|
|
|
|
|
8
|
$r .= "=$type$p_break"; |
236
|
|
|
|
|
|
|
} |
237
|
|
|
|
|
|
|
} |
238
|
|
|
|
|
|
|
|
239
|
38
|
|
|
|
|
71
|
my @children = $self->children; |
240
|
38
|
|
|
|
|
66
|
foreach my $c (@children) { |
241
|
26
|
|
|
|
|
77
|
$r .= $c->pod; |
242
|
|
|
|
|
|
|
} |
243
|
|
|
|
|
|
|
|
244
|
38
|
100
|
|
|
|
105
|
if($should_para_break) { |
|
|
100
|
|
|
|
|
|
245
|
4
|
|
|
|
|
5
|
$r .= $p_break; |
246
|
|
|
|
|
|
|
} elsif($r_delim) { |
247
|
2
|
|
|
|
|
3
|
$r .= $r_delim; |
248
|
|
|
|
|
|
|
} |
249
|
|
|
|
|
|
|
|
250
|
38
|
100
|
|
|
|
68
|
if($self->param('close_element')) { |
251
|
2
|
|
|
|
|
6
|
$r .= $self->param('close_element')->pod; |
252
|
|
|
|
|
|
|
} |
253
|
|
|
|
|
|
|
|
254
|
38
|
|
|
|
|
166
|
return $r; |
255
|
|
|
|
|
|
|
} |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
=head2 select |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
my @nodes = $n->select('/:paragraph[//:text =~ {TODO}]'); |
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
Select a pPath expression against this node. The above example will |
262
|
|
|
|
|
|
|
select all paragraphs in the document containing 'TODO' in any of |
263
|
|
|
|
|
|
|
their text nodes. |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
The returned values are the real nodes from the document tree, and |
266
|
|
|
|
|
|
|
manipulating them will transform the document. |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
=cut |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
sub select { |
271
|
10
|
|
|
10
|
1
|
13
|
my $self = shift; |
272
|
10
|
|
|
|
|
17
|
my $path = shift; |
273
|
|
|
|
|
|
|
|
274
|
10
|
|
|
|
|
49
|
my $p_path = Pod::Abstract::Path->new($path); |
275
|
10
|
|
|
|
|
31
|
return $p_path->process($self); |
276
|
|
|
|
|
|
|
} |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
=head2 select_into |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
$node->select_into($target_node, $path) |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
As with select, this will match a pPath expression against $node - but |
283
|
|
|
|
|
|
|
the resulting nodes will be copied and added as children to |
284
|
|
|
|
|
|
|
$target_node. The nodes that were added will be returned as a list. |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
=cut |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
sub select_into { |
289
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
290
|
0
|
|
|
|
|
0
|
my $target = shift; |
291
|
0
|
|
|
|
|
0
|
my $path = shift; |
292
|
|
|
|
|
|
|
|
293
|
0
|
|
|
|
|
0
|
my @nodes = $self->select($path); |
294
|
0
|
|
|
|
|
0
|
my @dup_nodes = map { $_->duplicate } @nodes; |
|
0
|
|
|
|
|
0
|
|
295
|
|
|
|
|
|
|
|
296
|
0
|
|
|
|
|
0
|
return $target->nest(@dup_nodes); |
297
|
|
|
|
|
|
|
} |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
=head2 type |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
$node->type( [ $new_type ] ); |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
Get or set the type of the node. |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
=cut |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
sub type { |
308
|
79
|
|
|
79
|
1
|
95
|
my $self = shift; |
309
|
79
|
50
|
|
|
|
150
|
if(@_) { |
310
|
0
|
|
|
|
|
0
|
my $new_val = shift; |
311
|
0
|
|
|
|
|
0
|
$self->{type} = $new_val; |
312
|
|
|
|
|
|
|
} |
313
|
79
|
|
|
|
|
250
|
return $self->{type}; |
314
|
|
|
|
|
|
|
} |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
=head2 body |
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
$node->body( [ $new_body ] ); |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
Get or set the node body text. This is NOT the child tree of the node, |
321
|
|
|
|
|
|
|
it is the literal text as used by text/verbatim nodes. |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
=cut |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
sub body { |
326
|
38
|
|
|
38
|
1
|
41
|
my $self = shift; |
327
|
38
|
50
|
|
|
|
75
|
if(@_) { |
328
|
0
|
|
|
|
|
0
|
my $new_val = shift; |
329
|
0
|
|
|
|
|
0
|
$self->{body} = $new_val; |
330
|
|
|
|
|
|
|
} |
331
|
38
|
|
|
|
|
74
|
return $self->{body}; |
332
|
|
|
|
|
|
|
} |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
=head2 param |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
$node->param( $p_name [, $p_value ] ); |
337
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
Get or set the named parameter. Any value can be used, but for |
339
|
|
|
|
|
|
|
document attributes a Pod::Abstract::Node should be set. |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
=cut |
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
sub param { |
344
|
95
|
|
|
95
|
1
|
95
|
my $self = shift; |
345
|
95
|
|
|
|
|
93
|
my $param_name = shift; |
346
|
95
|
100
|
|
|
|
153
|
if(@_) { |
347
|
1
|
|
|
|
|
2
|
my $new_val = shift; |
348
|
1
|
|
|
|
|
3
|
$self->{params}{$param_name} = $new_val; |
349
|
|
|
|
|
|
|
} |
350
|
95
|
|
|
|
|
224
|
return $self->{params}{$param_name}; |
351
|
|
|
|
|
|
|
} |
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
=head2 duplicate |
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
my $new_node = $node->duplicate; |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
Make a deep-copy of the node. The duplicate node returned has an |
358
|
|
|
|
|
|
|
identical document tree, but different node identifiers. |
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
=cut |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
sub duplicate { |
363
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
364
|
0
|
|
|
|
|
0
|
my $class = ref $self; |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
# Implement the new() call with all the data needed. |
367
|
0
|
|
|
|
|
0
|
my $params = $self->{params}; |
368
|
0
|
|
|
|
|
0
|
my %new_params = ( ); |
369
|
0
|
|
|
|
|
0
|
foreach my $param (keys %$params) { |
370
|
0
|
|
|
|
|
0
|
my $pv = $params->{$param}; |
371
|
0
|
0
|
0
|
|
|
0
|
if(ref $pv && eval { $pv->can('duplicate') } ) { |
|
0
|
0
|
|
|
|
0
|
|
372
|
0
|
|
|
|
|
0
|
$new_params{$param} = $pv->duplicate; |
373
|
|
|
|
|
|
|
} elsif(! ref $pv) { |
374
|
0
|
|
|
|
|
0
|
$new_params{$param} = $pv; |
375
|
|
|
|
|
|
|
} else { |
376
|
0
|
|
|
|
|
0
|
die "Don't know how to copy a ", ref $pv; |
377
|
|
|
|
|
|
|
} |
378
|
|
|
|
|
|
|
} |
379
|
0
|
|
|
|
|
0
|
my $dup = $class->new( |
380
|
|
|
|
|
|
|
type => $self->type, |
381
|
|
|
|
|
|
|
body => $self->body, |
382
|
|
|
|
|
|
|
%new_params, |
383
|
|
|
|
|
|
|
); |
384
|
|
|
|
|
|
|
|
385
|
0
|
|
|
|
|
0
|
my @children = $self->children; |
386
|
0
|
|
|
|
|
0
|
my @dup_children = map { $_->duplicate } @children; |
|
0
|
|
|
|
|
0
|
|
387
|
0
|
|
|
|
|
0
|
$dup->nest(@dup_children); |
388
|
|
|
|
|
|
|
|
389
|
0
|
|
|
|
|
0
|
return $dup; |
390
|
|
|
|
|
|
|
} |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
=head2 insert_before |
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
$node->insert_before($target); |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
Inserts $node before $target, as a sibling of $target. If $node is |
397
|
|
|
|
|
|
|
already in a document tree, it will be removed from it's existing |
398
|
|
|
|
|
|
|
position. |
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
=cut |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
sub insert_before { |
403
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
404
|
0
|
|
|
|
|
0
|
my $target = shift; |
405
|
|
|
|
|
|
|
|
406
|
0
|
|
|
|
|
0
|
my $target_tree = $target->parent->tree; |
407
|
0
|
0
|
|
|
|
0
|
die "Can't insert before a root node" unless $target_tree; |
408
|
0
|
0
|
|
|
|
0
|
if($target_tree->insert_before($target, $self)) { |
409
|
0
|
|
|
|
|
0
|
$self->parent($target->parent); |
410
|
|
|
|
|
|
|
} else { |
411
|
0
|
|
|
|
|
0
|
die "Could not insert before [$target]"; |
412
|
|
|
|
|
|
|
} |
413
|
|
|
|
|
|
|
} |
414
|
|
|
|
|
|
|
|
415
|
|
|
|
|
|
|
=head2 insert_after |
416
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
$node->insert_after($target); |
418
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
Inserts $node after $target, as a sibling of $target. If $node is |
420
|
|
|
|
|
|
|
already in a document tree, it will be removed from it's existing |
421
|
|
|
|
|
|
|
position. |
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
=cut |
424
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
sub insert_after { |
426
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
427
|
0
|
|
|
|
|
0
|
my $target = shift; |
428
|
|
|
|
|
|
|
|
429
|
0
|
|
|
|
|
0
|
my $target_tree = $target->parent->tree; |
430
|
0
|
0
|
|
|
|
0
|
die "Can't insert after a root node" unless $target_tree; |
431
|
0
|
0
|
|
|
|
0
|
if($target_tree->insert_after($target, $self)) { |
432
|
0
|
|
|
|
|
0
|
$self->parent($target->parent); |
433
|
|
|
|
|
|
|
} else { |
434
|
0
|
|
|
|
|
0
|
die "Could not insert before [$target]"; |
435
|
|
|
|
|
|
|
} |
436
|
|
|
|
|
|
|
} |
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
=head2 hoist |
439
|
|
|
|
|
|
|
|
440
|
|
|
|
|
|
|
$node->hoist; |
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
Inserts all children of $node, in order, immediately after |
443
|
|
|
|
|
|
|
$node. After this operation, $node will have no children. In pictures: |
444
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
- a |
446
|
|
|
|
|
|
|
- b |
447
|
|
|
|
|
|
|
- c |
448
|
|
|
|
|
|
|
- d |
449
|
|
|
|
|
|
|
-f |
450
|
|
|
|
|
|
|
|
451
|
|
|
|
|
|
|
$a->hoist; # -> |
452
|
|
|
|
|
|
|
|
453
|
|
|
|
|
|
|
- a |
454
|
|
|
|
|
|
|
- b |
455
|
|
|
|
|
|
|
- c |
456
|
|
|
|
|
|
|
- d |
457
|
|
|
|
|
|
|
- f |
458
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
=cut |
460
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
sub hoist { |
462
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
463
|
0
|
|
|
|
|
0
|
my @children = $self->children; |
464
|
|
|
|
|
|
|
|
465
|
0
|
|
|
|
|
0
|
my $parent = $self->parent; |
466
|
|
|
|
|
|
|
|
467
|
0
|
|
|
|
|
0
|
my $target = $self; |
468
|
0
|
|
|
|
|
0
|
foreach my $n(@children) { |
469
|
0
|
|
|
|
|
0
|
$n->detach; |
470
|
0
|
|
|
|
|
0
|
$n->insert_after($target); |
471
|
0
|
|
|
|
|
0
|
$target = $n; |
472
|
|
|
|
|
|
|
} |
473
|
|
|
|
|
|
|
|
474
|
0
|
|
|
|
|
0
|
return scalar @children; |
475
|
|
|
|
|
|
|
} |
476
|
|
|
|
|
|
|
|
477
|
|
|
|
|
|
|
=head2 clear |
478
|
|
|
|
|
|
|
|
479
|
|
|
|
|
|
|
$node->clear; |
480
|
|
|
|
|
|
|
|
481
|
|
|
|
|
|
|
Detach all children of $node. The detached nodes will be returned, and |
482
|
|
|
|
|
|
|
can be safely reused, but they will no longer be in the document tree. |
483
|
|
|
|
|
|
|
|
484
|
|
|
|
|
|
|
=cut |
485
|
|
|
|
|
|
|
|
486
|
|
|
|
|
|
|
sub clear { |
487
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
488
|
0
|
|
|
|
|
0
|
my @children = $self->children; |
489
|
|
|
|
|
|
|
|
490
|
0
|
|
|
|
|
0
|
foreach my $n (@children) { |
491
|
0
|
|
|
|
|
0
|
$n->detach; |
492
|
|
|
|
|
|
|
} |
493
|
|
|
|
|
|
|
|
494
|
0
|
|
|
|
|
0
|
return @children; |
495
|
|
|
|
|
|
|
} |
496
|
|
|
|
|
|
|
|
497
|
|
|
|
|
|
|
=head2 push |
498
|
|
|
|
|
|
|
|
499
|
|
|
|
|
|
|
$node->push($target); |
500
|
|
|
|
|
|
|
|
501
|
|
|
|
|
|
|
Pushes $target at the end of $node's children. |
502
|
|
|
|
|
|
|
|
503
|
|
|
|
|
|
|
=cut |
504
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
sub push { |
506
|
27
|
|
|
27
|
1
|
33
|
my $self = shift; |
507
|
27
|
|
|
|
|
26
|
my $target = shift; |
508
|
|
|
|
|
|
|
|
509
|
27
|
|
|
|
|
52
|
my $target_tree = $self->tree; |
510
|
27
|
50
|
|
|
|
78
|
if($target_tree->push($target)) { |
511
|
27
|
|
|
|
|
52
|
$target->parent($self); |
512
|
|
|
|
|
|
|
} else { |
513
|
0
|
|
|
|
|
0
|
die "Could not push [$target]"; |
514
|
|
|
|
|
|
|
} |
515
|
|
|
|
|
|
|
} |
516
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
=head2 nest |
518
|
|
|
|
|
|
|
|
519
|
|
|
|
|
|
|
$node->nest(@new_children); |
520
|
|
|
|
|
|
|
|
521
|
|
|
|
|
|
|
Adds @new_children to $node's children. The new nodes will be added at |
522
|
|
|
|
|
|
|
the end of any existing children. This can be considered the inverse |
523
|
|
|
|
|
|
|
of hoist. |
524
|
|
|
|
|
|
|
|
525
|
|
|
|
|
|
|
=cut |
526
|
|
|
|
|
|
|
|
527
|
|
|
|
|
|
|
sub nest { |
528
|
4
|
|
|
4
|
1
|
13
|
my $self = shift; |
529
|
|
|
|
|
|
|
|
530
|
4
|
|
|
|
|
9
|
foreach my $target (@_) { |
531
|
4
|
|
|
|
|
9
|
$self->push($target); |
532
|
|
|
|
|
|
|
} |
533
|
|
|
|
|
|
|
|
534
|
4
|
|
|
|
|
15
|
return @_; |
535
|
|
|
|
|
|
|
} |
536
|
|
|
|
|
|
|
|
537
|
|
|
|
|
|
|
sub tree { |
538
|
133
|
|
|
133
|
0
|
147
|
my $self = shift; |
539
|
133
|
|
|
|
|
388
|
return $self->{tree}; |
540
|
|
|
|
|
|
|
} |
541
|
|
|
|
|
|
|
|
542
|
|
|
|
|
|
|
=head2 unshift |
543
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
$node->unshift($target); |
545
|
|
|
|
|
|
|
|
546
|
|
|
|
|
|
|
The reverse of push, add a node to the start of $node's children. |
547
|
|
|
|
|
|
|
|
548
|
|
|
|
|
|
|
=cut |
549
|
|
|
|
|
|
|
|
550
|
|
|
|
|
|
|
sub unshift { |
551
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
552
|
0
|
|
|
|
|
0
|
my $target = shift; |
553
|
|
|
|
|
|
|
|
554
|
0
|
|
|
|
|
0
|
my $target_tree = $self->tree; |
555
|
0
|
0
|
|
|
|
0
|
if($target_tree->unshift($target)) { |
556
|
0
|
|
|
|
|
0
|
$target->parent($self); |
557
|
|
|
|
|
|
|
} else { |
558
|
0
|
|
|
|
|
0
|
die "Could not unshift [$target]"; |
559
|
|
|
|
|
|
|
} |
560
|
|
|
|
|
|
|
} |
561
|
|
|
|
|
|
|
|
562
|
|
|
|
|
|
|
=head2 serial |
563
|
|
|
|
|
|
|
|
564
|
|
|
|
|
|
|
$node->serial; |
565
|
|
|
|
|
|
|
|
566
|
|
|
|
|
|
|
The unique serial number of $node. This should never be modified. |
567
|
|
|
|
|
|
|
|
568
|
|
|
|
|
|
|
=cut |
569
|
|
|
|
|
|
|
|
570
|
|
|
|
|
|
|
sub serial { |
571
|
128
|
|
|
128
|
1
|
139
|
my $self = shift; |
572
|
128
|
|
|
|
|
483
|
return $self->{serial}; |
573
|
|
|
|
|
|
|
} |
574
|
|
|
|
|
|
|
|
575
|
|
|
|
|
|
|
=head2 attached |
576
|
|
|
|
|
|
|
|
577
|
|
|
|
|
|
|
$node->attached; |
578
|
|
|
|
|
|
|
|
579
|
|
|
|
|
|
|
Returns true if $node is attached to a document tree. |
580
|
|
|
|
|
|
|
|
581
|
|
|
|
|
|
|
=cut |
582
|
|
|
|
|
|
|
|
583
|
|
|
|
|
|
|
sub attached { |
584
|
27
|
|
|
27
|
1
|
30
|
my $self = shift; |
585
|
27
|
|
|
|
|
53
|
return defined $self->parent; |
586
|
|
|
|
|
|
|
} |
587
|
|
|
|
|
|
|
|
588
|
|
|
|
|
|
|
=head2 detach |
589
|
|
|
|
|
|
|
|
590
|
|
|
|
|
|
|
$node->detach; |
591
|
|
|
|
|
|
|
|
592
|
|
|
|
|
|
|
Removes a node from it's document tree. Returns true if the node was |
593
|
|
|
|
|
|
|
removed from a tree, false otherwise. After this operation, the node |
594
|
|
|
|
|
|
|
will be detached. |
595
|
|
|
|
|
|
|
|
596
|
|
|
|
|
|
|
Detached nodes can be reused safely. |
597
|
|
|
|
|
|
|
|
598
|
|
|
|
|
|
|
=cut |
599
|
|
|
|
|
|
|
|
600
|
|
|
|
|
|
|
sub detach { |
601
|
1
|
|
|
1
|
1
|
2
|
my $self = shift; |
602
|
|
|
|
|
|
|
|
603
|
1
|
50
|
|
|
|
2
|
if($self->parent) { |
604
|
1
|
|
|
|
|
9
|
$self->parent->tree->detach($self); |
605
|
1
|
|
|
|
|
2
|
return 1; |
606
|
|
|
|
|
|
|
} else { |
607
|
0
|
|
|
|
|
0
|
return 0; |
608
|
|
|
|
|
|
|
} |
609
|
|
|
|
|
|
|
} |
610
|
|
|
|
|
|
|
|
611
|
|
|
|
|
|
|
=head2 parent |
612
|
|
|
|
|
|
|
|
613
|
|
|
|
|
|
|
$node->parent; |
614
|
|
|
|
|
|
|
|
615
|
|
|
|
|
|
|
Returns the parent of $node if available. Returns undef if no parent. |
616
|
|
|
|
|
|
|
|
617
|
|
|
|
|
|
|
=cut |
618
|
|
|
|
|
|
|
|
619
|
|
|
|
|
|
|
sub parent { |
620
|
58
|
|
|
58
|
1
|
72
|
my $self = shift; |
621
|
|
|
|
|
|
|
|
622
|
58
|
100
|
|
|
|
107
|
if(@_) { |
623
|
28
|
|
|
|
|
31
|
my $new_parent = shift; |
624
|
28
|
50
|
66
|
|
|
73
|
if( defined $self->{parent} && |
625
|
|
|
|
|
|
|
$self->parent->tree->detach($self) ) { |
626
|
0
|
|
|
|
|
0
|
warn "Implicit detach when reparenting"; |
627
|
|
|
|
|
|
|
} |
628
|
28
|
|
|
|
|
36
|
$self->{parent} = $new_parent; |
629
|
|
|
|
|
|
|
|
630
|
|
|
|
|
|
|
# Parent nodes have to be weak - otherwise we leak. |
631
|
28
|
100
|
|
|
|
118
|
weaken $self->{parent} |
632
|
|
|
|
|
|
|
if defined $self->{parent}; |
633
|
|
|
|
|
|
|
} |
634
|
|
|
|
|
|
|
|
635
|
58
|
|
|
|
|
287
|
return $self->{parent}; |
636
|
|
|
|
|
|
|
} |
637
|
|
|
|
|
|
|
|
638
|
|
|
|
|
|
|
=head2 root |
639
|
|
|
|
|
|
|
|
640
|
|
|
|
|
|
|
$node->root |
641
|
|
|
|
|
|
|
|
642
|
|
|
|
|
|
|
Find the root node for the tree holding this node - this may be the |
643
|
|
|
|
|
|
|
original node if it has no parent. |
644
|
|
|
|
|
|
|
|
645
|
|
|
|
|
|
|
=cut |
646
|
|
|
|
|
|
|
|
647
|
|
|
|
|
|
|
sub root { |
648
|
0
|
|
|
0
|
1
|
0
|
my $n = shift; |
649
|
|
|
|
|
|
|
|
650
|
0
|
|
|
|
|
0
|
while(defined $n->parent) { |
651
|
0
|
|
|
|
|
0
|
$n = $n->parent; |
652
|
|
|
|
|
|
|
} |
653
|
|
|
|
|
|
|
|
654
|
0
|
|
|
|
|
0
|
return $n; |
655
|
|
|
|
|
|
|
} |
656
|
|
|
|
|
|
|
|
657
|
|
|
|
|
|
|
=head2 children |
658
|
|
|
|
|
|
|
|
659
|
|
|
|
|
|
|
my @children = $node->children; |
660
|
|
|
|
|
|
|
|
661
|
|
|
|
|
|
|
Returns the children of the node in document order. |
662
|
|
|
|
|
|
|
|
663
|
|
|
|
|
|
|
=cut |
664
|
|
|
|
|
|
|
|
665
|
|
|
|
|
|
|
sub children { |
666
|
104
|
|
|
104
|
1
|
117
|
my $self = shift; |
667
|
104
|
|
|
|
|
175
|
return $self->tree->children(); |
668
|
|
|
|
|
|
|
} |
669
|
|
|
|
|
|
|
|
670
|
|
|
|
|
|
|
=head2 next |
671
|
|
|
|
|
|
|
|
672
|
|
|
|
|
|
|
my $next = $node->next; |
673
|
|
|
|
|
|
|
|
674
|
|
|
|
|
|
|
Returns the following sibling of $node, if one exists. If there is no |
675
|
|
|
|
|
|
|
following node undef will be returned. |
676
|
|
|
|
|
|
|
|
677
|
|
|
|
|
|
|
=cut |
678
|
|
|
|
|
|
|
|
679
|
|
|
|
|
|
|
sub next { |
680
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
681
|
0
|
|
|
|
|
0
|
my $parent = $self->parent; |
682
|
|
|
|
|
|
|
|
683
|
0
|
0
|
|
|
|
0
|
return undef unless $parent; # No following node for root nodes. |
684
|
0
|
|
|
|
|
0
|
return $parent->tree->index_relative($self,+1); |
685
|
|
|
|
|
|
|
} |
686
|
|
|
|
|
|
|
|
687
|
|
|
|
|
|
|
=head2 previous |
688
|
|
|
|
|
|
|
|
689
|
|
|
|
|
|
|
my $previous = $node->previous; |
690
|
|
|
|
|
|
|
|
691
|
|
|
|
|
|
|
Returns the preceding sibling of $node, if one exists. If there is no |
692
|
|
|
|
|
|
|
preceding node, undef will be returned. |
693
|
|
|
|
|
|
|
|
694
|
|
|
|
|
|
|
=cut |
695
|
|
|
|
|
|
|
|
696
|
|
|
|
|
|
|
sub previous { |
697
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
698
|
0
|
|
|
|
|
0
|
my $parent = $self->parent; |
699
|
|
|
|
|
|
|
|
700
|
0
|
0
|
|
|
|
0
|
return undef unless $parent; # No preceding nodes for root nodes. |
701
|
0
|
|
|
|
|
0
|
return $parent->tree->index_relative($self,-1); |
702
|
|
|
|
|
|
|
} |
703
|
|
|
|
|
|
|
|
704
|
|
|
|
|
|
|
=head2 coalesce_body |
705
|
|
|
|
|
|
|
|
706
|
|
|
|
|
|
|
$node->coalesce_body(':verbatim'); |
707
|
|
|
|
|
|
|
|
708
|
|
|
|
|
|
|
This performs node coalescing as required by perlpodspec. Successive |
709
|
|
|
|
|
|
|
verbatim nodes can be merged into a single node. This is also done |
710
|
|
|
|
|
|
|
with text nodes, primarily for =begin/=end blocks. |
711
|
|
|
|
|
|
|
|
712
|
|
|
|
|
|
|
The named node type will be merged together in the child document |
713
|
|
|
|
|
|
|
wherever there are two or more successive nodes of that type. Don't |
714
|
|
|
|
|
|
|
use for anything except C<:text> and C<:verbatim> nodes unless you're |
715
|
|
|
|
|
|
|
really sure you know what you want. |
716
|
|
|
|
|
|
|
|
717
|
|
|
|
|
|
|
=cut |
718
|
|
|
|
|
|
|
|
719
|
|
|
|
|
|
|
sub coalesce_body { |
720
|
10
|
|
|
10
|
1
|
15
|
my $self = shift; |
721
|
10
|
|
|
|
|
16
|
my $node_type = shift; |
722
|
|
|
|
|
|
|
|
723
|
|
|
|
|
|
|
# Select all elements containing :verbatim nodes. |
724
|
10
|
|
|
|
|
36
|
my @candidates = $self->select("//[/$node_type]"); |
725
|
10
|
|
|
|
|
34
|
foreach my $c (@candidates) { |
726
|
3
|
|
|
|
|
6
|
my @children = $c->children; |
727
|
3
|
|
|
|
|
4
|
my $current_start = undef; |
728
|
3
|
|
|
|
|
4
|
foreach my $n (@children) { |
729
|
4
|
100
|
|
|
|
9
|
if($n->type eq $node_type) { |
730
|
3
|
50
|
|
|
|
6
|
if(defined $current_start) { |
731
|
0
|
|
|
|
|
0
|
my $p_break = $current_start->param('p_break'); |
732
|
0
|
0
|
|
|
|
0
|
$p_break = "" unless $p_break; |
733
|
0
|
|
|
|
|
0
|
my $body_start = $current_start->body; |
734
|
0
|
|
|
|
|
0
|
$current_start->body( |
735
|
|
|
|
|
|
|
$body_start . $p_break . $n->body |
736
|
|
|
|
|
|
|
); |
737
|
0
|
|
|
|
|
0
|
$current_start->param('p_break', |
738
|
|
|
|
|
|
|
$n->param('p_break')); |
739
|
0
|
0
|
|
|
|
0
|
$n->detach or die; # node has been appended to prev. |
740
|
|
|
|
|
|
|
} else { |
741
|
3
|
|
|
|
|
9
|
$current_start = $n; |
742
|
|
|
|
|
|
|
} |
743
|
|
|
|
|
|
|
} else { |
744
|
1
|
|
|
|
|
3
|
$current_start = undef; |
745
|
|
|
|
|
|
|
} |
746
|
|
|
|
|
|
|
} |
747
|
|
|
|
|
|
|
} |
748
|
|
|
|
|
|
|
} |
749
|
|
|
|
|
|
|
|
750
|
|
|
|
|
|
|
=head1 AUTHOR |
751
|
|
|
|
|
|
|
|
752
|
|
|
|
|
|
|
Ben Lilburne |
753
|
|
|
|
|
|
|
|
754
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
755
|
|
|
|
|
|
|
|
756
|
|
|
|
|
|
|
Copyright (C) 2009 Ben Lilburne |
757
|
|
|
|
|
|
|
|
758
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify |
759
|
|
|
|
|
|
|
it under the same terms as Perl itself. |
760
|
|
|
|
|
|
|
|
761
|
|
|
|
|
|
|
=cut |
762
|
|
|
|
|
|
|
|
763
|
|
|
|
|
|
|
|
764
|
|
|
|
|
|
|
1; |