line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
|
2
|
|
|
|
|
|
|
package POD::Tested ; |
3
|
|
|
|
|
|
|
|
4
|
1
|
|
|
1
|
|
39505
|
use base qw(Pod::Parser) ; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
114
|
|
5
|
|
|
|
|
|
|
|
6
|
1
|
|
|
1
|
|
6
|
use strict; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
30
|
|
7
|
1
|
|
|
1
|
|
5
|
use warnings ; |
|
1
|
|
|
|
|
7
|
|
|
1
|
|
|
|
|
30
|
|
8
|
1
|
|
|
1
|
|
5
|
use Carp ; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
92
|
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
BEGIN |
11
|
|
|
|
|
|
|
{ |
12
|
1
|
|
|
1
|
|
984
|
use Sub::Exporter -setup => { exports => [ qw() ] } ; |
|
1
|
|
|
|
|
14287
|
|
|
1
|
|
|
|
|
19
|
|
13
|
|
|
|
|
|
|
|
14
|
1
|
|
|
1
|
|
344
|
use vars qw ($VERSION @ISA @EXPORT_OK %EXPORT_TAGS); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
72
|
|
15
|
1
|
|
|
1
|
|
19
|
$VERSION = '0.06' ; |
16
|
|
|
|
|
|
|
} |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
#------------------------------------------------------------------------------------------------------------------------------- |
19
|
|
|
|
|
|
|
|
20
|
1
|
|
|
1
|
|
1097
|
use English qw( -no_match_vars ) ; |
|
1
|
|
|
|
|
4183
|
|
|
1
|
|
|
|
|
4
|
|
21
|
|
|
|
|
|
|
|
22
|
1
|
|
|
1
|
|
1182
|
use Readonly ; |
|
1
|
|
|
|
|
2704
|
|
|
1
|
|
|
|
|
56
|
|
23
|
|
|
|
|
|
|
Readonly my $EMPTY_STRING => q{} ; |
24
|
|
|
|
|
|
|
|
25
|
1
|
|
|
1
|
|
5
|
use Carp qw(carp croak confess) ; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
41
|
|
26
|
|
|
|
|
|
|
|
27
|
1
|
|
|
1
|
|
855
|
use Lexical::Persistence ; |
|
1
|
|
|
|
|
21242
|
|
|
1
|
|
|
|
|
41
|
|
28
|
1
|
|
|
1
|
|
1028
|
use IO::String ; |
|
1
|
|
|
|
|
5627
|
|
|
1
|
|
|
|
|
2073
|
|
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
#------------------------------------------------------------------------------------------------------------------------------- |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
=head1 NAME |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
POD::Tested - Test the code in your POD and generates POD. |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
=head1 SYNOPSIS |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
my $parser = POD::Tested->new(@options); |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
$parser->parse_from_file($input_file) ; |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
#or |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
$parser->parse_from_filehandle($input_filehandle) ; |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
write_file($output, $parser->GetPOD()) ; |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
=head1 DESCRIPTION |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
This module lets you write POD documents that are testable. It also let's you generate pod sections dynamically. |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
Any verbatim section (indented section) is considered part of the POD and the code to be tested. See the I |
53
|
|
|
|
|
|
|
tag for verbatim sections that are not code. |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
=head1 DOCUMENTATION |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
I wrote this module because I wanted a mechanism to verify the code I write in my POD. Code changes, output |
58
|
|
|
|
|
|
|
changes and I would like my documentation to always be up to date. |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
The installation procedure should install a B that you can use to verify your POD. This module is |
61
|
|
|
|
|
|
|
very simple to use and has but a few commands. Since it's rather difficult to explain simple things, I'll use an |
62
|
|
|
|
|
|
|
example based approach. |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
Please give me feedback on the documentation or some examples and I'll integrate them in |
65
|
|
|
|
|
|
|
module's documentation. |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
=head2 From POD to POD |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
=head1 Config::Hierarchical cookbook |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
=head2 Simple usage |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
Some Text |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
=cut |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
Let's run the above POD through B. |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
$> perl pod_tested.pl -input simple.pod -output simple.tested.pod |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
# Generating POD in 'simple.tested.pod'. |
82
|
|
|
|
|
|
|
# No tests run! |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
$> cat simple.tested.pod |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
=head1 cookbook |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
=head2 Simple usage |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
Some Text |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
=cut |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
=head2 Testing your code |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
=head1 cookbook |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
=head2 Simple usage |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
Some Text |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
=begin hidden |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
my $cc = 'cc' ; |
105
|
|
|
|
|
|
|
my $expected_cc = 'cc' ; |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
is($cc, $expected_cc, 'expected value') ; |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
=end hidden |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
Let's run the above POD through B. |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
$> perl pod_tested.pl -input test.pod -output test.tested.pod |
114
|
|
|
|
|
|
|
# output from 'script/test.pod:9': |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
ok 1 - expected value |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
# Generating POD in 'test.tested.pod'. |
119
|
|
|
|
|
|
|
1..1 |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
The Generated POD output goes to the output file you specified. You get the test output on your terminal. The POD |
122
|
|
|
|
|
|
|
would look like: |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
=head1 cookbook |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
=head2 Simple usage |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
Some Text |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
=cut |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
Note that your test code is not part of the generated POD. |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
=head2 Section common to your POD and tests |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
Most often we want to show an example in the POD and verify it. |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
=head1 Config::Hierarchical cookbook |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
=head2 Simple usage |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
Some text |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
use Config::Hierarchical ; |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
my $config = new Config::Hierarchical(); |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
$config->Set(NAME => 'CC', VALUE => 'acc') ; |
149
|
|
|
|
|
|
|
$config->Set(NAME => 'CC', VALUE => 'gcc') ; |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
my $cc_value = $config->Get(NAME => 'CC') ; |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
print "CC = '$cc_value'\n" ; |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
=begin hidden |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
my $expected_output = 'gcc' ; |
158
|
|
|
|
|
|
|
is($cc_value, $expected_output, 'expected value') ; |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
=end hidden |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
=cut |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
Let's run the above POD through B. |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
$> perl pod_tested.pl -input common.pod -output common.tested.pod |
167
|
|
|
|
|
|
|
# output from 'script/common.pod:9': |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
CC = 'gcc' |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
# output from 'script/common.pod:24': |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
ok 1 - expected value |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
# Generating POD in 'common.tested.pod'. |
176
|
|
|
|
|
|
|
1..1 |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
The POD is: |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
=head1 Config::Hierarchical cookbook |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
=head2 Simple usage |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
Some text |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
use Config::Hierarchical ; |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
my $config = new Config::Hierarchical(); |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
$config->Set(NAME => 'CC', VALUE => 'acc') ; |
191
|
|
|
|
|
|
|
$config->Set(NAME => 'CC', VALUE => 'gcc') ; |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
my $cc_value = $config->Get(NAME => 'CC') ; |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
print "CC = '$cc_value'\n" ; |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
=cut |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
=head2 When things go wrong |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
=head1 cookbook |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
=head2 Simple usage |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
Some Text |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
=begin hidden |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
my $cc = 'cc' ; |
210
|
|
|
|
|
|
|
my $expected_cc = 'cc' ; |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
is($cc_value, $expected_output) ; |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
=end hidden |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
Let's run the above POD through B. |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
$> perl pod_tested.pl -input test.pod -output test.tested.pod |
219
|
|
|
|
|
|
|
Global symbol "$cc_value" requires explicit package name at 'script/test.pod' line 12, <$in_fh> line 15. |
220
|
|
|
|
|
|
|
Global symbol "$expected_output" requires explicit package name at 'script/test.pod' line 12, <$in_fh> line 15. |
221
|
|
|
|
|
|
|
at script/pod_tested.pl line 31 |
222
|
|
|
|
|
|
|
# Looks like your test died before it could output anything. |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
Oops! This is a rather common error, copy/pasting code and modifying it for pod. |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
The following pod: |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
=head1 HEADER |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
my $cc = ; |
231
|
|
|
|
|
|
|
my $expected_cc = 'cc' ; |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
is($cc, $expected_cc) ; |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
=cut |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
produces: |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
syntax error at 'script/error_1.pod' line 9, at EOF |
240
|
|
|
|
|
|
|
at script/pod_tested.pl line 31 |
241
|
|
|
|
|
|
|
# Looks like your test died before it could output anything. |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
while: |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
=head1 HEADER |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
sub error { 1/0 } |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
error() ; |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
=cut |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
produces: |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
Illegal division by zero at 'script/error_2.pod' line 5, <$in_fh> line 10. |
256
|
|
|
|
|
|
|
at script/pod_tested.pl line 31 |
257
|
|
|
|
|
|
|
# Looks like your test died before it could output anything. |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
=head2 keeping your context together |
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
=head1 HEADER |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
Some text |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
my $cc_value = 'CC' ; |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
print "CC = '$cc_value'\n" ; |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
More text or code examples. |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
=begin not_tested |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
# this section is not part of the test but is part of the POD |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
my $non_tested_code = 1 ; |
276
|
|
|
|
|
|
|
DoSomething() ; |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
=end not_tested |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
=begin hidden |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
my $expected_output = 'gcc' ; |
283
|
|
|
|
|
|
|
is($cc_value, $expected_output) ; |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
=end hidden |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
=cut |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
The example above defines a variable in a section and uses it in another section. |
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
the output would be: |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
# output from 'script/context.pod:7': |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
CC = 'CC' |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
# output from 'script/context.pod:20': |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
not ok 1 |
300
|
|
|
|
|
|
|
# Failed test at 'script/context.pod' line 21. |
301
|
|
|
|
|
|
|
# got: 'CC' |
302
|
|
|
|
|
|
|
# expected: 'gcc' |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
# No POD output will be generated. |
305
|
|
|
|
|
|
|
# Failed tests: 1. |
306
|
|
|
|
|
|
|
1..1 |
307
|
|
|
|
|
|
|
# Looks like you failed 1 test of 1. |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
Note that any test fails and the output file already exists, pod_tested will rename the existing file |
310
|
|
|
|
|
|
|
so there is little risk for using an invalid file. |
311
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
=head2 Resetting your context |
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
=head1 HEADER |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
=head2 Example 1 |
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
my $cc_value = 'CC' ; |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
=begin hidden |
323
|
|
|
|
|
|
|
|
324
|
|
|
|
|
|
|
is($cc_value, 'CC') ; |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
=end hidden |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
=head2 Example 2 |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
my $cc_value = 'ABC' ; |
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
=begin hidden |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
is($cc_value, 'ABC') ; |
337
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
=end hidden |
339
|
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
=cut |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
Running the above pod gives the following output: |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
# output from 'script/new_context_error.pod:7': |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
# output from 'script/new_context_error.pod:16': |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
ok 1 - expected value |
350
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
"my" variable $cc_value masks earlier declaration in same scope at 'script/new_context_error.pod' line 24, <$in_fh> line 27. |
352
|
|
|
|
|
|
|
# output from 'script/new_context_error.pod:24': |
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
# output from 'script/new_context_error.pod:32': |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
ok 2 - expected value |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
# Generating POD in 'new_context_error.tested.pod'. |
360
|
|
|
|
|
|
|
1..2 |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
Local variables are kept between test sections. What we want is two separate section. This can be achieved with |
363
|
|
|
|
|
|
|
B<=for POD::Tested reset> |
364
|
|
|
|
|
|
|
|
365
|
|
|
|
|
|
|
=head1 HEADER |
366
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
= head2 Example 1 |
368
|
|
|
|
|
|
|
|
369
|
|
|
|
|
|
|
my $cc_value = 'CC' ; |
370
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
=begin hidden |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
is($cc_value, 'CC') ; |
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
=end hidden |
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
=head2 Example 2 |
380
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
=for POD::Tested reset |
382
|
|
|
|
|
|
|
|
383
|
|
|
|
|
|
|
my $cc_value = 'ABC' ; |
384
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
|
387
|
|
|
|
|
|
|
=begin hidden |
388
|
|
|
|
|
|
|
|
389
|
|
|
|
|
|
|
is($cc_value, 'ABC') ; |
390
|
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
=end hidden |
392
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
=cut |
394
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
Gives: |
396
|
|
|
|
|
|
|
|
397
|
|
|
|
|
|
|
# output from 'script/new_context.pod:7': |
398
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
# output from 'script/new_context.pod:15': |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
ok 1 - expected value |
403
|
|
|
|
|
|
|
|
404
|
|
|
|
|
|
|
# output from 'script/new_context.pod:25': |
405
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
# output from 'script/new_context.pod:33': |
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
ok 2 - expected value |
410
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
# Generating POD in 'new_contex.tested.pod'. |
412
|
|
|
|
|
|
|
1..2 |
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
and this POD: |
415
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
=head1 HEADER |
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
= head2 Example 1 |
419
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
my $cc_value = 'CC' ; |
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
=head2 Example 2 |
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
my $cc_value = 'ABC' ; |
427
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
=cut |
431
|
|
|
|
|
|
|
|
432
|
|
|
|
|
|
|
=head2 Generating POD |
433
|
|
|
|
|
|
|
|
434
|
|
|
|
|
|
|
So far we have code in pod that we can test and the code itself is kept as part of the generated POD. Let's add the |
435
|
|
|
|
|
|
|
result of some code execution to the POD. We'll use B to achieve that. |
436
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
=head1 Config::Hierarchical cookbook |
438
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
=head2 Simple usage |
440
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
use Config::Hierarchical ; |
442
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
my $config = new Config::Hierarchical(); |
444
|
|
|
|
|
|
|
$config->Set(NAME => 'CC', VALUE => 'acc') ; |
445
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
my $cc_value = $config->Get(NAME => 'CC') ; |
447
|
|
|
|
|
|
|
print "CC = '$cc_value'\n" ; |
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
Result: |
450
|
|
|
|
|
|
|
|
451
|
|
|
|
|
|
|
=begin hidden |
452
|
|
|
|
|
|
|
|
453
|
|
|
|
|
|
|
my $expected_output = 'acc' ; |
454
|
|
|
|
|
|
|
is($cc_value, $expected_output) ; |
455
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
generate_pod(" CC = '$expected_output'\n\n") ; |
457
|
|
|
|
|
|
|
generate_pod($config->GetHistoryDump(NAME => 'CC')) ; |
458
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
=end hidden |
460
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
=cut |
462
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
running this gives this output: |
464
|
|
|
|
|
|
|
|
465
|
|
|
|
|
|
|
# output from 'script/generate_pod.pod:10': |
466
|
|
|
|
|
|
|
|
467
|
|
|
|
|
|
|
CC = 'acc' |
468
|
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
# output from 'script/generate_pod.pod:24': |
470
|
|
|
|
|
|
|
|
471
|
|
|
|
|
|
|
ok 1 - expected value |
472
|
|
|
|
|
|
|
|
473
|
|
|
|
|
|
|
# Generating POD in 'generate_pod.tested.pod.pod'. |
474
|
|
|
|
|
|
|
1..1 |
475
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
and the generated POD looks like: |
477
|
|
|
|
|
|
|
|
478
|
|
|
|
|
|
|
=head1 Config::Hierarchical cookbook |
479
|
|
|
|
|
|
|
|
480
|
|
|
|
|
|
|
=head2 Simple usage |
481
|
|
|
|
|
|
|
|
482
|
|
|
|
|
|
|
use Config::Hierarchical ; |
483
|
|
|
|
|
|
|
|
484
|
|
|
|
|
|
|
my $config = new Config::Hierarchical(); |
485
|
|
|
|
|
|
|
$config->Set(NAME => 'CC', VALUE => 'acc') ; |
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
my $cc_value = $config->Get(NAME => 'CC') ; |
488
|
|
|
|
|
|
|
print "CC = '$cc_value'\n" ; |
489
|
|
|
|
|
|
|
|
490
|
|
|
|
|
|
|
Result: |
491
|
|
|
|
|
|
|
|
492
|
|
|
|
|
|
|
CC = 'acc' |
493
|
|
|
|
|
|
|
|
494
|
|
|
|
|
|
|
History for variable 'CC' from config 'Anonymous' created at ''script/generate_pod.pod':13': |
495
|
|
|
|
|
|
|
`- 0 |
496
|
|
|
|
|
|
|
|- EVENT = CREATE AND SET. value = 'acc', category = 'CURRENT' at ''script/generate_pod.pod':14', status = OK. |
497
|
|
|
|
|
|
|
`- TIME = 0 |
498
|
|
|
|
|
|
|
|
499
|
|
|
|
|
|
|
=cut |
500
|
|
|
|
|
|
|
|
501
|
|
|
|
|
|
|
you don't need to copy/paste output from your modules into your POD as you can generate it directly. |
502
|
|
|
|
|
|
|
|
503
|
|
|
|
|
|
|
=head2 Using more test modules than the default ones |
504
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
simply use the modules you need in a B<=begin hidden> section. |
506
|
|
|
|
|
|
|
|
507
|
|
|
|
|
|
|
=begin hidden |
508
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
use Test::Some::Great::Module ; |
510
|
|
|
|
|
|
|
|
511
|
|
|
|
|
|
|
=end hidden |
512
|
|
|
|
|
|
|
|
513
|
|
|
|
|
|
|
=head1 SUBROUTINES/METHODS |
514
|
|
|
|
|
|
|
|
515
|
|
|
|
|
|
|
=cut |
516
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
#------------------------------------------------------------------------------------------------------------------------------- |
518
|
|
|
|
|
|
|
|
519
|
|
|
|
|
|
|
my $global_current_active_parser ; |
520
|
|
|
|
|
|
|
|
521
|
|
|
|
|
|
|
#------------------------------------------------------------------------------------------------------------------------------- |
522
|
|
|
|
|
|
|
|
523
|
|
|
|
|
|
|
sub new |
524
|
|
|
|
|
|
|
{ |
525
|
|
|
|
|
|
|
|
526
|
|
|
|
|
|
|
=head2 new |
527
|
|
|
|
|
|
|
|
528
|
|
|
|
|
|
|
=head3 Options |
529
|
|
|
|
|
|
|
|
530
|
|
|
|
|
|
|
You must, in the new sub, pass what your POD source is with one of the following options: |
531
|
|
|
|
|
|
|
|
532
|
|
|
|
|
|
|
=over 4 |
533
|
|
|
|
|
|
|
|
534
|
|
|
|
|
|
|
=item * FILE_HANDLE |
535
|
|
|
|
|
|
|
|
536
|
|
|
|
|
|
|
|
537
|
|
|
|
|
|
|
=item * FILE |
538
|
|
|
|
|
|
|
|
539
|
|
|
|
|
|
|
|
540
|
|
|
|
|
|
|
=item * STRING |
541
|
|
|
|
|
|
|
|
542
|
|
|
|
|
|
|
|
543
|
|
|
|
|
|
|
=back |
544
|
|
|
|
|
|
|
|
545
|
|
|
|
|
|
|
|
546
|
|
|
|
|
|
|
Other options: |
547
|
|
|
|
|
|
|
|
548
|
|
|
|
|
|
|
=over 2 |
549
|
|
|
|
|
|
|
|
550
|
|
|
|
|
|
|
=item * VERBOSE |
551
|
|
|
|
|
|
|
|
552
|
|
|
|
|
|
|
Set to true to display extra information when parsing and testing POD. |
553
|
|
|
|
|
|
|
|
554
|
|
|
|
|
|
|
=item * VERBOSE_POD_GENERATION |
555
|
|
|
|
|
|
|
|
556
|
|
|
|
|
|
|
Set to true to display the POD added through B. |
557
|
|
|
|
|
|
|
|
558
|
|
|
|
|
|
|
=item * NOT_TESTED |
559
|
|
|
|
|
|
|
|
560
|
|
|
|
|
|
|
The tag that is used to declare a section that are not common to the POD and the tests. |
561
|
|
|
|
|
|
|
|
562
|
|
|
|
|
|
|
default value is: |
563
|
|
|
|
|
|
|
|
564
|
|
|
|
|
|
|
qr/\s*not_tested/xmi |
565
|
|
|
|
|
|
|
|
566
|
|
|
|
|
|
|
=item * HIDDEN_TAG |
567
|
|
|
|
|
|
|
|
568
|
|
|
|
|
|
|
The tag that is used to declare a test section. |
569
|
|
|
|
|
|
|
|
570
|
|
|
|
|
|
|
default value is: |
571
|
|
|
|
|
|
|
|
572
|
|
|
|
|
|
|
qr/\s*hidden/xmi |
573
|
|
|
|
|
|
|
|
574
|
|
|
|
|
|
|
=item * RESET_TAG |
575
|
|
|
|
|
|
|
|
576
|
|
|
|
|
|
|
The tag that is used to reset the lexical context. Type is a B. |
577
|
|
|
|
|
|
|
|
578
|
|
|
|
|
|
|
default value is: |
579
|
|
|
|
|
|
|
|
580
|
|
|
|
|
|
|
qr/\s*POD::Tested\s+reset/xmi |
581
|
|
|
|
|
|
|
|
582
|
|
|
|
|
|
|
=item * DEFAULT_TEST_MODULES |
583
|
|
|
|
|
|
|
|
584
|
|
|
|
|
|
|
the test modules loaded when B starts. |
585
|
|
|
|
|
|
|
|
586
|
|
|
|
|
|
|
default value is: |
587
|
|
|
|
|
|
|
|
588
|
|
|
|
|
|
|
use Test::More ; |
589
|
|
|
|
|
|
|
use Test::Block qw($Plan); |
590
|
|
|
|
|
|
|
use Test::Exception ; |
591
|
|
|
|
|
|
|
use Test::Warn ; |
592
|
|
|
|
|
|
|
|
593
|
|
|
|
|
|
|
plan qw(no_plan) unless(defined Test::More->builder->has_plan()); |
594
|
|
|
|
|
|
|
|
595
|
|
|
|
|
|
|
if you use Test::More, which you should, the last line is necessary only when B is installed or |
596
|
|
|
|
|
|
|
tested. |
597
|
|
|
|
|
|
|
|
598
|
|
|
|
|
|
|
=back |
599
|
|
|
|
|
|
|
|
600
|
|
|
|
|
|
|
=cut |
601
|
|
|
|
|
|
|
|
602
|
2
|
|
|
2
|
1
|
1361
|
my ($class, @setup_data) = @_ ; |
603
|
|
|
|
|
|
|
|
604
|
2
|
100
|
|
|
|
31
|
confess 'Invalid constructor call!' if @setup_data % 2 ; |
605
|
|
|
|
|
|
|
|
606
|
1
|
|
|
|
|
12
|
my $object = |
607
|
|
|
|
|
|
|
{ |
608
|
|
|
|
|
|
|
BLOCK_START => 0, |
609
|
|
|
|
|
|
|
VERBOSE => 0, |
610
|
|
|
|
|
|
|
VERBOSE_POD_GENERATION => 0, |
611
|
|
|
|
|
|
|
STATE => $EMPTY_STRING, |
612
|
|
|
|
|
|
|
CODE => $EMPTY_STRING, |
613
|
|
|
|
|
|
|
POD => $EMPTY_STRING, |
614
|
|
|
|
|
|
|
LP => Lexical::Persistence->new(), |
615
|
|
|
|
|
|
|
|
616
|
|
|
|
|
|
|
NOT_TESTED_TAG => qr/\s*not_tested/sxmi, |
617
|
|
|
|
|
|
|
HIDDEN_TAG => qr/\s*hidden/sxmi, |
618
|
|
|
|
|
|
|
RESET_TAG => qr/\s*POD::Tested\s+reset/sxmi, |
619
|
|
|
|
|
|
|
|
620
|
|
|
|
|
|
|
DEFAULT_TEST_MODULES => <<'EOM', |
621
|
|
|
|
|
|
|
use Test::More ; |
622
|
|
|
|
|
|
|
use Test::Block qw($Plan); |
623
|
|
|
|
|
|
|
use Test::Exception ; |
624
|
|
|
|
|
|
|
use Test::Warn ; |
625
|
|
|
|
|
|
|
|
626
|
|
|
|
|
|
|
plan qw(no_plan) unless(defined Test::More->builder->has_plan()); |
627
|
|
|
|
|
|
|
|
628
|
|
|
|
|
|
|
EOM |
629
|
|
|
|
|
|
|
|
630
|
|
|
|
|
|
|
@setup_data, |
631
|
|
|
|
|
|
|
} ; |
632
|
|
|
|
|
|
|
|
633
|
1
|
|
|
|
|
68
|
$global_current_active_parser = $object ; |
634
|
|
|
|
|
|
|
|
635
|
1
|
|
|
|
|
7
|
my($code_as_text, $code) |
636
|
|
|
|
|
|
|
= GetWrappedCode |
637
|
|
|
|
|
|
|
( |
638
|
|
|
|
|
|
|
$object->{LP}, |
639
|
|
|
|
|
|
|
$object->{DEFAULT_TEST_MODULES}, |
640
|
|
|
|
|
|
|
$EMPTY_STRING, |
641
|
|
|
|
|
|
|
$EMPTY_STRING, |
642
|
|
|
|
|
|
|
'POD::Test::new', |
643
|
|
|
|
|
|
|
0 |
644
|
|
|
|
|
|
|
) ; |
645
|
|
|
|
|
|
|
|
646
|
1
|
|
|
|
|
3
|
eval { $code->() } ; |
|
1
|
|
|
|
|
4
|
|
647
|
|
|
|
|
|
|
|
648
|
1
|
|
|
|
|
71
|
my ($package, $file_name, $line) = caller() ; |
649
|
1
|
|
|
|
|
23
|
bless $object, $class ; |
650
|
|
|
|
|
|
|
|
651
|
1
|
|
|
|
|
95
|
$object->initialize() ; |
652
|
|
|
|
|
|
|
|
653
|
1
|
50
|
|
|
|
17
|
if(defined $object->{FILE_HANDLE}) |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
654
|
|
|
|
|
|
|
{ |
655
|
0
|
|
|
|
|
0
|
$object->parse_from_filehandle($object->{FILE_HANDLE}) ; |
656
|
|
|
|
|
|
|
} |
657
|
|
|
|
|
|
|
elsif(defined $object->{FILE}) |
658
|
|
|
|
|
|
|
{ |
659
|
0
|
|
|
|
|
0
|
$object->parse_from_file($object->{FILE}) ; |
660
|
|
|
|
|
|
|
} |
661
|
|
|
|
|
|
|
elsif(defined $object->{STRING}) |
662
|
|
|
|
|
|
|
{ |
663
|
1
|
|
|
|
|
9
|
$object->parse_from_filehandle( IO::String->new($object->{STRING})) ; |
664
|
|
|
|
|
|
|
} |
665
|
|
|
|
|
|
|
else |
666
|
|
|
|
|
|
|
{ |
667
|
0
|
|
|
|
|
0
|
croak "Expecting input data through argument 'STRING', 'FILE' or 'FILE_HANDLE'!\n" ; |
668
|
|
|
|
|
|
|
} |
669
|
|
|
|
|
|
|
|
670
|
1
|
|
|
|
|
207
|
$object->RunTestCode() ; |
671
|
|
|
|
|
|
|
|
672
|
1
|
|
|
|
|
17
|
return($object) ; |
673
|
|
|
|
|
|
|
} |
674
|
|
|
|
|
|
|
|
675
|
|
|
|
|
|
|
#------------------------------------------------------------------------------------------------------------------------------- |
676
|
|
|
|
|
|
|
|
677
|
|
|
|
|
|
|
sub command |
678
|
|
|
|
|
|
|
{ |
679
|
|
|
|
|
|
|
|
680
|
|
|
|
|
|
|
=head2 command |
681
|
|
|
|
|
|
|
|
682
|
|
|
|
|
|
|
Handles POD commands. See Pod::Parser for more information. |
683
|
|
|
|
|
|
|
|
684
|
|
|
|
|
|
|
=cut |
685
|
|
|
|
|
|
|
|
686
|
0
|
|
|
0
|
1
|
0
|
my ($parser, $command, $paragraph, $line_num, $pod_para) = @_ ; |
687
|
|
|
|
|
|
|
|
688
|
0
|
|
|
|
|
0
|
chomp($paragraph) ; |
689
|
0
|
|
|
|
|
0
|
chomp($paragraph) ; |
690
|
|
|
|
|
|
|
#~ print "<$command> <$paragraph><$line_num>" ; |
691
|
|
|
|
|
|
|
|
692
|
0
|
|
|
|
|
0
|
for($command) |
693
|
|
|
|
|
|
|
{ |
694
|
|
|
|
|
|
|
$_ eq 'for' and do |
695
|
0
|
0
|
|
|
|
0
|
{ |
696
|
0
|
0
|
|
|
|
0
|
if($paragraph =~ $parser->{RESET_TAG}) |
697
|
|
|
|
|
|
|
{ |
698
|
0
|
|
|
|
|
0
|
$parser->{LP}= Lexical::Persistence->new() ; |
699
|
|
|
|
|
|
|
} |
700
|
|
|
|
|
|
|
else |
701
|
|
|
|
|
|
|
{ |
702
|
0
|
|
|
|
|
0
|
$parser->{POD} .= "=$command $paragraph\n\n" ; |
703
|
|
|
|
|
|
|
} |
704
|
|
|
|
|
|
|
|
705
|
0
|
|
|
|
|
0
|
last ; |
706
|
|
|
|
|
|
|
} ; |
707
|
|
|
|
|
|
|
|
708
|
|
|
|
|
|
|
$_ eq 'begin' && do |
709
|
0
|
0
|
|
|
|
0
|
{ |
710
|
0
|
|
|
|
|
0
|
$parser->{STATE} = $paragraph ; |
711
|
0
|
|
|
|
|
0
|
$parser->{BLOCK_START} = 0 ; |
712
|
|
|
|
|
|
|
|
713
|
0
|
0
|
|
|
|
0
|
if($paragraph =~ $parser->{HIDDEN_TAG}) |
714
|
|
|
|
|
|
|
{ |
715
|
|
|
|
|
|
|
} |
716
|
|
|
|
|
|
|
else |
717
|
|
|
|
|
|
|
{ |
718
|
0
|
|
|
|
|
0
|
$parser->{POD} .= "=$command $paragraph\n\n" ; |
719
|
|
|
|
|
|
|
} |
720
|
|
|
|
|
|
|
|
721
|
0
|
|
|
|
|
0
|
last ; |
722
|
|
|
|
|
|
|
} ; |
723
|
|
|
|
|
|
|
|
724
|
|
|
|
|
|
|
$_ eq 'end' && do |
725
|
0
|
0
|
|
|
|
0
|
{ |
726
|
0
|
0
|
|
|
|
0
|
if($paragraph =~ $parser->{HIDDEN_TAG}) |
727
|
|
|
|
|
|
|
{ |
728
|
0
|
|
|
|
|
0
|
$parser->RunTestCode() ; |
729
|
|
|
|
|
|
|
} |
730
|
|
|
|
|
|
|
else |
731
|
|
|
|
|
|
|
{ |
732
|
0
|
|
|
|
|
0
|
$parser->{POD} .= "=$command $paragraph\n\n" ; |
733
|
|
|
|
|
|
|
} |
734
|
|
|
|
|
|
|
|
735
|
0
|
|
|
|
|
0
|
$parser->{BLOCK_START} = 0 ; |
736
|
0
|
|
|
|
|
0
|
$parser->{STATE} = $EMPTY_STRING; |
737
|
|
|
|
|
|
|
|
738
|
0
|
|
|
|
|
0
|
last ; |
739
|
|
|
|
|
|
|
} ; |
740
|
|
|
|
|
|
|
|
741
|
0
|
|
|
|
|
0
|
$parser->{POD} .= "=$command $paragraph\n\n" ; |
742
|
|
|
|
|
|
|
} |
743
|
|
|
|
|
|
|
|
744
|
0
|
|
|
|
|
0
|
return(1) ; |
745
|
|
|
|
|
|
|
} |
746
|
|
|
|
|
|
|
|
747
|
|
|
|
|
|
|
#------------------------------------------------------------------------------------------------------------------------------- |
748
|
|
|
|
|
|
|
|
749
|
|
|
|
|
|
|
sub RunTestCode |
750
|
|
|
|
|
|
|
{ |
751
|
|
|
|
|
|
|
|
752
|
|
|
|
|
|
|
=head2 RunTestCode |
753
|
|
|
|
|
|
|
|
754
|
|
|
|
|
|
|
Not to be used directly. |
755
|
|
|
|
|
|
|
|
756
|
|
|
|
|
|
|
=cut |
757
|
|
|
|
|
|
|
|
758
|
1
|
|
|
1
|
1
|
3
|
my ($parser) = @_ ; |
759
|
|
|
|
|
|
|
|
760
|
1
|
50
|
|
|
|
7
|
return(0) if $parser->{CODE} eq $EMPTY_STRING ; |
761
|
|
|
|
|
|
|
|
762
|
0
|
|
|
|
|
0
|
my $input= $parser->input_file() ; |
763
|
0
|
0
|
|
|
|
0
|
$input = $global_current_active_parser->{INPUT} if defined $global_current_active_parser->{INPUT} ; |
764
|
|
|
|
|
|
|
|
765
|
0
|
|
|
|
|
0
|
my $line = $parser->{BLOCK_START} ; |
766
|
0
|
0
|
|
|
|
0
|
$line= $global_current_active_parser->{LINE} if defined $global_current_active_parser->{LINE} ; |
767
|
|
|
|
|
|
|
|
768
|
0
|
|
|
|
|
0
|
EvalInContext |
769
|
|
|
|
|
|
|
( |
770
|
|
|
|
|
|
|
$parser->{LP}, |
771
|
|
|
|
|
|
|
$parser->{CODE}, |
772
|
|
|
|
|
|
|
$parser->{VERBOSE}, |
773
|
|
|
|
|
|
|
$input , |
774
|
|
|
|
|
|
|
$line, |
775
|
|
|
|
|
|
|
) ; |
776
|
|
|
|
|
|
|
|
777
|
0
|
|
|
|
|
0
|
$parser->{CODE} = $EMPTY_STRING ; |
778
|
|
|
|
|
|
|
|
779
|
0
|
|
|
|
|
0
|
return(1) ; |
780
|
|
|
|
|
|
|
} |
781
|
|
|
|
|
|
|
|
782
|
|
|
|
|
|
|
#------------------------------------------------------------------------------------------------------------------------------- |
783
|
|
|
|
|
|
|
|
784
|
|
|
|
|
|
|
sub verbatim |
785
|
|
|
|
|
|
|
{ |
786
|
|
|
|
|
|
|
|
787
|
|
|
|
|
|
|
=head2 verbatim |
788
|
|
|
|
|
|
|
|
789
|
|
|
|
|
|
|
Handles POD verbatim sections. See Pod::Parser for more information. |
790
|
|
|
|
|
|
|
|
791
|
|
|
|
|
|
|
=cut |
792
|
|
|
|
|
|
|
|
793
|
0
|
|
|
0
|
1
|
0
|
my ($parser, $paragraph, $line_num, $pod_para) = @_; |
794
|
|
|
|
|
|
|
|
795
|
0
|
0
|
|
|
|
0
|
$parser->{BLOCK_START} = $line_num if $parser->{BLOCK_START} == 0; |
796
|
|
|
|
|
|
|
|
797
|
|
|
|
|
|
|
#~ print "verbatim $parser->{STATE} >>$paragraph<<\n" ; |
798
|
|
|
|
|
|
|
|
799
|
0
|
0
|
|
|
|
0
|
if($parser->{STATE} =~ $parser->{HIDDEN_TAG}) |
|
|
0
|
|
|
|
|
|
800
|
|
|
|
|
|
|
{ |
801
|
0
|
|
|
|
|
0
|
$parser->{CODE} .= $paragraph ; |
802
|
|
|
|
|
|
|
} |
803
|
|
|
|
|
|
|
elsif($parser->{STATE} eq $EMPTY_STRING) |
804
|
|
|
|
|
|
|
{ |
805
|
0
|
|
|
|
|
0
|
$parser->{CODE} .= $paragraph ; |
806
|
0
|
|
|
|
|
0
|
$parser->{POD} .= $paragraph ; |
807
|
|
|
|
|
|
|
|
808
|
0
|
|
|
|
|
0
|
$parser->{BLOCK_START} = 0 ; |
809
|
|
|
|
|
|
|
} |
810
|
|
|
|
|
|
|
else |
811
|
|
|
|
|
|
|
{ |
812
|
0
|
|
|
|
|
0
|
$parser->{POD} .= $paragraph ; |
813
|
|
|
|
|
|
|
} |
814
|
|
|
|
|
|
|
|
815
|
0
|
|
|
|
|
0
|
return(1) ; |
816
|
|
|
|
|
|
|
} |
817
|
|
|
|
|
|
|
|
818
|
|
|
|
|
|
|
#------------------------------------------------------------------------------------------------------------------------------- |
819
|
|
|
|
|
|
|
|
820
|
|
|
|
|
|
|
sub textblock |
821
|
|
|
|
|
|
|
{ |
822
|
|
|
|
|
|
|
|
823
|
|
|
|
|
|
|
=head2 textblock |
824
|
|
|
|
|
|
|
|
825
|
|
|
|
|
|
|
Handles POD textblocks. See Pod::Parser for more information. |
826
|
|
|
|
|
|
|
|
827
|
|
|
|
|
|
|
=cut |
828
|
|
|
|
|
|
|
|
829
|
0
|
|
|
0
|
1
|
0
|
my ($parser, $paragraph, $line_num, $pod_para) = @_; |
830
|
|
|
|
|
|
|
|
831
|
|
|
|
|
|
|
#~ print "textblock $parser->{STATE} >>$paragraph<<\n" ; |
832
|
|
|
|
|
|
|
|
833
|
0
|
|
|
|
|
0
|
$parser->RunTestCode() ; |
834
|
|
|
|
|
|
|
|
835
|
0
|
0
|
|
|
|
0
|
$parser->{BLOCK_START} = $line_num if $parser->{BLOCK_START} == 0; |
836
|
|
|
|
|
|
|
|
837
|
0
|
0
|
|
|
|
0
|
if($parser->{STATE} =~ $parser->{HIDDEN_TAG}) |
838
|
|
|
|
|
|
|
{ |
839
|
0
|
|
|
|
|
0
|
$parser->{CODE} .= $paragraph ; |
840
|
|
|
|
|
|
|
} |
841
|
|
|
|
|
|
|
else |
842
|
|
|
|
|
|
|
{ |
843
|
0
|
|
|
|
|
0
|
$parser->{POD} .= $paragraph ; |
844
|
|
|
|
|
|
|
} |
845
|
|
|
|
|
|
|
|
846
|
0
|
|
|
|
|
0
|
return(1) ; |
847
|
|
|
|
|
|
|
} |
848
|
|
|
|
|
|
|
|
849
|
|
|
|
|
|
|
#------------------------------------------------------------------------------------------------------------------------------- |
850
|
|
|
|
|
|
|
|
851
|
|
|
|
|
|
|
sub generate_pod |
852
|
|
|
|
|
|
|
{ |
853
|
|
|
|
|
|
|
|
854
|
|
|
|
|
|
|
=head2 generate_pod |
855
|
|
|
|
|
|
|
|
856
|
|
|
|
|
|
|
=cut |
857
|
|
|
|
|
|
|
|
858
|
0
|
|
|
0
|
1
|
0
|
my (@pod_snippets) = @_ ; |
859
|
|
|
|
|
|
|
|
860
|
0
|
|
|
|
|
0
|
my ($pod) = join ($EMPTY_STRING, @pod_snippets) ; |
861
|
|
|
|
|
|
|
|
862
|
0
|
0
|
|
|
|
0
|
if($global_current_active_parser->{VERBOSE_POD_GENERATION}) |
863
|
|
|
|
|
|
|
{ |
864
|
0
|
|
|
|
|
0
|
my ($package, $file_name, $line) = caller() ; |
865
|
|
|
|
|
|
|
|
866
|
0
|
|
|
|
|
0
|
my $input = '(unknown)'; |
867
|
0
|
0
|
|
|
|
0
|
$input = $global_current_active_parser->{FILE} if defined $global_current_active_parser->{FILE} ; |
868
|
0
|
0
|
|
|
|
0
|
$line= $global_current_active_parser->{LINE} if defined $global_current_active_parser->{LINE} ; |
869
|
|
|
|
|
|
|
|
870
|
0
|
|
|
|
|
0
|
OutputStrings("# Generating POD at '$input' line $line:\n$pod") ; |
871
|
|
|
|
|
|
|
} |
872
|
|
|
|
|
|
|
|
873
|
0
|
|
|
|
|
0
|
$global_current_active_parser->{POD} .= $pod ; |
874
|
|
|
|
|
|
|
|
875
|
0
|
|
|
|
|
0
|
return(1) ; |
876
|
|
|
|
|
|
|
} |
877
|
|
|
|
|
|
|
|
878
|
|
|
|
|
|
|
#------------------------------------------------------------------------------------------------------------------------------- |
879
|
|
|
|
|
|
|
|
880
|
|
|
|
|
|
|
sub GetPOD |
881
|
|
|
|
|
|
|
{ |
882
|
|
|
|
|
|
|
|
883
|
|
|
|
|
|
|
=head2 GetPOD |
884
|
|
|
|
|
|
|
|
885
|
|
|
|
|
|
|
Returns the result of parsing and testing your POD. You can pass the result to L or other pod |
886
|
|
|
|
|
|
|
transformers. |
887
|
|
|
|
|
|
|
|
888
|
|
|
|
|
|
|
=cut |
889
|
|
|
|
|
|
|
|
890
|
0
|
|
|
0
|
1
|
0
|
my ($parser) = @_; |
891
|
|
|
|
|
|
|
|
892
|
0
|
|
|
|
|
0
|
Readonly my $PADDING_SIZE => 2 ; |
893
|
|
|
|
|
|
|
|
894
|
0
|
|
|
|
|
0
|
my $pod_end = substr($parser->{POD}, -2, 2) ; |
895
|
|
|
|
|
|
|
|
896
|
0
|
|
|
|
|
0
|
my $amount_of_nl = $pod_end =~ tr[\n][\n] ; |
897
|
0
|
|
|
|
|
0
|
my $padding_nl = "\n" x ($PADDING_SIZE - $amount_of_nl) ; |
898
|
|
|
|
|
|
|
|
899
|
0
|
|
|
|
|
0
|
return($parser->{POD} . $padding_nl . "=cut\n") ; |
900
|
|
|
|
|
|
|
} |
901
|
|
|
|
|
|
|
|
902
|
|
|
|
|
|
|
#------------------------------------------------------------------------------------------------------------------------------- |
903
|
|
|
|
|
|
|
|
904
|
|
|
|
|
|
|
sub EvalInContext |
905
|
|
|
|
|
|
|
{ |
906
|
|
|
|
|
|
|
|
907
|
|
|
|
|
|
|
=head2 EvalInContext |
908
|
|
|
|
|
|
|
|
909
|
|
|
|
|
|
|
Not to be used directly. |
910
|
|
|
|
|
|
|
|
911
|
|
|
|
|
|
|
=cut |
912
|
|
|
|
|
|
|
|
913
|
0
|
|
|
0
|
1
|
0
|
my ($lp, $original_code, $verbose, $file, $line) = @_ ; |
914
|
|
|
|
|
|
|
|
915
|
0
|
|
|
|
|
0
|
OutputStrings("# output from '$file:$line':\n\n") ; |
916
|
|
|
|
|
|
|
|
917
|
0
|
0
|
|
|
|
0
|
if($verbose) |
918
|
|
|
|
|
|
|
{ |
919
|
0
|
|
|
|
|
0
|
OutputStrings(<<"EOC") ; |
920
|
|
|
|
|
|
|
running code from '$file:$line': |
921
|
|
|
|
|
|
|
|
922
|
|
|
|
|
|
|
$original_code |
923
|
|
|
|
|
|
|
|
924
|
|
|
|
|
|
|
EOC |
925
|
|
|
|
|
|
|
} |
926
|
|
|
|
|
|
|
|
927
|
0
|
|
|
|
|
0
|
my($code_as_text, $code) = GetWrappedCode($lp, $EMPTY_STRING, $original_code, $EMPTY_STRING, $file, $line) ; |
928
|
|
|
|
|
|
|
|
929
|
0
|
|
|
|
|
0
|
eval { $code->() } ; |
|
0
|
|
|
|
|
0
|
|
930
|
0
|
0
|
|
|
|
0
|
if($EVAL_ERROR) |
931
|
|
|
|
|
|
|
{ |
932
|
0
|
|
|
|
|
0
|
croak $EVAL_ERROR ; |
933
|
|
|
|
|
|
|
} |
934
|
|
|
|
|
|
|
|
935
|
0
|
|
|
|
|
0
|
OutputStrings("\n") ; |
936
|
|
|
|
|
|
|
|
937
|
0
|
|
|
|
|
0
|
return(1) ; |
938
|
|
|
|
|
|
|
} |
939
|
|
|
|
|
|
|
|
940
|
|
|
|
|
|
|
#------------------------------------------------------------------------------------------------------------------------------- |
941
|
|
|
|
|
|
|
|
942
|
|
|
|
|
|
|
sub GetWrappedCode |
943
|
|
|
|
|
|
|
{ ## no critic (Subroutines::ProhibitManyArgs) |
944
|
|
|
|
|
|
|
|
945
|
|
|
|
|
|
|
=head2 GetWrappedCode |
946
|
|
|
|
|
|
|
|
947
|
|
|
|
|
|
|
Not to be used directly. |
948
|
|
|
|
|
|
|
|
949
|
|
|
|
|
|
|
=cut |
950
|
|
|
|
|
|
|
|
951
|
1
|
|
|
1
|
1
|
4
|
my ($lp, $code_header, $code, $code_footer, $file, $line) = @_ ; |
952
|
|
|
|
|
|
|
|
953
|
1
|
|
|
|
|
10
|
my $lexical_variables = join($EMPTY_STRING, map { "my $_;\n" } keys %{$lp->get_context('_')}) ; |
|
0
|
|
|
|
|
0
|
|
|
1
|
|
|
|
|
6
|
|
954
|
|
|
|
|
|
|
|
955
|
1
|
|
|
|
|
17
|
my $subified = <<"EOC" ; |
956
|
|
|
|
|
|
|
#line 0 'GetWrappedCode' |
957
|
|
|
|
|
|
|
sub |
958
|
|
|
|
|
|
|
{ |
959
|
|
|
|
|
|
|
$lexical_variables |
960
|
|
|
|
|
|
|
|
961
|
|
|
|
|
|
|
$code_header |
962
|
|
|
|
|
|
|
|
963
|
|
|
|
|
|
|
#line $line '$file' |
964
|
|
|
|
|
|
|
$code |
965
|
|
|
|
|
|
|
|
966
|
|
|
|
|
|
|
$code_footer |
967
|
|
|
|
|
|
|
} ; |
968
|
|
|
|
|
|
|
EOC |
969
|
|
|
|
|
|
|
|
970
|
1
|
|
|
|
|
260
|
my $compiled = eval $subified ; ## no critic (eval) |
971
|
1
|
50
|
|
|
|
8530
|
croak $EVAL_ERROR if $EVAL_ERROR ; |
972
|
|
|
|
|
|
|
|
973
|
1
|
|
|
|
|
8
|
my $wrapped_code = $lp->wrap($compiled) ; |
974
|
|
|
|
|
|
|
|
975
|
1
|
|
|
|
|
14
|
return($subified, $wrapped_code) ; |
976
|
|
|
|
|
|
|
} |
977
|
|
|
|
|
|
|
|
978
|
|
|
|
|
|
|
#------------------------------------------------------------------------------------------------------------------------------- |
979
|
|
|
|
|
|
|
|
980
|
|
|
|
|
|
|
sub OutputStrings |
981
|
|
|
|
|
|
|
{ |
982
|
|
|
|
|
|
|
|
983
|
|
|
|
|
|
|
=head2 OutputStrings |
984
|
|
|
|
|
|
|
|
985
|
|
|
|
|
|
|
Not to be used directly. |
986
|
|
|
|
|
|
|
|
987
|
|
|
|
|
|
|
=cut |
988
|
|
|
|
|
|
|
|
989
|
0
|
|
|
0
|
1
|
|
my (@strings) = @_ ; |
990
|
|
|
|
|
|
|
|
991
|
0
|
0
|
|
|
|
|
print(@strings) or croak $ERRNO ; |
992
|
|
|
|
|
|
|
|
993
|
0
|
|
|
|
|
|
return ; |
994
|
|
|
|
|
|
|
} |
995
|
|
|
|
|
|
|
|
996
|
|
|
|
|
|
|
#------------------------------------------------------------------------------------------------------------------------------- |
997
|
|
|
|
|
|
|
|
998
|
|
|
|
|
|
|
1 ; |
999
|
|
|
|
|
|
|
|
1000
|
|
|
|
|
|
|
=head1 BUGS AND LIMITATIONS |
1001
|
|
|
|
|
|
|
|
1002
|
|
|
|
|
|
|
None so far. |
1003
|
|
|
|
|
|
|
|
1004
|
|
|
|
|
|
|
=head1 AUTHOR |
1005
|
|
|
|
|
|
|
|
1006
|
|
|
|
|
|
|
Khemir Nadim ibn Hamouda |
1007
|
|
|
|
|
|
|
CPAN ID: NKH |
1008
|
|
|
|
|
|
|
mailto:nadim@khemir.net |
1009
|
|
|
|
|
|
|
|
1010
|
|
|
|
|
|
|
=head1 LICENSE AND COPYRIGHT |
1011
|
|
|
|
|
|
|
|
1012
|
|
|
|
|
|
|
This program is free software; you can redistribute |
1013
|
|
|
|
|
|
|
it and/or modify it under the same terms as Perl itself. |
1014
|
|
|
|
|
|
|
|
1015
|
|
|
|
|
|
|
=head1 SUPPORT |
1016
|
|
|
|
|
|
|
|
1017
|
|
|
|
|
|
|
You can find documentation for this module with the perldoc command. |
1018
|
|
|
|
|
|
|
|
1019
|
|
|
|
|
|
|
perldoc POD::Tested |
1020
|
|
|
|
|
|
|
|
1021
|
|
|
|
|
|
|
You can also look for information at: |
1022
|
|
|
|
|
|
|
|
1023
|
|
|
|
|
|
|
=over 4 |
1024
|
|
|
|
|
|
|
|
1025
|
|
|
|
|
|
|
=item * AnnoCPAN: Annotated CPAN documentation |
1026
|
|
|
|
|
|
|
|
1027
|
|
|
|
|
|
|
L |
1028
|
|
|
|
|
|
|
|
1029
|
|
|
|
|
|
|
=item * RT: CPAN's request tracker |
1030
|
|
|
|
|
|
|
|
1031
|
|
|
|
|
|
|
Please report any bugs or feature requests to L . |
1032
|
|
|
|
|
|
|
|
1033
|
|
|
|
|
|
|
We will be notified, and then you'll automatically be notified of progress on |
1034
|
|
|
|
|
|
|
your bug as we make changes. |
1035
|
|
|
|
|
|
|
|
1036
|
|
|
|
|
|
|
=item * Search CPAN |
1037
|
|
|
|
|
|
|
|
1038
|
|
|
|
|
|
|
L |
1039
|
|
|
|
|
|
|
|
1040
|
|
|
|
|
|
|
=back |
1041
|
|
|
|
|
|
|
|
1042
|
|
|
|
|
|
|
=head1 SEE ALSO |
1043
|
|
|
|
|
|
|
|
1044
|
|
|
|
|
|
|
L |
1045
|
|
|
|
|
|
|
|
1046
|
|
|
|
|
|
|
L |
1047
|
|
|
|
|
|
|
|
1048
|
|
|
|
|
|
|
L |
1049
|
|
|
|
|
|
|
|
1050
|
|
|
|
|
|
|
L |
1051
|
|
|
|
|
|
|
|
1052
|
|
|
|
|
|
|
=cut |