line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Pod::Query; |
2
|
|
|
|
|
|
|
|
3
|
7
|
|
|
7
|
|
363922
|
use v5.16; |
|
7
|
|
|
|
|
47
|
|
4
|
7
|
|
|
7
|
|
52
|
use strict; |
|
7
|
|
|
|
|
15
|
|
|
7
|
|
|
|
|
141
|
|
5
|
7
|
|
|
7
|
|
28
|
use warnings; |
|
7
|
|
|
|
|
10
|
|
|
7
|
|
|
|
|
154
|
|
6
|
7
|
|
|
7
|
|
3102
|
use Pod::Text(); |
|
7
|
|
|
|
|
247190
|
|
|
7
|
|
|
|
|
167
|
|
7
|
7
|
|
|
7
|
|
2818
|
use Pod::LOL(); |
|
7
|
|
|
|
|
44250
|
|
|
7
|
|
|
|
|
166
|
|
8
|
7
|
|
|
7
|
|
2538
|
use File::Spec::Functions qw( catfile ); |
|
7
|
|
|
|
|
3750
|
|
|
7
|
|
|
|
|
419
|
|
9
|
7
|
|
|
7
|
|
40
|
use List::Util qw( first ); |
|
7
|
|
|
|
|
13
|
|
|
7
|
|
|
|
|
612
|
|
10
|
7
|
|
|
7
|
|
2605
|
use Text::ParseWords qw( parse_line ); |
|
7
|
|
|
|
|
6931
|
|
|
7
|
|
|
|
|
324
|
|
11
|
7
|
|
|
7
|
|
2323
|
use Term::Size::Any qw( chars ); |
|
7
|
|
|
|
|
1221
|
|
|
7
|
|
|
|
|
36
|
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
=head1 NAME |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
Pod::Query - Query pod documents |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
=head1 VERSION |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
Version 0.36 |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
=cut |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
our $VERSION = '0.36'; |
24
|
|
|
|
|
|
|
our $DEBUG_LOL_DUMP = 0; |
25
|
|
|
|
|
|
|
our $DEBUG_STRUCT_OVER = 0; |
26
|
|
|
|
|
|
|
our $DEBUG_TREE = 0; |
27
|
|
|
|
|
|
|
our $DEBUG_TREE_DUMP = 0; |
28
|
|
|
|
|
|
|
our $DEBUG_FIND_CONDITIONS = 0; |
29
|
|
|
|
|
|
|
our $DEBUG_FIND_AFTER_DEFAULTS = 0; |
30
|
|
|
|
|
|
|
our $DEBUG_PRE_FIND_DUMP = 0; |
31
|
|
|
|
|
|
|
our $DEBUG_FIND = 0; |
32
|
|
|
|
|
|
|
our $DEBUG_FIND_DUMP = 0; |
33
|
|
|
|
|
|
|
our $DEBUG_INVERT = 0; |
34
|
|
|
|
|
|
|
our $DEBUG_RENDER = 0; |
35
|
|
|
|
|
|
|
our $MOCK_ROOT = 0; |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
=head1 SYNOPSIS |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
Query POD information from a file |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
% perl -MPod::Query -E 'say for Pod::Query->new("ojo")->find("head1[0]")' |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
NAME |
44
|
|
|
|
|
|
|
ojo - Fun one-liners with Mojo |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
% perl -MPod::Query -E 'say Pod::Query->new("ojo")->find("head1[0]/Para[0]")' |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
ojo - Fun one-liners with Mojo |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
% perl -MPod::Query -E 'say Pod::Query->new(shift)->find("head1[0]/Para[0]")' my.pod |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
Find Methods: |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
find_title; |
55
|
|
|
|
|
|
|
find_method; |
56
|
|
|
|
|
|
|
find_method_summary; |
57
|
|
|
|
|
|
|
find_events; |
58
|
|
|
|
|
|
|
find($query_sting); |
59
|
|
|
|
|
|
|
find(@query_structs); |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
=head1 DESCRIPTION |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
This module takes a class name, extracts the POD |
64
|
|
|
|
|
|
|
and provides methods to query specific information. |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
=head1 SUBROUTINES/METHODS |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
=cut |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
# |
71
|
|
|
|
|
|
|
# Method maker |
72
|
|
|
|
|
|
|
# |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
=head2 _has |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
Generates class accessor methods (like Mojo::Base::attr) |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
=cut |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
sub _has { |
81
|
7
|
|
|
7
|
|
7870
|
no strict 'refs'; |
|
7
|
|
|
|
|
12
|
|
|
7
|
|
|
|
|
23578
|
|
82
|
7
|
|
|
7
|
|
18
|
for my $attr ( @_ ) { |
83
|
|
|
|
|
|
|
*$attr = sub { |
84
|
155
|
100
|
|
155
|
|
477
|
return $_[0]{$attr} if @_ == 1; # Get: return $self-<{$attr} |
85
|
27
|
|
|
|
|
63
|
$_[0]{$attr} = $_[1]; # Set: $self->{$attr} = $val |
86
|
27
|
|
|
|
|
46
|
$_[0]; # return $self |
87
|
28
|
|
|
|
|
167
|
}; |
88
|
|
|
|
|
|
|
} |
89
|
|
|
|
|
|
|
} |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
=head2 path |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
Path to the pod class file |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
=head2 lol |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
List of lists (LOL) structure of the pod file. |
98
|
|
|
|
|
|
|
Result of Pod::LOL. |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
=head2 tree |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
An hierarchy is added to the lol to create a |
103
|
|
|
|
|
|
|
tree like structure of the pod file. |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
=head2 class_is_path |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
Flag to indicate if the class is really a path to the file. |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
=cut |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
sub import { |
112
|
7
|
|
|
7
|
|
95
|
_has qw( |
113
|
|
|
|
|
|
|
path |
114
|
|
|
|
|
|
|
lol |
115
|
|
|
|
|
|
|
tree |
116
|
|
|
|
|
|
|
class_is_path |
117
|
|
|
|
|
|
|
); |
118
|
|
|
|
|
|
|
} |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
# |
121
|
|
|
|
|
|
|
# Debug |
122
|
|
|
|
|
|
|
# |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
sub _dumper { |
125
|
0
|
|
|
0
|
|
0
|
require Data::Dumper; |
126
|
0
|
|
|
|
|
0
|
my $data = Data::Dumper |
127
|
|
|
|
|
|
|
->new( [@_] ) |
128
|
|
|
|
|
|
|
->Indent( 1 ) |
129
|
|
|
|
|
|
|
->Sortkeys( 1 ) |
130
|
|
|
|
|
|
|
->Terse( 1 ) |
131
|
|
|
|
|
|
|
->Useqq( 1 ) |
132
|
|
|
|
|
|
|
->Dump; |
133
|
0
|
0
|
|
|
|
0
|
return $data if defined wantarray; |
134
|
0
|
|
|
|
|
0
|
say $data; |
135
|
|
|
|
|
|
|
} |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
=head2 new |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
Create a new object. |
140
|
|
|
|
|
|
|
Return value is cached (based on the class of the pod file). |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
use Pod::Query; |
143
|
|
|
|
|
|
|
my $pod = Pod::Query->new('Pod::LOL', PATH_ONLY=0); |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
PATH_ONLY can be used to determine the path to the pod |
146
|
|
|
|
|
|
|
document without having to do much unnecessary work. |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
=cut |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
sub new { |
151
|
9
|
|
|
9
|
1
|
6804
|
my ( $class, $pod_class, $path_only ) = @_; |
152
|
9
|
|
50
|
|
|
39
|
$path_only //= 0; |
153
|
9
|
|
|
|
|
9
|
state %CACHE; |
154
|
|
|
|
|
|
|
|
155
|
9
|
|
|
|
|
11
|
my $cached; |
156
|
9
|
50
|
|
|
|
19
|
return $cached if $cached = $CACHE{$pod_class}; |
157
|
|
|
|
|
|
|
|
158
|
9
|
|
|
|
|
24
|
my $s = bless { |
159
|
|
|
|
|
|
|
pod_class => $pod_class, |
160
|
|
|
|
|
|
|
lol => [], |
161
|
|
|
|
|
|
|
tree => [], |
162
|
|
|
|
|
|
|
}, $class; |
163
|
|
|
|
|
|
|
|
164
|
9
|
|
|
|
|
20
|
$s->path( $s->_class_to_path( $pod_class ) ); |
165
|
|
|
|
|
|
|
|
166
|
9
|
50
|
33
|
|
|
27
|
return $s if $path_only or not $s->path; |
167
|
|
|
|
|
|
|
|
168
|
9
|
50
|
|
|
|
24
|
my $lol = $MOCK_ROOT ? _mock_root() : Pod::LOL->new_root( $s->path ); |
169
|
9
|
|
|
|
|
707
|
$lol = _flatten_for_tags( $lol ); |
170
|
9
|
50
|
|
|
|
23
|
if ( $DEBUG_LOL_DUMP ) { |
171
|
0
|
|
|
|
|
0
|
say "DEBUG_LOL_DUMP: " . _dumper $lol; |
172
|
0
|
|
|
|
|
0
|
exit; |
173
|
|
|
|
|
|
|
} |
174
|
|
|
|
|
|
|
|
175
|
9
|
|
|
|
|
21
|
$s->lol( $lol ); |
176
|
9
|
|
|
|
|
17
|
$s->tree( _lol_to_tree( $lol ) ); |
177
|
9
|
50
|
|
|
|
17
|
if ( $DEBUG_TREE_DUMP ) { |
178
|
0
|
|
|
|
|
0
|
say "DEBUG_TREE_DUMP: " . _dumper $s->tree(); |
179
|
0
|
|
|
|
|
0
|
exit; |
180
|
|
|
|
|
|
|
} |
181
|
|
|
|
|
|
|
|
182
|
9
|
|
|
|
|
17
|
$CACHE{$pod_class} = $s; |
183
|
|
|
|
|
|
|
|
184
|
9
|
|
|
|
|
37
|
$s; |
185
|
|
|
|
|
|
|
} |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
=head2 _class_to_path |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
Given a class name, returns the path to the pod file. |
190
|
|
|
|
|
|
|
Return value is cached (based on the class of the pod file). |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
If the class is not found in INC, it will be checked whether |
193
|
|
|
|
|
|
|
the input is an existing file path. |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
Returns an empty string if there are any errors. |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
=cut |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
sub _class_to_path { |
200
|
4
|
|
|
4
|
|
2182
|
my ( $s, $pod_class ) = @_; |
201
|
4
|
|
|
|
|
4
|
state %CACHE; |
202
|
4
|
|
|
|
|
5
|
my $path; |
203
|
|
|
|
|
|
|
|
204
|
4
|
50
|
|
|
|
9
|
return $path if $path = $CACHE{$pod_class}; |
205
|
|
|
|
|
|
|
|
206
|
4
|
|
|
|
|
15
|
my $partial_path = catfile( split /::/, $pod_class ) . '.pm'; |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
# Shortcut for files already used. |
209
|
4
|
|
|
|
|
7
|
$path = $INC{$partial_path}; |
210
|
4
|
50
|
33
|
|
|
10
|
return $CACHE{$pod_class} = $path if $path and -f $path; |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
# Otherwise find it ourselves. |
213
|
4
|
|
|
|
|
5
|
for ( @INC ) { |
214
|
22
|
|
|
|
|
82
|
$path = catfile( $_, $partial_path ); |
215
|
22
|
100
|
66
|
|
|
260
|
return $CACHE{$pod_class} = $path if $path and -f $path; |
216
|
|
|
|
|
|
|
} |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
# Check for it in PATH also. |
219
|
|
|
|
|
|
|
# Maybe pod_class is the path. |
220
|
2
|
|
|
|
|
10
|
for ( "", split /:/, $ENV{PATH} ) { |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
# Absolute path or current folder means class is path. |
223
|
11
|
100
|
66
|
|
|
49
|
$path = ( $_ and $_ ne "." ) ? catfile( $_, $pod_class ) : $pod_class; |
224
|
11
|
100
|
66
|
|
|
94
|
if ( $path and -f $path ) { |
225
|
1
|
50
|
|
|
|
4
|
$s->class_is_path( 1 ) if ref $s; |
226
|
1
|
|
|
|
|
5
|
return $CACHE{$pod_class} = $path; |
227
|
|
|
|
|
|
|
} |
228
|
|
|
|
|
|
|
} |
229
|
|
|
|
|
|
|
|
230
|
1
|
|
|
|
|
4
|
return ""; |
231
|
|
|
|
|
|
|
} |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
=head2 _mock_root |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
For debugging and/or testing. |
236
|
|
|
|
|
|
|
Builds a sample object (overwrite this in a test file). |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
=cut |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
0
|
|
|
sub _mock_root { } |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
=head2 _flatten_for_tags |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
Removes for tags from the lol and flattens |
245
|
|
|
|
|
|
|
out the inner tags to be on the same level as the for |
246
|
|
|
|
|
|
|
tag was. |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
=cut |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
sub _flatten_for_tags { |
251
|
9
|
|
|
9
|
|
15
|
my ( $lol ) = @_; |
252
|
9
|
|
|
|
|
12
|
my @flat; |
253
|
|
|
|
|
|
|
|
254
|
9
|
|
|
|
|
16
|
for ( @$lol ) { |
255
|
322
|
|
|
|
|
375
|
my ( $tag, @data ) = @$_; |
256
|
322
|
|
50
|
|
|
344
|
$tag //= ''; |
257
|
|
|
|
|
|
|
|
258
|
322
|
50
|
|
|
|
395
|
push @flat, ( $tag eq "for" ) ? @data : $_; |
259
|
|
|
|
|
|
|
} |
260
|
|
|
|
|
|
|
|
261
|
9
|
|
|
|
|
19
|
\@flat; |
262
|
|
|
|
|
|
|
} |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
=head2 _lol_to_tree |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
Generates a tree from a Pod::LOL object. |
267
|
|
|
|
|
|
|
The structure of the tree is based on the N (level) in "=headN". |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
This example pod: |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
=head1 FUNCTIONS |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
=Para Description of Functions |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
=head2 Function1 |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
=Para Description of Function1 |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
=head1 AUTHOR |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
=cut |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
This will be grouped as: |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
=head1 FUNCTIONS |
286
|
|
|
|
|
|
|
=Para Description of Functions |
287
|
|
|
|
|
|
|
=head2 Function1 |
288
|
|
|
|
|
|
|
=Para Description of Function1 |
289
|
|
|
|
|
|
|
=head1 AUTHOR |
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
In summary: |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
=over 2 |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
=item * |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
Non "head" tags are always grouped "below". |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
=item * |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
HeadN tags with a higher N with also be grouped below. |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
=item * |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
HeadN tags with the same or lower N will be grouped higher. |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
=back |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
=cut |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
sub _lol_to_tree { |
312
|
14
|
|
|
14
|
|
20
|
my ( $lol ) = @_; |
313
|
14
|
|
|
|
|
16
|
my ( $is_in, $is_out ); |
314
|
14
|
|
|
|
|
36
|
my %heads_table = __PACKAGE__->_define_heads_regex_table(); |
315
|
14
|
|
|
|
|
34
|
my $is_head = qr/ ^ head (\d) $ /x; |
316
|
14
|
|
|
|
|
21
|
my $node = {}; |
317
|
14
|
|
|
|
|
15
|
my @tree; |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
my $push = sub { # push to tree. |
320
|
107
|
100
|
|
107
|
|
145
|
return if not %$node; |
321
|
93
|
|
|
|
|
84
|
my $kids = $node->{kids}; |
322
|
|
|
|
|
|
|
$node->{kids} = _lol_to_tree( $kids ) |
323
|
93
|
100
|
100
|
|
|
347
|
if ref( $kids ) && first { $_->{tag} =~ /$is_head/ } @$kids; |
|
238
|
|
|
|
|
524
|
|
324
|
93
|
|
|
|
|
174
|
push @tree, $node; |
325
|
93
|
|
|
|
|
113
|
$node = {}; |
326
|
14
|
|
|
|
|
47
|
}; |
327
|
|
|
|
|
|
|
|
328
|
14
|
50
|
|
|
|
48
|
say "\n_ROOT_TO_TREE()" if $DEBUG_TREE; |
329
|
|
|
|
|
|
|
|
330
|
14
|
|
|
|
|
23
|
for ( $lol->@* ) { |
331
|
545
|
50
|
|
|
|
661
|
say "\n_=", _dumper $_ if $DEBUG_TREE; |
332
|
|
|
|
|
|
|
|
333
|
545
|
|
|
|
|
566
|
my $leaf = _make_leaf( $_ ); |
334
|
545
|
50
|
|
|
|
662
|
say "\nleaf=", _dumper $leaf if $DEBUG_TREE; |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
# Outer tag. |
337
|
545
|
100
|
100
|
|
|
1628
|
if ( not $is_in or $leaf->{tag} =~ /$is_out/ ) { |
338
|
93
|
|
|
|
|
175
|
$push->(); |
339
|
93
|
|
|
|
|
98
|
$node = $leaf; |
340
|
93
|
100
|
|
|
|
286
|
if ( $leaf->{tag} =~ /$is_head/ ) { |
341
|
88
|
|
|
|
|
204
|
( $is_in, $is_out ) = $heads_table{$1}->@*; |
342
|
|
|
|
|
|
|
} |
343
|
|
|
|
|
|
|
} |
344
|
|
|
|
|
|
|
else { |
345
|
452
|
|
|
|
|
560
|
push $node->{kids}->@*, $leaf; |
346
|
452
|
50
|
|
|
|
623
|
say "node: ", _dumper $node if $DEBUG_TREE; |
347
|
|
|
|
|
|
|
} |
348
|
|
|
|
|
|
|
} |
349
|
|
|
|
|
|
|
|
350
|
14
|
|
|
|
|
25
|
$push->(); |
351
|
|
|
|
|
|
|
|
352
|
14
|
|
|
|
|
122
|
\@tree; |
353
|
|
|
|
|
|
|
} |
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
=head2 _define_heads_regex_table |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
Generates the regexes for head elements inside |
358
|
|
|
|
|
|
|
and outside the current head. |
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
=cut |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
sub _define_heads_regex_table { |
363
|
|
|
|
|
|
|
map { |
364
|
14
|
|
|
14
|
|
25
|
my $inner = join "", $_ + 1 .. 5; # num=2, inner=345 |
|
56
|
|
|
|
|
130
|
|
365
|
56
|
|
|
|
|
98
|
my $outer = join "", 0 .. $_; # num=2, outer=012 |
366
|
|
|
|
|
|
|
|
367
|
56
|
|
|
|
|
70
|
$_ => [ map { qr/ ^ head ([$_]) $ /x } $inner, $outer ] |
|
112
|
|
|
|
|
1129
|
|
368
|
|
|
|
|
|
|
} 1 .. 4; |
369
|
|
|
|
|
|
|
} |
370
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
=head2 _make_leaf |
372
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
Creates a new node (aka leaf). |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
=cut |
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
sub _make_leaf { |
378
|
545
|
|
|
545
|
|
546
|
my ( $node ) = @_; |
379
|
545
|
100
|
|
|
|
877
|
return $node if ref $node eq ref {}; |
380
|
|
|
|
|
|
|
|
381
|
322
|
|
|
|
|
491
|
my ( $tag, @text ) = @$node; |
382
|
322
|
|
|
|
|
457
|
my $leaf = { tag => $tag }; |
383
|
|
|
|
|
|
|
|
384
|
322
|
100
|
|
|
|
416
|
if ( $tag =~ / ^ over- /x ) { |
385
|
7
|
|
|
|
|
11
|
$leaf->{kids} = _structure_over( \@text ); |
386
|
7
|
|
|
|
|
11
|
$leaf->{text} = ""; |
387
|
|
|
|
|
|
|
} |
388
|
|
|
|
|
|
|
else { |
389
|
315
|
|
|
|
|
656
|
$leaf->{text} = join "", @text; |
390
|
|
|
|
|
|
|
} |
391
|
|
|
|
|
|
|
|
392
|
322
|
|
|
|
|
421
|
$leaf; |
393
|
|
|
|
|
|
|
} |
394
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
=head2 _structure_over |
396
|
|
|
|
|
|
|
|
397
|
|
|
|
|
|
|
Restructures the text for an "over-text" element to be under it. |
398
|
|
|
|
|
|
|
Also, "item-text" will be the first element of each group. |
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
=cut |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
sub _structure_over { |
403
|
7
|
|
|
7
|
|
8
|
my ( $text_list ) = @_; |
404
|
7
|
|
|
|
|
8
|
my @struct; |
405
|
|
|
|
|
|
|
my @nodes; |
406
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
my $push = sub { |
408
|
74
|
100
|
|
74
|
|
100
|
return if not @nodes; |
409
|
|
|
|
|
|
|
|
410
|
|
|
|
|
|
|
# First is the parent node. |
411
|
67
|
|
|
|
|
68
|
my $item_text = shift @nodes; |
412
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
# Treat the rest of the tags as kids. |
414
|
67
|
100
|
|
|
|
237
|
push @struct, |
415
|
|
|
|
|
|
|
{ %$item_text, @nodes ? ( kids => [ splice @nodes ] ) : (), }; |
416
|
7
|
|
|
|
|
25
|
}; |
417
|
|
|
|
|
|
|
|
418
|
7
|
|
|
|
|
11
|
for ( @$text_list ) { |
419
|
242
|
|
|
|
|
345
|
my ( $tag, @text ) = @$_; |
420
|
242
|
100
|
|
|
|
379
|
$push->() if $tag =~ / ^ item- /x; |
421
|
242
|
|
|
|
|
634
|
push @nodes, |
422
|
|
|
|
|
|
|
{ |
423
|
|
|
|
|
|
|
tag => $tag, |
424
|
|
|
|
|
|
|
text => join( "", @text ), |
425
|
|
|
|
|
|
|
}; |
426
|
|
|
|
|
|
|
} |
427
|
|
|
|
|
|
|
|
428
|
7
|
|
|
|
|
16
|
$push->(); |
429
|
|
|
|
|
|
|
|
430
|
7
|
50
|
|
|
|
15
|
if ( $DEBUG_STRUCT_OVER ) { |
431
|
0
|
|
|
|
|
0
|
say "DEBUG_STRUCT_OVER-IN: " . _dumper $text_list; |
432
|
0
|
|
|
|
|
0
|
say "DEBUG_STRUCT_OVER-OUT: " . _dumper \@struct; |
433
|
|
|
|
|
|
|
} |
434
|
|
|
|
|
|
|
|
435
|
7
|
|
|
|
|
20
|
\@struct; |
436
|
|
|
|
|
|
|
} |
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
=head2 find_title |
439
|
|
|
|
|
|
|
|
440
|
|
|
|
|
|
|
Extracts the title information. |
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
=cut |
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
sub find_title { |
445
|
9
|
|
|
9
|
1
|
91552
|
my ( $s ) = @_; |
446
|
9
|
|
|
|
|
23
|
scalar $s->find( 'head1=NAME[0]/Para[0]' ); |
447
|
|
|
|
|
|
|
} |
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
=head2 find_method |
450
|
|
|
|
|
|
|
|
451
|
|
|
|
|
|
|
Extracts the complete method information. |
452
|
|
|
|
|
|
|
|
453
|
|
|
|
|
|
|
=cut |
454
|
|
|
|
|
|
|
|
455
|
|
|
|
|
|
|
sub find_method { |
456
|
10
|
|
|
10
|
1
|
4599
|
my ( $s, $method ) = @_; |
457
|
10
|
50
|
|
|
|
36
|
my $m = $s->_clean_method_name( $method ) or return ""; |
458
|
|
|
|
|
|
|
|
459
|
10
|
|
|
|
|
54
|
$s->find( sprintf '~head=~^%s\b.*$[0]**', $m ); |
460
|
|
|
|
|
|
|
} |
461
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
=head2 find_method_summary |
463
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
Extracts the method summary. |
465
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
=cut |
467
|
|
|
|
|
|
|
|
468
|
|
|
|
|
|
|
sub find_method_summary { |
469
|
10
|
|
|
10
|
1
|
2259
|
my ( $s, $method ) = @_; |
470
|
10
|
50
|
|
|
|
16
|
my $m = $s->_clean_method_name( $method ) or return ""; |
471
|
|
|
|
|
|
|
|
472
|
10
|
|
|
|
|
39
|
scalar $s->find( sprintf '~head=~^%s\b.*$[0]/~(Data|Para)[0]', $m ); |
473
|
|
|
|
|
|
|
} |
474
|
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
=head2 _clean_method_name |
476
|
|
|
|
|
|
|
|
477
|
|
|
|
|
|
|
Returns a method name without any possible parenthesis. |
478
|
|
|
|
|
|
|
|
479
|
|
|
|
|
|
|
=cut |
480
|
|
|
|
|
|
|
|
481
|
|
|
|
|
|
|
sub _clean_method_name { |
482
|
20
|
|
|
20
|
|
30
|
my ( $s, $name ) = @_; |
483
|
20
|
|
|
|
|
50
|
my $safe_start = qr/ ^ [\w_] /x; |
484
|
20
|
|
|
|
|
35
|
my $safe_end = qr/ [\w_()] $ /x; |
485
|
20
|
50
|
|
|
|
93
|
return if $name !~ $safe_start; |
486
|
20
|
50
|
|
|
|
58
|
return if $name !~ $safe_end; |
487
|
|
|
|
|
|
|
|
488
|
20
|
|
|
|
|
54
|
my $clean = quotemeta( $name =~ s/[^a-zA-Z0-9_]+//gr ); |
489
|
20
|
50
|
|
|
|
54
|
return if $clean !~ $safe_start; |
490
|
|
|
|
|
|
|
|
491
|
20
|
|
|
|
|
55
|
$clean; |
492
|
|
|
|
|
|
|
} |
493
|
|
|
|
|
|
|
|
494
|
|
|
|
|
|
|
=head2 find_events |
495
|
|
|
|
|
|
|
|
496
|
|
|
|
|
|
|
Extracts a list of events with a description. |
497
|
|
|
|
|
|
|
|
498
|
|
|
|
|
|
|
Returns a list of key value pairs. |
499
|
|
|
|
|
|
|
|
500
|
|
|
|
|
|
|
=cut |
501
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
sub find_events { |
503
|
6
|
|
|
6
|
1
|
1482
|
my ( $s ) = @_; |
504
|
6
|
|
|
|
|
12
|
$s->find( '~head=EVENTS[0]/~head*/(Para)[0]' ); |
505
|
|
|
|
|
|
|
} |
506
|
|
|
|
|
|
|
|
507
|
|
|
|
|
|
|
=head2 find |
508
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
Generic extraction command. |
510
|
|
|
|
|
|
|
|
511
|
|
|
|
|
|
|
Note: This function is Scalar/List context sensitive! |
512
|
|
|
|
|
|
|
|
513
|
|
|
|
|
|
|
$query->find($condition) |
514
|
|
|
|
|
|
|
|
515
|
|
|
|
|
|
|
Where condtion is a string as described in L"_query_string_to_struct"> |
516
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
$query->find(@conditions) |
518
|
|
|
|
|
|
|
|
519
|
|
|
|
|
|
|
Where each condition can contain: |
520
|
|
|
|
|
|
|
|
521
|
|
|
|
|
|
|
{ |
522
|
|
|
|
|
|
|
tag => "TAG_NAME", # Find all matching tags. |
523
|
|
|
|
|
|
|
text => "TEXT_NAME", # Find all matching texts. |
524
|
|
|
|
|
|
|
keep => 1, # Capture the text. |
525
|
|
|
|
|
|
|
keep_all => 1, # Capture entire section. |
526
|
|
|
|
|
|
|
nth => 0, # Use only the nth match. |
527
|
|
|
|
|
|
|
nth_in_group => 0, # Use only the nth matching group. |
528
|
|
|
|
|
|
|
} |
529
|
|
|
|
|
|
|
|
530
|
|
|
|
|
|
|
Return contents of entire head section: |
531
|
|
|
|
|
|
|
|
532
|
|
|
|
|
|
|
find ( |
533
|
|
|
|
|
|
|
{tag => "head", text => "a", keep_all => 1}, |
534
|
|
|
|
|
|
|
) |
535
|
|
|
|
|
|
|
|
536
|
|
|
|
|
|
|
Results: |
537
|
|
|
|
|
|
|
|
538
|
|
|
|
|
|
|
[ |
539
|
|
|
|
|
|
|
" my \$app = a('/hel...", |
540
|
|
|
|
|
|
|
{text => "Create a route with ...", wrap => 1}, |
541
|
|
|
|
|
|
|
" \$ perl -Mojo -E ...", |
542
|
|
|
|
|
|
|
] |
543
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
=cut |
545
|
|
|
|
|
|
|
|
546
|
|
|
|
|
|
|
sub find { |
547
|
123
|
|
|
123
|
1
|
47784
|
my ( $s, @raw_conditions ) = @_; |
548
|
|
|
|
|
|
|
|
549
|
123
|
|
|
|
|
133
|
my $find_conditions; |
550
|
|
|
|
|
|
|
|
551
|
|
|
|
|
|
|
# If the find condition is a single string. |
552
|
123
|
50
|
33
|
|
|
468
|
if ( @raw_conditions == 1 and not ref $raw_conditions[0] ) { |
553
|
123
|
|
|
|
|
221
|
$find_conditions = $s->_query_string_to_struct( $raw_conditions[0] ); |
554
|
|
|
|
|
|
|
} |
555
|
|
|
|
|
|
|
else { |
556
|
0
|
|
|
|
|
0
|
$find_conditions = \@raw_conditions; |
557
|
|
|
|
|
|
|
} |
558
|
123
|
50
|
|
|
|
239
|
say "DEBUG_FIND_CONDITIONS: " . _dumper $find_conditions |
559
|
|
|
|
|
|
|
if $DEBUG_FIND_CONDITIONS; |
560
|
|
|
|
|
|
|
|
561
|
123
|
|
|
|
|
215
|
_check_conditions( $find_conditions ); |
562
|
119
|
|
|
|
|
187
|
_set_condition_defaults( $find_conditions ); |
563
|
119
|
50
|
|
|
|
180
|
say "DEBUG_FIND_AFTER_DEFAULTS " . _dumper $find_conditions |
564
|
|
|
|
|
|
|
if $DEBUG_FIND_AFTER_DEFAULTS; |
565
|
|
|
|
|
|
|
|
566
|
119
|
|
|
|
|
221
|
my @tree = $s->tree->@*; |
567
|
119
|
|
|
|
|
137
|
my $kept_all; |
568
|
119
|
50
|
|
|
|
188
|
if ( $DEBUG_PRE_FIND_DUMP ) { |
569
|
0
|
|
|
|
|
0
|
say "DEBUG_PRE_FIND_DUMP: " . _dumper \@tree; |
570
|
0
|
|
|
|
|
0
|
exit; |
571
|
|
|
|
|
|
|
} |
572
|
|
|
|
|
|
|
|
573
|
119
|
|
|
|
|
168
|
for ( @$find_conditions ) { |
574
|
206
|
|
|
|
|
334
|
@tree = _find( $_, @tree ); |
575
|
206
|
100
|
|
|
|
370
|
if ( $_->{keep_all} ) { |
576
|
18
|
|
|
|
|
22
|
$kept_all++; |
577
|
18
|
|
|
|
|
21
|
last; |
578
|
|
|
|
|
|
|
} |
579
|
|
|
|
|
|
|
} |
580
|
119
|
50
|
|
|
|
163
|
if ( $DEBUG_FIND_DUMP ) { |
581
|
0
|
|
|
|
|
0
|
say "DEBUG_FIND_DUMP: " . _dumper \@tree; |
582
|
0
|
0
|
|
|
|
0
|
exit if $DEBUG_FIND_DUMP > 1; |
583
|
|
|
|
|
|
|
} |
584
|
|
|
|
|
|
|
|
585
|
119
|
100
|
|
|
|
171
|
if ( not $kept_all ) { |
586
|
101
|
|
|
|
|
153
|
@tree = _invert( @tree ); |
587
|
|
|
|
|
|
|
} |
588
|
|
|
|
|
|
|
|
589
|
119
|
|
|
|
|
185
|
_render( $kept_all, @tree ); |
590
|
|
|
|
|
|
|
} |
591
|
|
|
|
|
|
|
|
592
|
|
|
|
|
|
|
=head2 _query_string_to_struct |
593
|
|
|
|
|
|
|
|
594
|
|
|
|
|
|
|
Convert a pod query string into a structure based on these rules: |
595
|
|
|
|
|
|
|
|
596
|
|
|
|
|
|
|
1. Split string by '/'. |
597
|
|
|
|
|
|
|
Each piece is a separate list of conditions. |
598
|
|
|
|
|
|
|
|
599
|
|
|
|
|
|
|
2. Remove an optional '*' or '**' from the last condition. |
600
|
|
|
|
|
|
|
Keep is set if we have '*'. |
601
|
|
|
|
|
|
|
Keep all is set if we have '**'. |
602
|
|
|
|
|
|
|
|
603
|
|
|
|
|
|
|
3. Remove an optional [N] from the last condition. |
604
|
|
|
|
|
|
|
(Where N is a decimal). |
605
|
|
|
|
|
|
|
Set nth base on 'N'. |
606
|
|
|
|
|
|
|
Set nth_in_group if previous word is surrounded by (): |
607
|
|
|
|
|
|
|
(WORD)[N] |
608
|
|
|
|
|
|
|
|
609
|
|
|
|
|
|
|
4. Double and single quotes are removed from the ends (if matching). |
610
|
|
|
|
|
|
|
|
611
|
|
|
|
|
|
|
5. Split each list of conditions by "=". |
612
|
|
|
|
|
|
|
First word is the tag. |
613
|
|
|
|
|
|
|
Second word is the text (if any). |
614
|
|
|
|
|
|
|
If either starts with a tilde, then the word: |
615
|
|
|
|
|
|
|
- is treated like a pattern. |
616
|
|
|
|
|
|
|
- is case Insensitive. |
617
|
|
|
|
|
|
|
|
618
|
|
|
|
|
|
|
Precedence: |
619
|
|
|
|
|
|
|
If quoted and ~, left wins: |
620
|
|
|
|
|
|
|
~"head1" => qr/"head"/, |
621
|
|
|
|
|
|
|
"~head1" => qr/head/, |
622
|
|
|
|
|
|
|
|
623
|
|
|
|
|
|
|
=cut |
624
|
|
|
|
|
|
|
|
625
|
|
|
|
|
|
|
sub _query_string_to_struct { |
626
|
196
|
|
|
196
|
|
25568
|
my ( $s, $query_string ) = @_; |
627
|
196
|
|
|
|
|
508
|
my $is_nth = qr/ \[ (-?\d+) \] $ /x; |
628
|
196
|
|
|
|
|
749
|
my $is_nth_in_group = qr/ ^ \( (.+) \) $is_nth /x; |
629
|
196
|
|
|
|
|
341
|
my $is_keep = qr/ \* $ /x; |
630
|
196
|
|
|
|
|
302
|
my $is_keep_all = qr/ \* \* $ /x; |
631
|
|
|
|
|
|
|
|
632
|
|
|
|
|
|
|
my @query_struct = |
633
|
|
|
|
|
|
|
map { |
634
|
316
|
|
|
|
|
545
|
my @condition = parse_line( '=', "1", $_ ); |
635
|
316
|
|
|
|
|
17159
|
my $set = {}; |
636
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
# Set flags based on last condition. |
638
|
316
|
|
|
|
|
473
|
for ( $condition[-1] ) { |
639
|
316
|
100
|
|
|
|
1241
|
if ( s/$is_keep_all// ) { |
|
|
100
|
|
|
|
|
|
640
|
25
|
|
|
|
|
53
|
$set->{keep_all}++; |
641
|
|
|
|
|
|
|
} |
642
|
|
|
|
|
|
|
elsif ( s/$is_keep// ) { |
643
|
28
|
|
|
|
|
54
|
$set->{keep}++; |
644
|
|
|
|
|
|
|
} |
645
|
|
|
|
|
|
|
|
646
|
316
|
100
|
|
|
|
1471
|
if ( s/$is_nth_in_group// ) { |
|
|
100
|
|
|
|
|
|
647
|
30
|
|
|
|
|
47
|
$_ = $1; |
648
|
30
|
|
|
|
|
74
|
$set->{nth_in_group} = $2; |
649
|
|
|
|
|
|
|
} |
650
|
|
|
|
|
|
|
elsif ( s/$is_nth// ) { |
651
|
205
|
|
|
|
|
522
|
$set->{nth} = $1; |
652
|
|
|
|
|
|
|
} |
653
|
|
|
|
|
|
|
} |
654
|
|
|
|
|
|
|
|
655
|
|
|
|
|
|
|
# Remove outer quotes (if any). |
656
|
316
|
|
|
|
|
426
|
for ( @condition ) { |
657
|
435
|
|
|
|
|
448
|
for my $quote ( qw/ " ' / ) { |
658
|
866
|
100
|
66
|
|
|
1414
|
if ( $quote eq substr( $_, 0, 1 ) |
659
|
|
|
|
|
|
|
and $quote eq substr( $_, -1 ) ) |
660
|
|
|
|
|
|
|
{ |
661
|
12
|
|
|
|
|
19
|
$_ = substr( $_, 1, -1 ); # Strip first and last characters. |
662
|
12
|
|
|
|
|
17
|
last; # Skip multi quoting. |
663
|
|
|
|
|
|
|
} |
664
|
|
|
|
|
|
|
} |
665
|
|
|
|
|
|
|
} |
666
|
|
|
|
|
|
|
|
667
|
|
|
|
|
|
|
# Regex or literal. |
668
|
316
|
|
|
|
|
350
|
for ( qw/ tag text / ) { |
669
|
632
|
100
|
|
|
|
935
|
last if not @condition; |
670
|
435
|
|
|
|
|
527
|
my $cond = shift @condition; |
671
|
435
|
100
|
|
|
|
1930
|
$set->{$_} = ( $cond =~ s/^~// ) ? qr/$cond/i : $cond; |
672
|
|
|
|
|
|
|
} |
673
|
|
|
|
|
|
|
|
674
|
316
|
|
|
|
|
624
|
$set; |
675
|
|
|
|
|
|
|
} |
676
|
196
|
|
|
|
|
477
|
grep { $_ } # Skip trailing and leading slashes. |
|
325
|
|
|
|
|
18171
|
|
677
|
|
|
|
|
|
|
parse_line( '/', 1, $query_string ); |
678
|
|
|
|
|
|
|
|
679
|
196
|
|
|
|
|
852
|
\@query_struct; |
680
|
|
|
|
|
|
|
} |
681
|
|
|
|
|
|
|
|
682
|
|
|
|
|
|
|
=head2 _check_conditions |
683
|
|
|
|
|
|
|
|
684
|
|
|
|
|
|
|
Check if queries are valid. |
685
|
|
|
|
|
|
|
|
686
|
|
|
|
|
|
|
=cut |
687
|
|
|
|
|
|
|
|
688
|
|
|
|
|
|
|
sub _check_conditions { |
689
|
123
|
|
|
123
|
|
146
|
my ( $sections ) = @_; |
690
|
|
|
|
|
|
|
|
691
|
123
|
|
|
|
|
161
|
my $error_message = <<'ERROR'; |
692
|
|
|
|
|
|
|
|
693
|
|
|
|
|
|
|
Invalid input: expecting a hash reference! |
694
|
|
|
|
|
|
|
|
695
|
|
|
|
|
|
|
Syntax: |
696
|
|
|
|
|
|
|
|
697
|
|
|
|
|
|
|
$pod->find( 'QUERY' ) # As explained in _query_string_to_struct(). |
698
|
|
|
|
|
|
|
|
699
|
|
|
|
|
|
|
# OR: |
700
|
|
|
|
|
|
|
|
701
|
|
|
|
|
|
|
$pod->find( |
702
|
|
|
|
|
|
|
# section1 |
703
|
|
|
|
|
|
|
{ |
704
|
|
|
|
|
|
|
tag => "TAG", # Search to look for. |
705
|
|
|
|
|
|
|
text => "TEXT", # Text of the tag to find. |
706
|
|
|
|
|
|
|
keep => 1, # Must only be in last section. |
707
|
|
|
|
|
|
|
keep_all => 1, # Keep this tag and sub tags. |
708
|
|
|
|
|
|
|
nth => 0, # Stop searching after find so many matches. |
709
|
|
|
|
|
|
|
nth_in_group => 0, # Nth only in the current group. |
710
|
|
|
|
|
|
|
}, |
711
|
|
|
|
|
|
|
# ... |
712
|
|
|
|
|
|
|
# conditionN |
713
|
|
|
|
|
|
|
); |
714
|
|
|
|
|
|
|
ERROR |
715
|
|
|
|
|
|
|
|
716
|
|
|
|
|
|
|
die "$error_message" |
717
|
|
|
|
|
|
|
if not $sections |
718
|
|
|
|
|
|
|
or not @$sections |
719
|
123
|
100
|
66
|
|
|
442
|
or grep { ref() ne ref {} } @$sections; |
|
206
|
|
66
|
|
|
549
|
|
720
|
|
|
|
|
|
|
|
721
|
|
|
|
|
|
|
# keep_all should only be in the last section |
722
|
119
|
|
|
|
|
173
|
my $last = $#$sections; |
723
|
119
|
|
|
|
|
323
|
while ( my ( $n, $section ) = each @$sections ) { |
724
|
|
|
|
|
|
|
die "Error: keep_all is not in last query!\n" |
725
|
206
|
50
|
66
|
|
|
529
|
if $section->{keep_all} and $n < $last; |
726
|
|
|
|
|
|
|
} |
727
|
|
|
|
|
|
|
|
728
|
|
|
|
|
|
|
# Cannot use both nth and nth_in_group (makes no sense, plus may cause errors) |
729
|
119
|
|
|
|
|
252
|
while ( my ( $n, $section ) = each @$sections ) { |
730
|
|
|
|
|
|
|
die "Error: nth and nth_in_group are exclusive!\n" |
731
|
|
|
|
|
|
|
if defined $section->{nth} |
732
|
206
|
50
|
66
|
|
|
616
|
and defined $section->{nth_in_group}; |
733
|
|
|
|
|
|
|
} |
734
|
|
|
|
|
|
|
} |
735
|
|
|
|
|
|
|
|
736
|
|
|
|
|
|
|
=head2 _set_condition_defaults |
737
|
|
|
|
|
|
|
|
738
|
|
|
|
|
|
|
Assigns default query options. |
739
|
|
|
|
|
|
|
|
740
|
|
|
|
|
|
|
=cut |
741
|
|
|
|
|
|
|
|
742
|
|
|
|
|
|
|
sub _set_condition_defaults { |
743
|
119
|
|
|
119
|
|
134
|
my ( $conditions ) = @_; |
744
|
119
|
|
|
|
|
164
|
for my $condition ( @$conditions ) { |
745
|
|
|
|
|
|
|
|
746
|
|
|
|
|
|
|
# Text Options |
747
|
206
|
|
|
|
|
232
|
for ( qw/ tag text / ) { |
748
|
412
|
100
|
|
|
|
556
|
if ( defined $condition->{$_} ) { |
749
|
283
|
100
|
|
|
|
771
|
if ( ref $condition->{$_} ne ref qr// ) { |
750
|
155
|
|
|
|
|
1008
|
$condition->{$_} = qr/^$condition->{$_}$/; |
751
|
|
|
|
|
|
|
} |
752
|
|
|
|
|
|
|
} |
753
|
|
|
|
|
|
|
else { |
754
|
129
|
|
|
|
|
250
|
$condition->{$_} = qr//; |
755
|
|
|
|
|
|
|
} |
756
|
|
|
|
|
|
|
} |
757
|
|
|
|
|
|
|
|
758
|
|
|
|
|
|
|
# Bit Options |
759
|
206
|
|
|
|
|
258
|
for ( qw/ keep keep_all / ) { |
760
|
412
|
100
|
|
|
|
491
|
if ( defined $condition->{$_} ) { |
761
|
36
|
|
|
|
|
62
|
$condition->{$_} = !!$condition->{$_}; |
762
|
|
|
|
|
|
|
} |
763
|
|
|
|
|
|
|
else { |
764
|
376
|
|
|
|
|
433
|
$condition->{$_} = 0; |
765
|
|
|
|
|
|
|
} |
766
|
|
|
|
|
|
|
} |
767
|
|
|
|
|
|
|
|
768
|
|
|
|
|
|
|
# Range Options |
769
|
206
|
|
|
|
|
296
|
my $is_digit = qr/ ^ -?\d+ $ /x; |
770
|
206
|
|
|
|
|
233
|
for ( qw/ nth nth_in_group / ) { |
771
|
412
|
|
|
|
|
434
|
my $v = $condition->{$_}; |
772
|
412
|
100
|
66
|
|
|
1232
|
if ( defined $v and $v =~ /$is_digit/ ) { |
773
|
156
|
|
100
|
|
|
453
|
$v ||= "0 but true"; |
774
|
156
|
100
|
|
|
|
281
|
my $end = ( $v >= 0 ) ? "pos" : "neg"; # Set negative or |
775
|
156
|
|
|
|
|
230
|
my $name = "_${_}_$end"; # positive form. |
776
|
156
|
|
|
|
|
278
|
$condition->{$name} = $v; |
777
|
|
|
|
|
|
|
} |
778
|
|
|
|
|
|
|
} |
779
|
|
|
|
|
|
|
|
780
|
|
|
|
|
|
|
} |
781
|
|
|
|
|
|
|
|
782
|
|
|
|
|
|
|
# Last condition should be keep or keep_all. |
783
|
|
|
|
|
|
|
# (otherwise, why even query for it?) |
784
|
119
|
|
|
|
|
168
|
for ( $conditions->[-1] ) { |
785
|
119
|
100
|
100
|
|
|
316
|
if ( not $_->{keep} || $_->{keep_all} ) { |
786
|
93
|
|
|
|
|
135
|
$_->{keep} = 1; |
787
|
|
|
|
|
|
|
} |
788
|
|
|
|
|
|
|
} |
789
|
|
|
|
|
|
|
} |
790
|
|
|
|
|
|
|
|
791
|
|
|
|
|
|
|
=head2 _find |
792
|
|
|
|
|
|
|
|
793
|
|
|
|
|
|
|
Lower level find command. |
794
|
|
|
|
|
|
|
|
795
|
|
|
|
|
|
|
=cut |
796
|
|
|
|
|
|
|
|
797
|
|
|
|
|
|
|
sub _find { |
798
|
206
|
|
|
206
|
|
299
|
my ( $need, @groups ) = @_; |
799
|
206
|
50
|
|
|
|
275
|
if ( $DEBUG_FIND ) { |
800
|
0
|
|
|
|
|
0
|
say "\n_FIND()"; |
801
|
0
|
|
|
|
|
0
|
say "need: ", _dumper $need; |
802
|
0
|
|
|
|
|
0
|
say "groups: ", _dumper \@groups; |
803
|
|
|
|
|
|
|
} |
804
|
|
|
|
|
|
|
|
805
|
206
|
|
|
|
|
232
|
my $nth_p = $need->{_nth_pos}; # Simplify code by already |
806
|
206
|
|
|
|
|
244
|
my $nth_n = $need->{_nth_neg}; # knowing if neg or pos. |
807
|
206
|
|
|
|
|
209
|
my $nth_in_group_p = $need->{_nth_grou_pos}; # Set in _set_section_defaults. |
808
|
206
|
|
|
|
|
194
|
my $nth_in_group_n = $need->{_nth_grou_neg}; |
809
|
206
|
|
|
|
|
193
|
my @found; |
810
|
|
|
|
|
|
|
|
811
|
|
|
|
|
|
|
GROUP: |
812
|
206
|
|
|
|
|
235
|
for my $group ( @groups ) { |
813
|
562
|
|
|
|
|
601
|
my @tries = ( $group ); # Assume single group to process. |
814
|
562
|
|
100
|
|
|
472
|
my @prev = @{ $group->{prev} // [] }; |
|
562
|
|
|
|
|
1169
|
|
815
|
562
|
|
|
|
|
612
|
my $locked_prev = 0; |
816
|
562
|
|
|
|
|
466
|
my @found_in_group; |
817
|
562
|
50
|
|
|
|
651
|
if ( $DEBUG_FIND ) { |
818
|
0
|
|
|
|
|
0
|
say "\nprev: ", _dumper \@prev; |
819
|
0
|
|
|
|
|
0
|
say "group: ", _dumper $group; |
820
|
|
|
|
|
|
|
} |
821
|
|
|
|
|
|
|
|
822
|
|
|
|
|
|
|
TRY: |
823
|
562
|
|
|
|
|
801
|
while ( my $try = shift @tries ) { # Can add to this queue if a sub tag. |
824
|
4834
|
50
|
|
|
|
5204
|
say "\nTrying: try=", _dumper $try if $DEBUG_FIND; |
825
|
|
|
|
|
|
|
|
826
|
4834
|
50
|
|
|
|
5494
|
if ( defined $try->{text} ) { # over-text has no text (only kids). |
827
|
4834
|
50
|
100
|
|
|
14769
|
if ( $DEBUG_FIND ) { |
|
|
100
|
100
|
|
|
|
|
828
|
0
|
|
|
|
|
0
|
say "text=$try->{text}"; |
829
|
0
|
|
|
|
|
0
|
say "next->{tag}=$need->{tag}"; |
830
|
0
|
|
|
|
|
0
|
say "next->{text}=$need->{text}"; |
831
|
|
|
|
|
|
|
} |
832
|
|
|
|
|
|
|
|
833
|
|
|
|
|
|
|
elsif ( |
834
|
|
|
|
|
|
|
$try->{tag} =~ /$need->{tag}/ |
835
|
|
|
|
|
|
|
and $try->{text} =~ /$need->{text}/ |
836
|
|
|
|
|
|
|
and not defined $try->{keep} # Already found the node. |
837
|
|
|
|
|
|
|
# Since nodes are checked again |
838
|
|
|
|
|
|
|
# on next call to _find. |
839
|
|
|
|
|
|
|
) |
840
|
|
|
|
|
|
|
{ |
841
|
546
|
50
|
|
|
|
745
|
say "Found: tag=$try->{tag}, text=$try->{text}" |
842
|
|
|
|
|
|
|
if $DEBUG_FIND; |
843
|
|
|
|
|
|
|
push @found_in_group, { |
844
|
|
|
|
|
|
|
%$try, # Copy current search options. |
845
|
|
|
|
|
|
|
prev => \@prev, # Need this for the inversion step. |
846
|
|
|
|
|
|
|
keep => $need->{keep}, # Remember for later. |
847
|
546
|
|
|
|
|
1396
|
}; |
848
|
|
|
|
|
|
|
|
849
|
|
|
|
|
|
|
# Specific match (positive) |
850
|
546
|
50
|
|
|
|
774
|
say "nth_p:$nth_p and found_in_group:" |
851
|
|
|
|
|
|
|
. _dumper \@found_in_group |
852
|
|
|
|
|
|
|
if $DEBUG_FIND; |
853
|
546
|
100
|
100
|
|
|
1136
|
if ( $nth_p and @found + @found_in_group > $nth_p ) { |
|
|
50
|
33
|
|
|
|
|
854
|
120
|
50
|
|
|
|
173
|
say "ENFORCING: nth=$nth_p" if $DEBUG_FIND; |
855
|
120
|
|
|
|
|
149
|
@found = $found_in_group[-1]; |
856
|
120
|
|
|
|
|
214
|
last GROUP; |
857
|
|
|
|
|
|
|
} |
858
|
|
|
|
|
|
|
|
859
|
|
|
|
|
|
|
# Specific group match (positive) |
860
|
|
|
|
|
|
|
elsif ( $nth_in_group_p |
861
|
|
|
|
|
|
|
and @found_in_group > $nth_in_group_p ) |
862
|
|
|
|
|
|
|
{ |
863
|
0
|
0
|
|
|
|
0
|
say "ENFORCING: nth_in_group=$nth_in_group_p" |
864
|
|
|
|
|
|
|
if $DEBUG_FIND; |
865
|
0
|
|
|
|
|
0
|
@found_in_group = $found_in_group[-1]; |
866
|
0
|
|
|
|
|
0
|
last TRY; |
867
|
|
|
|
|
|
|
} |
868
|
|
|
|
|
|
|
|
869
|
426
|
|
|
|
|
645
|
next TRY; |
870
|
|
|
|
|
|
|
} |
871
|
|
|
|
|
|
|
} |
872
|
|
|
|
|
|
|
|
873
|
4288
|
100
|
100
|
|
|
8014
|
if ( $try->{kids} and not @found_in_group ) { |
874
|
1227
|
50
|
|
|
|
1365
|
say "Got kids and nothing yet in queue" if $DEBUG_FIND; |
875
|
1227
|
|
|
|
|
1432
|
unshift @tries, $try->{kids}->@*; # Process kids tags. |
876
|
1227
|
100
|
66
|
|
|
1563
|
if ( $try->{keep} and not $locked_prev++ ) { |
877
|
8
|
|
|
|
|
20
|
unshift @prev, { %$try{qw/tag text keep/} }; |
878
|
8
|
50
|
|
|
|
15
|
say "prev changed: ", _dumper \@prev if $DEBUG_FIND; |
879
|
|
|
|
|
|
|
} |
880
|
1227
|
50
|
|
|
|
2084
|
say "locked_prev: $locked_prev" if $DEBUG_FIND; |
881
|
|
|
|
|
|
|
} |
882
|
|
|
|
|
|
|
} |
883
|
|
|
|
|
|
|
|
884
|
|
|
|
|
|
|
# Specific group match (negative) |
885
|
442
|
50
|
33
|
|
|
594
|
if ( $nth_in_group_n and @found_in_group >= abs $nth_in_group_n ) { |
886
|
0
|
0
|
|
|
|
0
|
say "ENFORCING: nth_in_group_n=$nth_in_group_n" if $DEBUG_FIND; |
887
|
0
|
|
|
|
|
0
|
@found_in_group = $found_in_group[$nth_in_group_n]; |
888
|
|
|
|
|
|
|
} |
889
|
|
|
|
|
|
|
|
890
|
442
|
100
|
|
|
|
746
|
push @found, splice @found_in_group if @found_in_group; |
891
|
|
|
|
|
|
|
} |
892
|
|
|
|
|
|
|
|
893
|
|
|
|
|
|
|
# Specific match (negative) |
894
|
206
|
100
|
66
|
|
|
347
|
if ( $nth_n and @found >= abs $nth_n ) { |
895
|
4
|
50
|
|
|
|
9
|
say "ENFORCING: nth=$nth_n" if $DEBUG_FIND; |
896
|
4
|
|
|
|
|
18
|
@found = $found[$nth_n]; |
897
|
|
|
|
|
|
|
} |
898
|
|
|
|
|
|
|
|
899
|
206
|
50
|
|
|
|
273
|
say "found: ", _dumper \@found if $DEBUG_FIND; |
900
|
|
|
|
|
|
|
|
901
|
206
|
|
|
|
|
419
|
@found; |
902
|
|
|
|
|
|
|
} |
903
|
|
|
|
|
|
|
|
904
|
|
|
|
|
|
|
=head2 _invert |
905
|
|
|
|
|
|
|
|
906
|
|
|
|
|
|
|
Previous elements are inside of the child |
907
|
|
|
|
|
|
|
(due to the way the tree is created). |
908
|
|
|
|
|
|
|
|
909
|
|
|
|
|
|
|
This method walks through each child and puts |
910
|
|
|
|
|
|
|
the parent in its place. |
911
|
|
|
|
|
|
|
|
912
|
|
|
|
|
|
|
=cut |
913
|
|
|
|
|
|
|
|
914
|
|
|
|
|
|
|
sub _invert { |
915
|
101
|
|
|
101
|
|
124
|
my ( @groups ) = @_; |
916
|
101
|
50
|
|
|
|
148
|
if ( $DEBUG_INVERT ) { |
917
|
0
|
|
|
|
|
0
|
say "\n_INVERT()"; |
918
|
0
|
|
|
|
|
0
|
say "groups: ", _dumper \@groups; |
919
|
|
|
|
|
|
|
} |
920
|
|
|
|
|
|
|
|
921
|
101
|
|
|
|
|
112
|
my @tree; |
922
|
|
|
|
|
|
|
my %navi; |
923
|
|
|
|
|
|
|
|
924
|
101
|
|
|
|
|
120
|
for my $group ( @groups ) { |
925
|
379
|
|
|
|
|
678
|
push @tree, { %$group{qw/ tag text keep kids /} }; |
926
|
379
|
50
|
|
|
|
740
|
if ( $DEBUG_INVERT ) { |
927
|
0
|
|
|
|
|
0
|
say "\nInverting: group=", _dumper $group; |
928
|
0
|
|
|
|
|
0
|
say "tree: ", _dumper \@tree; |
929
|
|
|
|
|
|
|
} |
930
|
|
|
|
|
|
|
|
931
|
379
|
|
50
|
|
|
483
|
my $prevs = $group->{prev} // []; |
932
|
379
|
|
|
|
|
408
|
for my $prev ( @$prevs ) { |
933
|
8
|
|
|
|
|
10
|
my $prev_node = $navi{$prev}; |
934
|
8
|
50
|
|
|
|
13
|
if ( $DEBUG_INVERT ) { |
935
|
0
|
|
|
|
|
0
|
say "prev: ", _dumper $prev; |
936
|
0
|
|
|
|
|
0
|
say "prev_node: ", _dumper $prev_node; |
937
|
|
|
|
|
|
|
} |
938
|
8
|
50
|
|
|
|
10
|
if ( $prev_node ) { |
939
|
0
|
|
|
|
|
0
|
push @$prev_node, pop @tree; |
940
|
0
|
0
|
|
|
|
0
|
if ( $DEBUG_INVERT ) { |
941
|
0
|
|
|
|
|
0
|
say "FOUND: prev_node=", _dumper $prev_node; |
942
|
|
|
|
|
|
|
} |
943
|
0
|
|
|
|
|
0
|
last; |
944
|
|
|
|
|
|
|
} |
945
|
|
|
|
|
|
|
else { |
946
|
8
|
|
|
|
|
16
|
$prev_node = $navi{$prev} = [ $tree[-1] ]; |
947
|
8
|
|
|
|
|
23
|
$tree[-1] = { %$prev, kids => $prev_node }; |
948
|
8
|
50
|
|
|
|
17
|
if ( $DEBUG_INVERT ) { |
949
|
0
|
|
|
|
|
0
|
say "NEW: prev_node=", _dumper $prev_node; |
950
|
|
|
|
|
|
|
} |
951
|
|
|
|
|
|
|
} |
952
|
|
|
|
|
|
|
} |
953
|
|
|
|
|
|
|
|
954
|
379
|
50
|
|
|
|
495
|
say "tree end: ", _dumper \@tree if $DEBUG_INVERT; |
955
|
|
|
|
|
|
|
} |
956
|
|
|
|
|
|
|
|
957
|
101
|
|
|
|
|
277
|
@tree; |
958
|
|
|
|
|
|
|
} |
959
|
|
|
|
|
|
|
|
960
|
|
|
|
|
|
|
=head2 _render |
961
|
|
|
|
|
|
|
|
962
|
|
|
|
|
|
|
Transforms a tree of found nodes in a simple list |
963
|
|
|
|
|
|
|
or a string depending on context. |
964
|
|
|
|
|
|
|
|
965
|
|
|
|
|
|
|
Pod::Text formatter is used for C tags when C is set. |
966
|
|
|
|
|
|
|
|
967
|
|
|
|
|
|
|
=cut |
968
|
|
|
|
|
|
|
|
969
|
|
|
|
|
|
|
sub _render { |
970
|
119
|
|
|
119
|
|
158
|
my ( $kept_all, @tree ) = @_; |
971
|
119
|
50
|
|
|
|
162
|
if ( $DEBUG_RENDER ) { |
972
|
0
|
|
|
|
|
0
|
say "\n_RENDER()"; |
973
|
0
|
|
|
|
|
0
|
say "tree: ", _dumper \@tree; |
974
|
0
|
|
|
|
|
0
|
say "kept_all: ", _dumper $kept_all; |
975
|
|
|
|
|
|
|
} |
976
|
|
|
|
|
|
|
|
977
|
119
|
|
|
|
|
280
|
my $formatter = Pod::Text->new( width => get_term_width(), ); |
978
|
119
|
|
|
|
|
10496
|
$formatter->{MARGIN} = 2; |
979
|
|
|
|
|
|
|
|
980
|
119
|
|
|
|
|
137
|
my @lines; |
981
|
|
|
|
|
|
|
my $n; |
982
|
|
|
|
|
|
|
|
983
|
119
|
|
|
|
|
155
|
for my $group ( @tree ) { |
984
|
419
|
|
|
|
|
449
|
my @tries = ( $group ); |
985
|
419
|
50
|
|
|
|
498
|
say "\ngroup: ", _dumper $group if $DEBUG_RENDER; |
986
|
|
|
|
|
|
|
|
987
|
419
|
|
|
|
|
563
|
while ( my $try = shift @tries ) { |
988
|
2839
|
50
|
|
|
|
3042
|
say "\nTrying: try=", _dumper $try if $DEBUG_RENDER; |
989
|
|
|
|
|
|
|
|
990
|
2839
|
|
|
|
|
2595
|
my $_text = $try->{text}; |
991
|
2839
|
50
|
|
|
|
2970
|
say "_text=$_text" if $DEBUG_RENDER; |
992
|
|
|
|
|
|
|
|
993
|
2839
|
100
|
|
|
|
3414
|
if ( $kept_all ) { |
|
|
100
|
|
|
|
|
|
994
|
548
|
100
|
|
|
|
610
|
$_text .= ":" if ++$n == 1; # Only for the first line. |
995
|
548
|
100
|
|
|
|
643
|
if ( $try->{tag} eq "Para" ) { |
996
|
164
|
50
|
|
|
|
174
|
say "USING FORMATTER" if $DEBUG_RENDER; |
997
|
164
|
|
|
|
|
246
|
$_text = $formatter->reformat( $_text ); |
998
|
|
|
|
|
|
|
} |
999
|
548
|
|
|
|
|
5600
|
push @lines, $_text, ""; |
1000
|
|
|
|
|
|
|
} |
1001
|
|
|
|
|
|
|
elsif ( $try->{keep} ) { |
1002
|
387
|
50
|
|
|
|
437
|
say "keeping" if $DEBUG_RENDER; |
1003
|
387
|
|
|
|
|
390
|
push @lines, $_text; |
1004
|
|
|
|
|
|
|
} |
1005
|
|
|
|
|
|
|
|
1006
|
2839
|
100
|
|
|
|
4282
|
if ( $try->{kids} ) { |
1007
|
738
|
|
|
|
|
854
|
unshift @tries, $try->{kids}->@*; |
1008
|
738
|
50
|
|
|
|
1232
|
if ( $DEBUG_RENDER ) { |
1009
|
0
|
|
|
|
|
0
|
say "Got kids"; |
1010
|
0
|
|
|
|
|
0
|
say "tries: ", _dumper \@tries; |
1011
|
|
|
|
|
|
|
} |
1012
|
|
|
|
|
|
|
} |
1013
|
|
|
|
|
|
|
} |
1014
|
|
|
|
|
|
|
} |
1015
|
|
|
|
|
|
|
|
1016
|
119
|
50
|
|
|
|
163
|
say "lines: ", _dumper \@lines if $DEBUG_RENDER; |
1017
|
|
|
|
|
|
|
|
1018
|
119
|
100
|
|
|
|
674
|
return @lines if wantarray; |
1019
|
69
|
|
|
|
|
900
|
join "\n", @lines; |
1020
|
|
|
|
|
|
|
} |
1021
|
|
|
|
|
|
|
|
1022
|
|
|
|
|
|
|
=head2 get_term_width |
1023
|
|
|
|
|
|
|
|
1024
|
|
|
|
|
|
|
Determines, caches and returns the terminal width. |
1025
|
|
|
|
|
|
|
|
1026
|
|
|
|
|
|
|
=head3 Error: Unable to get Terminal Size |
1027
|
|
|
|
|
|
|
|
1028
|
|
|
|
|
|
|
If terminal width cannot be detected, 80 will be assumed. |
1029
|
|
|
|
|
|
|
|
1030
|
|
|
|
|
|
|
=cut |
1031
|
|
|
|
|
|
|
|
1032
|
|
|
|
|
|
|
sub get_term_width { |
1033
|
6
|
|
|
6
|
1
|
8
|
state $term_width; |
1034
|
|
|
|
|
|
|
|
1035
|
6
|
100
|
|
|
|
8
|
if ( not $term_width ) { |
1036
|
1
|
|
|
|
|
1
|
$term_width = eval { chars() }; |
|
1
|
|
|
|
|
4
|
|
1037
|
1
|
|
50
|
|
|
19
|
$term_width ||= 80; # Safe default. |
1038
|
1
|
|
|
|
|
2
|
$term_width--; # Padding. |
1039
|
|
|
|
|
|
|
} |
1040
|
|
|
|
|
|
|
|
1041
|
6
|
|
|
|
|
19
|
$term_width; |
1042
|
|
|
|
|
|
|
} |
1043
|
|
|
|
|
|
|
|
1044
|
|
|
|
|
|
|
=head1 SEE ALSO |
1045
|
|
|
|
|
|
|
|
1046
|
|
|
|
|
|
|
L |
1047
|
|
|
|
|
|
|
|
1048
|
|
|
|
|
|
|
L |
1049
|
|
|
|
|
|
|
|
1050
|
|
|
|
|
|
|
L |
1051
|
|
|
|
|
|
|
|
1052
|
|
|
|
|
|
|
|
1053
|
|
|
|
|
|
|
=head1 AUTHOR |
1054
|
|
|
|
|
|
|
|
1055
|
|
|
|
|
|
|
Tim Potapov, C<< >> |
1056
|
|
|
|
|
|
|
|
1057
|
|
|
|
|
|
|
=head1 BUGS |
1058
|
|
|
|
|
|
|
|
1059
|
|
|
|
|
|
|
Please report any bugs or feature requests to L. |
1060
|
|
|
|
|
|
|
|
1061
|
|
|
|
|
|
|
=head1 CAVEAT |
1062
|
|
|
|
|
|
|
|
1063
|
|
|
|
|
|
|
Nothing to report. |
1064
|
|
|
|
|
|
|
|
1065
|
|
|
|
|
|
|
=head1 SUPPORT |
1066
|
|
|
|
|
|
|
|
1067
|
|
|
|
|
|
|
You can find documentation for this module with the perldoc command. |
1068
|
|
|
|
|
|
|
|
1069
|
|
|
|
|
|
|
perldoc Pod::Query |
1070
|
|
|
|
|
|
|
|
1071
|
|
|
|
|
|
|
|
1072
|
|
|
|
|
|
|
You can also look for information at: |
1073
|
|
|
|
|
|
|
|
1074
|
|
|
|
|
|
|
L |
1075
|
|
|
|
|
|
|
L |
1076
|
|
|
|
|
|
|
|
1077
|
|
|
|
|
|
|
|
1078
|
|
|
|
|
|
|
=head1 ACKNOWLEDGEMENTS |
1079
|
|
|
|
|
|
|
|
1080
|
|
|
|
|
|
|
TBD |
1081
|
|
|
|
|
|
|
|
1082
|
|
|
|
|
|
|
=head1 LICENSE AND COPYRIGHT |
1083
|
|
|
|
|
|
|
|
1084
|
|
|
|
|
|
|
This software is Copyright (c) 2022 by Tim Potapov. |
1085
|
|
|
|
|
|
|
|
1086
|
|
|
|
|
|
|
This is free software, licensed under: |
1087
|
|
|
|
|
|
|
|
1088
|
|
|
|
|
|
|
The Artistic License 2.0 (GPL Compatible) |
1089
|
|
|
|
|
|
|
|
1090
|
|
|
|
|
|
|
|
1091
|
|
|
|
|
|
|
=cut |
1092
|
|
|
|
|
|
|
|
1093
|
|
|
|
|
|
|
1; # End of Pod::Query |