Filename | /usr/lib64/perl5/vendor_perl/5.16.0/Pod/Parser.pm |
Statements | Executed 15 statements in 20.0ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 11.7ms | 12.3ms | BEGIN@205 | Pod::Parser::
1 | 1 | 1 | 77µs | 175µs | BEGIN@11 | Pod::Parser::
1 | 1 | 1 | 62µs | 326µs | BEGIN@206 | Pod::Parser::
1 | 1 | 1 | 54µs | 140µs | BEGIN@207 | Pod::Parser::
1 | 1 | 1 | 53µs | 495µs | BEGIN@14 | Pod::Parser::
1 | 1 | 1 | 24µs | 24µs | BEGIN@208 | Pod::Parser::
0 | 0 | 0 | 0s | 0s | __ANON__[:759] | Pod::Parser::
0 | 0 | 0 | 0s | 0s | __ANON__[:761] | Pod::Parser::
0 | 0 | 0 | 0s | 0s | __ANON__[:762] | Pod::Parser::
0 | 0 | 0 | 0s | 0s | __ANON__[:763] | Pod::Parser::
0 | 0 | 0 | 0s | 0s | _pop_input_stream | Pod::Parser::
0 | 0 | 0 | 0s | 0s | _push_input_stream | Pod::Parser::
0 | 0 | 0 | 0s | 0s | begin_input | Pod::Parser::
0 | 0 | 0 | 0s | 0s | begin_pod | Pod::Parser::
0 | 0 | 0 | 0s | 0s | command | Pod::Parser::
0 | 0 | 0 | 0s | 0s | cutting | Pod::Parser::
0 | 0 | 0 | 0s | 0s | end_input | Pod::Parser::
0 | 0 | 0 | 0s | 0s | end_pod | Pod::Parser::
0 | 0 | 0 | 0s | 0s | errorsub | Pod::Parser::
0 | 0 | 0 | 0s | 0s | initialize | Pod::Parser::
0 | 0 | 0 | 0s | 0s | input_file | Pod::Parser::
0 | 0 | 0 | 0s | 0s | input_handle | Pod::Parser::
0 | 0 | 0 | 0s | 0s | input_streams | Pod::Parser::
0 | 0 | 0 | 0s | 0s | interior_sequence | Pod::Parser::
0 | 0 | 0 | 0s | 0s | interpolate | Pod::Parser::
0 | 0 | 0 | 0s | 0s | new | Pod::Parser::
0 | 0 | 0 | 0s | 0s | output_file | Pod::Parser::
0 | 0 | 0 | 0s | 0s | output_handle | Pod::Parser::
0 | 0 | 0 | 0s | 0s | parse_from_file | Pod::Parser::
0 | 0 | 0 | 0s | 0s | parse_from_filehandle | Pod::Parser::
0 | 0 | 0 | 0s | 0s | parse_paragraph | Pod::Parser::
0 | 0 | 0 | 0s | 0s | parse_text | Pod::Parser::
0 | 0 | 0 | 0s | 0s | parseopts | Pod::Parser::
0 | 0 | 0 | 0s | 0s | preprocess_line | Pod::Parser::
0 | 0 | 0 | 0s | 0s | preprocess_paragraph | Pod::Parser::
0 | 0 | 0 | 0s | 0s | textblock | Pod::Parser::
0 | 0 | 0 | 0s | 0s | top_stream | Pod::Parser::
0 | 0 | 0 | 0s | 0s | verbatim | Pod::Parser::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | ############################################################################# | ||||
2 | # Pod/Parser.pm -- package which defines a base class for parsing POD docs. | ||||
3 | # | ||||
4 | # Copyright (C) 1996-2000 by Bradford Appleton. All rights reserved. | ||||
5 | # This file is part of "PodParser". PodParser is free software; | ||||
6 | # you can redistribute it and/or modify it under the same terms | ||||
7 | # as Perl itself. | ||||
8 | ############################################################################# | ||||
9 | |||||
10 | package Pod::Parser; | ||||
11 | 2 | 172µs | 2 | 272µs | # spent 175µs (77+98) within Pod::Parser::BEGIN@11 which was called:
# once (77µs+98µs) by Pod::Select::BEGIN@242 at line 11 # spent 175µs making 1 call to Pod::Parser::BEGIN@11
# spent 98µs making 1 call to strict::import |
12 | |||||
13 | ## These "variables" are used as local "glob aliases" for performance | ||||
14 | 2 | 605µs | 2 | 937µs | # spent 495µs (53+442) within Pod::Parser::BEGIN@14 which was called:
# once (53µs+442µs) by Pod::Select::BEGIN@242 at line 14 # spent 495µs making 1 call to Pod::Parser::BEGIN@14
# spent 442µs making 1 call to vars::import |
15 | 1 | 5µs | $VERSION = '1.37'; ## Current version of this package | ||
16 | 1 | 61µs | require 5.005; ## requires this Perl version or later | ||
17 | |||||
18 | ############################################################################# | ||||
19 | |||||
20 | =head1 NAME | ||||
21 | |||||
22 | Pod::Parser - base class for creating POD filters and translators | ||||
23 | |||||
24 | =head1 SYNOPSIS | ||||
25 | |||||
26 | use Pod::Parser; | ||||
27 | |||||
28 | package MyParser; | ||||
29 | @ISA = qw(Pod::Parser); | ||||
30 | |||||
31 | sub command { | ||||
32 | my ($parser, $command, $paragraph, $line_num) = @_; | ||||
33 | ## Interpret the command and its text; sample actions might be: | ||||
34 | if ($command eq 'head1') { ... } | ||||
35 | elsif ($command eq 'head2') { ... } | ||||
36 | ## ... other commands and their actions | ||||
37 | my $out_fh = $parser->output_handle(); | ||||
38 | my $expansion = $parser->interpolate($paragraph, $line_num); | ||||
39 | print $out_fh $expansion; | ||||
40 | } | ||||
41 | |||||
42 | sub verbatim { | ||||
43 | my ($parser, $paragraph, $line_num) = @_; | ||||
44 | ## Format verbatim paragraph; sample actions might be: | ||||
45 | my $out_fh = $parser->output_handle(); | ||||
46 | print $out_fh $paragraph; | ||||
47 | } | ||||
48 | |||||
49 | sub textblock { | ||||
50 | my ($parser, $paragraph, $line_num) = @_; | ||||
51 | ## Translate/Format this block of text; sample actions might be: | ||||
52 | my $out_fh = $parser->output_handle(); | ||||
53 | my $expansion = $parser->interpolate($paragraph, $line_num); | ||||
54 | print $out_fh $expansion; | ||||
55 | } | ||||
56 | |||||
57 | sub interior_sequence { | ||||
58 | my ($parser, $seq_command, $seq_argument) = @_; | ||||
59 | ## Expand an interior sequence; sample actions might be: | ||||
60 | return "*$seq_argument*" if ($seq_command eq 'B'); | ||||
61 | return "`$seq_argument'" if ($seq_command eq 'C'); | ||||
62 | return "_${seq_argument}_'" if ($seq_command eq 'I'); | ||||
63 | ## ... other sequence commands and their resulting text | ||||
64 | } | ||||
65 | |||||
66 | package main; | ||||
67 | |||||
68 | ## Create a parser object and have it parse file whose name was | ||||
69 | ## given on the command-line (use STDIN if no files were given). | ||||
70 | $parser = new MyParser(); | ||||
71 | $parser->parse_from_filehandle(\*STDIN) if (@ARGV == 0); | ||||
72 | for (@ARGV) { $parser->parse_from_file($_); } | ||||
73 | |||||
74 | =head1 REQUIRES | ||||
75 | |||||
76 | perl5.005, Pod::InputObjects, Exporter, Symbol, Carp | ||||
77 | |||||
78 | =head1 EXPORTS | ||||
79 | |||||
80 | Nothing. | ||||
81 | |||||
82 | =head1 DESCRIPTION | ||||
83 | |||||
84 | B<Pod::Parser> is a base class for creating POD filters and translators. | ||||
85 | It handles most of the effort involved with parsing the POD sections | ||||
86 | from an input stream, leaving subclasses free to be concerned only with | ||||
87 | performing the actual translation of text. | ||||
88 | |||||
89 | B<Pod::Parser> parses PODs, and makes method calls to handle the various | ||||
90 | components of the POD. Subclasses of B<Pod::Parser> override these methods | ||||
91 | to translate the POD into whatever output format they desire. | ||||
92 | |||||
93 | =head1 QUICK OVERVIEW | ||||
94 | |||||
95 | To create a POD filter for translating POD documentation into some other | ||||
96 | format, you create a subclass of B<Pod::Parser> which typically overrides | ||||
97 | just the base class implementation for the following methods: | ||||
98 | |||||
99 | =over 2 | ||||
100 | |||||
101 | =item * | ||||
102 | |||||
103 | B<command()> | ||||
104 | |||||
105 | =item * | ||||
106 | |||||
107 | B<verbatim()> | ||||
108 | |||||
109 | =item * | ||||
110 | |||||
111 | B<textblock()> | ||||
112 | |||||
113 | =item * | ||||
114 | |||||
115 | B<interior_sequence()> | ||||
116 | |||||
117 | =back | ||||
118 | |||||
119 | You may also want to override the B<begin_input()> and B<end_input()> | ||||
120 | methods for your subclass (to perform any needed per-file and/or | ||||
121 | per-document initialization or cleanup). | ||||
122 | |||||
123 | If you need to perform any preprocessing of input before it is parsed | ||||
124 | you may want to override one or more of B<preprocess_line()> and/or | ||||
125 | B<preprocess_paragraph()>. | ||||
126 | |||||
127 | Sometimes it may be necessary to make more than one pass over the input | ||||
128 | files. If this is the case you have several options. You can make the | ||||
129 | first pass using B<Pod::Parser> and override your methods to store the | ||||
130 | intermediate results in memory somewhere for the B<end_pod()> method to | ||||
131 | process. You could use B<Pod::Parser> for several passes with an | ||||
132 | appropriate state variable to control the operation for each pass. If | ||||
133 | your input source can't be reset to start at the beginning, you can | ||||
134 | store it in some other structure as a string or an array and have that | ||||
135 | structure implement a B<getline()> method (which is all that | ||||
136 | B<parse_from_filehandle()> uses to read input). | ||||
137 | |||||
138 | Feel free to add any member data fields you need to keep track of things | ||||
139 | like current font, indentation, horizontal or vertical position, or | ||||
140 | whatever else you like. Be sure to read L<"PRIVATE METHODS AND DATA"> | ||||
141 | to avoid name collisions. | ||||
142 | |||||
143 | For the most part, the B<Pod::Parser> base class should be able to | ||||
144 | do most of the input parsing for you and leave you free to worry about | ||||
145 | how to interpret the commands and translate the result. | ||||
146 | |||||
147 | Note that all we have described here in this quick overview is the | ||||
148 | simplest most straightforward use of B<Pod::Parser> to do stream-based | ||||
149 | parsing. It is also possible to use the B<Pod::Parser::parse_text> function | ||||
150 | to do more sophisticated tree-based parsing. See L<"TREE-BASED PARSING">. | ||||
151 | |||||
152 | =head1 PARSING OPTIONS | ||||
153 | |||||
154 | A I<parse-option> is simply a named option of B<Pod::Parser> with a | ||||
155 | value that corresponds to a certain specified behavior. These various | ||||
156 | behaviors of B<Pod::Parser> may be enabled/disabled by setting | ||||
157 | or unsetting one or more I<parse-options> using the B<parseopts()> method. | ||||
158 | The set of currently accepted parse-options is as follows: | ||||
159 | |||||
160 | =over 3 | ||||
161 | |||||
162 | =item B<-want_nonPODs> (default: unset) | ||||
163 | |||||
164 | Normally (by default) B<Pod::Parser> will only provide access to | ||||
165 | the POD sections of the input. Input paragraphs that are not part | ||||
166 | of the POD-format documentation are not made available to the caller | ||||
167 | (not even using B<preprocess_paragraph()>). Setting this option to a | ||||
168 | non-empty, non-zero value will allow B<preprocess_paragraph()> to see | ||||
169 | non-POD sections of the input as well as POD sections. The B<cutting()> | ||||
170 | method can be used to determine if the corresponding paragraph is a POD | ||||
171 | paragraph, or some other input paragraph. | ||||
172 | |||||
173 | =item B<-process_cut_cmd> (default: unset) | ||||
174 | |||||
175 | Normally (by default) B<Pod::Parser> handles the C<=cut> POD directive | ||||
176 | by itself and does not pass it on to the caller for processing. Setting | ||||
177 | this option to a non-empty, non-zero value will cause B<Pod::Parser> to | ||||
178 | pass the C<=cut> directive to the caller just like any other POD command | ||||
179 | (and hence it may be processed by the B<command()> method). | ||||
180 | |||||
181 | B<Pod::Parser> will still interpret the C<=cut> directive to mean that | ||||
182 | "cutting mode" has been (re)entered, but the caller will get a chance | ||||
183 | to capture the actual C<=cut> paragraph itself for whatever purpose | ||||
184 | it desires. | ||||
185 | |||||
186 | =item B<-warnings> (default: unset) | ||||
187 | |||||
188 | Normally (by default) B<Pod::Parser> recognizes a bare minimum of | ||||
189 | pod syntax errors and warnings and issues diagnostic messages | ||||
190 | for errors, but not for warnings. (Use B<Pod::Checker> to do more | ||||
191 | thorough checking of POD syntax.) Setting this option to a non-empty, | ||||
192 | non-zero value will cause B<Pod::Parser> to issue diagnostics for | ||||
193 | the few warnings it recognizes as well as the errors. | ||||
194 | |||||
195 | =back | ||||
196 | |||||
197 | Please see L<"parseopts()"> for a complete description of the interface | ||||
198 | for the setting and unsetting of parse-options. | ||||
199 | |||||
200 | =cut | ||||
201 | |||||
202 | ############################################################################# | ||||
203 | |||||
204 | #use diagnostics; | ||||
205 | 2 | 646µs | 1 | 12.3ms | # spent 12.3ms (11.7+613µs) within Pod::Parser::BEGIN@205 which was called:
# once (11.7ms+613µs) by Pod::Select::BEGIN@242 at line 205 # spent 12.3ms making 1 call to Pod::Parser::BEGIN@205 |
206 | 2 | 162µs | 2 | 589µs | # spent 326µs (62+263) within Pod::Parser::BEGIN@206 which was called:
# once (62µs+263µs) by Pod::Select::BEGIN@242 at line 206 # spent 326µs making 1 call to Pod::Parser::BEGIN@206
# spent 263µs making 1 call to Exporter::import |
207 | 2 | 261µs | 2 | 227µs | # spent 140µs (54+86) within Pod::Parser::BEGIN@207 which was called:
# once (54µs+86µs) by Pod::Select::BEGIN@242 at line 207 # spent 140µs making 1 call to Pod::Parser::BEGIN@207
# spent 86µs making 1 call to Exporter::import |
208 | # spent 24µs within Pod::Parser::BEGIN@208 which was called:
# once (24µs+0s) by Pod::Select::BEGIN@242 at line 213 | ||||
209 | 1 | 55µs | if ($] < 5.006) { | ||
210 | require Symbol; | ||||
211 | import Symbol; | ||||
212 | } | ||||
213 | 1 | 18.0ms | 1 | 24µs | } # spent 24µs making 1 call to Pod::Parser::BEGIN@208 |
214 | 1 | 36µs | @ISA = qw(Exporter); | ||
215 | |||||
216 | ############################################################################# | ||||
217 | |||||
218 | =head1 RECOMMENDED SUBROUTINE/METHOD OVERRIDES | ||||
219 | |||||
220 | B<Pod::Parser> provides several methods which most subclasses will probably | ||||
221 | want to override. These methods are as follows: | ||||
222 | |||||
223 | =cut | ||||
224 | |||||
225 | ##--------------------------------------------------------------------------- | ||||
226 | |||||
227 | =head1 B<command()> | ||||
228 | |||||
229 | $parser->command($cmd,$text,$line_num,$pod_para); | ||||
230 | |||||
231 | This method should be overridden by subclasses to take the appropriate | ||||
232 | action when a POD command paragraph (denoted by a line beginning with | ||||
233 | "=") is encountered. When such a POD directive is seen in the input, | ||||
234 | this method is called and is passed: | ||||
235 | |||||
236 | =over 3 | ||||
237 | |||||
238 | =item C<$cmd> | ||||
239 | |||||
240 | the name of the command for this POD paragraph | ||||
241 | |||||
242 | =item C<$text> | ||||
243 | |||||
244 | the paragraph text for the given POD paragraph command. | ||||
245 | |||||
246 | =item C<$line_num> | ||||
247 | |||||
248 | the line-number of the beginning of the paragraph | ||||
249 | |||||
250 | =item C<$pod_para> | ||||
251 | |||||
252 | a reference to a C<Pod::Paragraph> object which contains further | ||||
253 | information about the paragraph command (see L<Pod::InputObjects> | ||||
254 | for details). | ||||
255 | |||||
256 | =back | ||||
257 | |||||
258 | B<Note> that this method I<is> called for C<=pod> paragraphs. | ||||
259 | |||||
260 | The base class implementation of this method simply treats the raw POD | ||||
261 | command as normal block of paragraph text (invoking the B<textblock()> | ||||
262 | method with the command paragraph). | ||||
263 | |||||
264 | =cut | ||||
265 | |||||
266 | sub command { | ||||
267 | my ($self, $cmd, $text, $line_num, $pod_para) = @_; | ||||
268 | ## Just treat this like a textblock | ||||
269 | $self->textblock($pod_para->raw_text(), $line_num, $pod_para); | ||||
270 | } | ||||
271 | |||||
272 | ##--------------------------------------------------------------------------- | ||||
273 | |||||
274 | =head1 B<verbatim()> | ||||
275 | |||||
276 | $parser->verbatim($text,$line_num,$pod_para); | ||||
277 | |||||
278 | This method may be overridden by subclasses to take the appropriate | ||||
279 | action when a block of verbatim text is encountered. It is passed the | ||||
280 | following parameters: | ||||
281 | |||||
282 | =over 3 | ||||
283 | |||||
284 | =item C<$text> | ||||
285 | |||||
286 | the block of text for the verbatim paragraph | ||||
287 | |||||
288 | =item C<$line_num> | ||||
289 | |||||
290 | the line-number of the beginning of the paragraph | ||||
291 | |||||
292 | =item C<$pod_para> | ||||
293 | |||||
294 | a reference to a C<Pod::Paragraph> object which contains further | ||||
295 | information about the paragraph (see L<Pod::InputObjects> | ||||
296 | for details). | ||||
297 | |||||
298 | =back | ||||
299 | |||||
300 | The base class implementation of this method simply prints the textblock | ||||
301 | (unmodified) to the output filehandle. | ||||
302 | |||||
303 | =cut | ||||
304 | |||||
305 | sub verbatim { | ||||
306 | my ($self, $text, $line_num, $pod_para) = @_; | ||||
307 | my $out_fh = $self->{_OUTPUT}; | ||||
308 | print $out_fh $text; | ||||
309 | } | ||||
310 | |||||
311 | ##--------------------------------------------------------------------------- | ||||
312 | |||||
313 | =head1 B<textblock()> | ||||
314 | |||||
315 | $parser->textblock($text,$line_num,$pod_para); | ||||
316 | |||||
317 | This method may be overridden by subclasses to take the appropriate | ||||
318 | action when a normal block of POD text is encountered (although the base | ||||
319 | class method will usually do what you want). It is passed the following | ||||
320 | parameters: | ||||
321 | |||||
322 | =over 3 | ||||
323 | |||||
324 | =item C<$text> | ||||
325 | |||||
326 | the block of text for the a POD paragraph | ||||
327 | |||||
328 | =item C<$line_num> | ||||
329 | |||||
330 | the line-number of the beginning of the paragraph | ||||
331 | |||||
332 | =item C<$pod_para> | ||||
333 | |||||
334 | a reference to a C<Pod::Paragraph> object which contains further | ||||
335 | information about the paragraph (see L<Pod::InputObjects> | ||||
336 | for details). | ||||
337 | |||||
338 | =back | ||||
339 | |||||
340 | In order to process interior sequences, subclasses implementations of | ||||
341 | this method will probably want to invoke either B<interpolate()> or | ||||
342 | B<parse_text()>, passing it the text block C<$text>, and the corresponding | ||||
343 | line number in C<$line_num>, and then perform any desired processing upon | ||||
344 | the returned result. | ||||
345 | |||||
346 | The base class implementation of this method simply prints the text block | ||||
347 | as it occurred in the input stream). | ||||
348 | |||||
349 | =cut | ||||
350 | |||||
351 | sub textblock { | ||||
352 | my ($self, $text, $line_num, $pod_para) = @_; | ||||
353 | my $out_fh = $self->{_OUTPUT}; | ||||
354 | print $out_fh $self->interpolate($text, $line_num); | ||||
355 | } | ||||
356 | |||||
357 | ##--------------------------------------------------------------------------- | ||||
358 | |||||
359 | =head1 B<interior_sequence()> | ||||
360 | |||||
361 | $parser->interior_sequence($seq_cmd,$seq_arg,$pod_seq); | ||||
362 | |||||
363 | This method should be overridden by subclasses to take the appropriate | ||||
364 | action when an interior sequence is encountered. An interior sequence is | ||||
365 | an embedded command within a block of text which appears as a command | ||||
366 | name (usually a single uppercase character) followed immediately by a | ||||
367 | string of text which is enclosed in angle brackets. This method is | ||||
368 | passed the sequence command C<$seq_cmd> and the corresponding text | ||||
369 | C<$seq_arg>. It is invoked by the B<interpolate()> method for each interior | ||||
370 | sequence that occurs in the string that it is passed. It should return | ||||
371 | the desired text string to be used in place of the interior sequence. | ||||
372 | The C<$pod_seq> argument is a reference to a C<Pod::InteriorSequence> | ||||
373 | object which contains further information about the interior sequence. | ||||
374 | Please see L<Pod::InputObjects> for details if you need to access this | ||||
375 | additional information. | ||||
376 | |||||
377 | Subclass implementations of this method may wish to invoke the | ||||
378 | B<nested()> method of C<$pod_seq> to see if it is nested inside | ||||
379 | some other interior-sequence (and if so, which kind). | ||||
380 | |||||
381 | The base class implementation of the B<interior_sequence()> method | ||||
382 | simply returns the raw text of the interior sequence (as it occurred | ||||
383 | in the input) to the caller. | ||||
384 | |||||
385 | =cut | ||||
386 | |||||
387 | sub interior_sequence { | ||||
388 | my ($self, $seq_cmd, $seq_arg, $pod_seq) = @_; | ||||
389 | ## Just return the raw text of the interior sequence | ||||
390 | return $pod_seq->raw_text(); | ||||
391 | } | ||||
392 | |||||
393 | ############################################################################# | ||||
394 | |||||
395 | =head1 OPTIONAL SUBROUTINE/METHOD OVERRIDES | ||||
396 | |||||
397 | B<Pod::Parser> provides several methods which subclasses may want to override | ||||
398 | to perform any special pre/post-processing. These methods do I<not> have to | ||||
399 | be overridden, but it may be useful for subclasses to take advantage of them. | ||||
400 | |||||
401 | =cut | ||||
402 | |||||
403 | ##--------------------------------------------------------------------------- | ||||
404 | |||||
405 | =head1 B<new()> | ||||
406 | |||||
407 | my $parser = Pod::Parser->new(); | ||||
408 | |||||
409 | This is the constructor for B<Pod::Parser> and its subclasses. You | ||||
410 | I<do not> need to override this method! It is capable of constructing | ||||
411 | subclass objects as well as base class objects, provided you use | ||||
412 | any of the following constructor invocation styles: | ||||
413 | |||||
414 | my $parser1 = MyParser->new(); | ||||
415 | my $parser2 = new MyParser(); | ||||
416 | my $parser3 = $parser2->new(); | ||||
417 | |||||
418 | where C<MyParser> is some subclass of B<Pod::Parser>. | ||||
419 | |||||
420 | Using the syntax C<MyParser::new()> to invoke the constructor is I<not> | ||||
421 | recommended, but if you insist on being able to do this, then the | ||||
422 | subclass I<will> need to override the B<new()> constructor method. If | ||||
423 | you do override the constructor, you I<must> be sure to invoke the | ||||
424 | B<initialize()> method of the newly blessed object. | ||||
425 | |||||
426 | Using any of the above invocations, the first argument to the | ||||
427 | constructor is always the corresponding package name (or object | ||||
428 | reference). No other arguments are required, but if desired, an | ||||
429 | associative array (or hash-table) my be passed to the B<new()> | ||||
430 | constructor, as in: | ||||
431 | |||||
432 | my $parser1 = MyParser->new( MYDATA => $value1, MOREDATA => $value2 ); | ||||
433 | my $parser2 = new MyParser( -myflag => 1 ); | ||||
434 | |||||
435 | All arguments passed to the B<new()> constructor will be treated as | ||||
436 | key/value pairs in a hash-table. The newly constructed object will be | ||||
437 | initialized by copying the contents of the given hash-table (which may | ||||
438 | have been empty). The B<new()> constructor for this class and all of its | ||||
439 | subclasses returns a blessed reference to the initialized object (hash-table). | ||||
440 | |||||
441 | =cut | ||||
442 | |||||
443 | sub new { | ||||
444 | ## Determine if we were called via an object-ref or a classname | ||||
445 | my ($this,%params) = @_; | ||||
446 | my $class = ref($this) || $this; | ||||
447 | ## Any remaining arguments are treated as initial values for the | ||||
448 | ## hash that is used to represent this object. | ||||
449 | my $self = { %params }; | ||||
450 | ## Bless ourselves into the desired class and perform any initialization | ||||
451 | bless $self, $class; | ||||
452 | $self->initialize(); | ||||
453 | return $self; | ||||
454 | } | ||||
455 | |||||
456 | ##--------------------------------------------------------------------------- | ||||
457 | |||||
458 | =head1 B<initialize()> | ||||
459 | |||||
460 | $parser->initialize(); | ||||
461 | |||||
462 | This method performs any necessary object initialization. It takes no | ||||
463 | arguments (other than the object instance of course, which is typically | ||||
464 | copied to a local variable named C<$self>). If subclasses override this | ||||
465 | method then they I<must> be sure to invoke C<$self-E<gt>SUPER::initialize()>. | ||||
466 | |||||
467 | =cut | ||||
468 | |||||
469 | sub initialize { | ||||
470 | #my $self = shift; | ||||
471 | #return; | ||||
472 | } | ||||
473 | |||||
474 | ##--------------------------------------------------------------------------- | ||||
475 | |||||
476 | =head1 B<begin_pod()> | ||||
477 | |||||
478 | $parser->begin_pod(); | ||||
479 | |||||
480 | This method is invoked at the beginning of processing for each POD | ||||
481 | document that is encountered in the input. Subclasses should override | ||||
482 | this method to perform any per-document initialization. | ||||
483 | |||||
484 | =cut | ||||
485 | |||||
486 | sub begin_pod { | ||||
487 | #my $self = shift; | ||||
488 | #return; | ||||
489 | } | ||||
490 | |||||
491 | ##--------------------------------------------------------------------------- | ||||
492 | |||||
493 | =head1 B<begin_input()> | ||||
494 | |||||
495 | $parser->begin_input(); | ||||
496 | |||||
497 | This method is invoked by B<parse_from_filehandle()> immediately I<before> | ||||
498 | processing input from a filehandle. The base class implementation does | ||||
499 | nothing, however, subclasses may override it to perform any per-file | ||||
500 | initializations. | ||||
501 | |||||
502 | Note that if multiple files are parsed for a single POD document | ||||
503 | (perhaps the result of some future C<=include> directive) this method | ||||
504 | is invoked for every file that is parsed. If you wish to perform certain | ||||
505 | initializations once per document, then you should use B<begin_pod()>. | ||||
506 | |||||
507 | =cut | ||||
508 | |||||
509 | sub begin_input { | ||||
510 | #my $self = shift; | ||||
511 | #return; | ||||
512 | } | ||||
513 | |||||
514 | ##--------------------------------------------------------------------------- | ||||
515 | |||||
516 | =head1 B<end_input()> | ||||
517 | |||||
518 | $parser->end_input(); | ||||
519 | |||||
520 | This method is invoked by B<parse_from_filehandle()> immediately I<after> | ||||
521 | processing input from a filehandle. The base class implementation does | ||||
522 | nothing, however, subclasses may override it to perform any per-file | ||||
523 | cleanup actions. | ||||
524 | |||||
525 | Please note that if multiple files are parsed for a single POD document | ||||
526 | (perhaps the result of some kind of C<=include> directive) this method | ||||
527 | is invoked for every file that is parsed. If you wish to perform certain | ||||
528 | cleanup actions once per document, then you should use B<end_pod()>. | ||||
529 | |||||
530 | =cut | ||||
531 | |||||
532 | sub end_input { | ||||
533 | #my $self = shift; | ||||
534 | #return; | ||||
535 | } | ||||
536 | |||||
537 | ##--------------------------------------------------------------------------- | ||||
538 | |||||
539 | =head1 B<end_pod()> | ||||
540 | |||||
541 | $parser->end_pod(); | ||||
542 | |||||
543 | This method is invoked at the end of processing for each POD document | ||||
544 | that is encountered in the input. Subclasses should override this method | ||||
545 | to perform any per-document finalization. | ||||
546 | |||||
547 | =cut | ||||
548 | |||||
549 | sub end_pod { | ||||
550 | #my $self = shift; | ||||
551 | #return; | ||||
552 | } | ||||
553 | |||||
554 | ##--------------------------------------------------------------------------- | ||||
555 | |||||
556 | =head1 B<preprocess_line()> | ||||
557 | |||||
558 | $textline = $parser->preprocess_line($text, $line_num); | ||||
559 | |||||
560 | This method should be overridden by subclasses that wish to perform | ||||
561 | any kind of preprocessing for each I<line> of input (I<before> it has | ||||
562 | been determined whether or not it is part of a POD paragraph). The | ||||
563 | parameter C<$text> is the input line; and the parameter C<$line_num> is | ||||
564 | the line number of the corresponding text line. | ||||
565 | |||||
566 | The value returned should correspond to the new text to use in its | ||||
567 | place. If the empty string or an undefined value is returned then no | ||||
568 | further processing will be performed for this line. | ||||
569 | |||||
570 | Please note that the B<preprocess_line()> method is invoked I<before> | ||||
571 | the B<preprocess_paragraph()> method. After all (possibly preprocessed) | ||||
572 | lines in a paragraph have been assembled together and it has been | ||||
573 | determined that the paragraph is part of the POD documentation from one | ||||
574 | of the selected sections, then B<preprocess_paragraph()> is invoked. | ||||
575 | |||||
576 | The base class implementation of this method returns the given text. | ||||
577 | |||||
578 | =cut | ||||
579 | |||||
580 | sub preprocess_line { | ||||
581 | my ($self, $text, $line_num) = @_; | ||||
582 | return $text; | ||||
583 | } | ||||
584 | |||||
585 | ##--------------------------------------------------------------------------- | ||||
586 | |||||
587 | =head1 B<preprocess_paragraph()> | ||||
588 | |||||
589 | $textblock = $parser->preprocess_paragraph($text, $line_num); | ||||
590 | |||||
591 | This method should be overridden by subclasses that wish to perform any | ||||
592 | kind of preprocessing for each block (paragraph) of POD documentation | ||||
593 | that appears in the input stream. The parameter C<$text> is the POD | ||||
594 | paragraph from the input file; and the parameter C<$line_num> is the | ||||
595 | line number for the beginning of the corresponding paragraph. | ||||
596 | |||||
597 | The value returned should correspond to the new text to use in its | ||||
598 | place If the empty string is returned or an undefined value is | ||||
599 | returned, then the given C<$text> is ignored (not processed). | ||||
600 | |||||
601 | This method is invoked after gathering up all the lines in a paragraph | ||||
602 | and after determining the cutting state of the paragraph, | ||||
603 | but before trying to further parse or interpret them. After | ||||
604 | B<preprocess_paragraph()> returns, the current cutting state (which | ||||
605 | is returned by C<$self-E<gt>cutting()>) is examined. If it evaluates | ||||
606 | to true then input text (including the given C<$text>) is cut (not | ||||
607 | processed) until the next POD directive is encountered. | ||||
608 | |||||
609 | Please note that the B<preprocess_line()> method is invoked I<before> | ||||
610 | the B<preprocess_paragraph()> method. After all (possibly preprocessed) | ||||
611 | lines in a paragraph have been assembled together and either it has been | ||||
612 | determined that the paragraph is part of the POD documentation from one | ||||
613 | of the selected sections or the C<-want_nonPODs> option is true, | ||||
614 | then B<preprocess_paragraph()> is invoked. | ||||
615 | |||||
616 | The base class implementation of this method returns the given text. | ||||
617 | |||||
618 | =cut | ||||
619 | |||||
620 | sub preprocess_paragraph { | ||||
621 | my ($self, $text, $line_num) = @_; | ||||
622 | return $text; | ||||
623 | } | ||||
624 | |||||
625 | ############################################################################# | ||||
626 | |||||
627 | =head1 METHODS FOR PARSING AND PROCESSING | ||||
628 | |||||
629 | B<Pod::Parser> provides several methods to process input text. These | ||||
630 | methods typically won't need to be overridden (and in some cases they | ||||
631 | can't be overridden), but subclasses may want to invoke them to exploit | ||||
632 | their functionality. | ||||
633 | |||||
634 | =cut | ||||
635 | |||||
636 | ##--------------------------------------------------------------------------- | ||||
637 | |||||
638 | =head1 B<parse_text()> | ||||
639 | |||||
640 | $ptree1 = $parser->parse_text($text, $line_num); | ||||
641 | $ptree2 = $parser->parse_text({%opts}, $text, $line_num); | ||||
642 | $ptree3 = $parser->parse_text(\%opts, $text, $line_num); | ||||
643 | |||||
644 | This method is useful if you need to perform your own interpolation | ||||
645 | of interior sequences and can't rely upon B<interpolate> to expand | ||||
646 | them in simple bottom-up order. | ||||
647 | |||||
648 | The parameter C<$text> is a string or block of text to be parsed | ||||
649 | for interior sequences; and the parameter C<$line_num> is the | ||||
650 | line number corresponding to the beginning of C<$text>. | ||||
651 | |||||
652 | B<parse_text()> will parse the given text into a parse-tree of "nodes." | ||||
653 | and interior-sequences. Each "node" in the parse tree is either a | ||||
654 | text-string, or a B<Pod::InteriorSequence>. The result returned is a | ||||
655 | parse-tree of type B<Pod::ParseTree>. Please see L<Pod::InputObjects> | ||||
656 | for more information about B<Pod::InteriorSequence> and B<Pod::ParseTree>. | ||||
657 | |||||
658 | If desired, an optional hash-ref may be specified as the first argument | ||||
659 | to customize certain aspects of the parse-tree that is created and | ||||
660 | returned. The set of recognized option keywords are: | ||||
661 | |||||
662 | =over 3 | ||||
663 | |||||
664 | =item B<-expand_seq> =E<gt> I<code-ref>|I<method-name> | ||||
665 | |||||
666 | Normally, the parse-tree returned by B<parse_text()> will contain an | ||||
667 | unexpanded C<Pod::InteriorSequence> object for each interior-sequence | ||||
668 | encountered. Specifying B<-expand_seq> tells B<parse_text()> to "expand" | ||||
669 | every interior-sequence it sees by invoking the referenced function | ||||
670 | (or named method of the parser object) and using the return value as the | ||||
671 | expanded result. | ||||
672 | |||||
673 | If a subroutine reference was given, it is invoked as: | ||||
674 | |||||
675 | &$code_ref( $parser, $sequence ) | ||||
676 | |||||
677 | and if a method-name was given, it is invoked as: | ||||
678 | |||||
679 | $parser->method_name( $sequence ) | ||||
680 | |||||
681 | where C<$parser> is a reference to the parser object, and C<$sequence> | ||||
682 | is a reference to the interior-sequence object. | ||||
683 | [I<NOTE>: If the B<interior_sequence()> method is specified, then it is | ||||
684 | invoked according to the interface specified in L<"interior_sequence()">]. | ||||
685 | |||||
686 | =item B<-expand_text> =E<gt> I<code-ref>|I<method-name> | ||||
687 | |||||
688 | Normally, the parse-tree returned by B<parse_text()> will contain a | ||||
689 | text-string for each contiguous sequence of characters outside of an | ||||
690 | interior-sequence. Specifying B<-expand_text> tells B<parse_text()> to | ||||
691 | "preprocess" every such text-string it sees by invoking the referenced | ||||
692 | function (or named method of the parser object) and using the return value | ||||
693 | as the preprocessed (or "expanded") result. [Note that if the result is | ||||
694 | an interior-sequence, then it will I<not> be expanded as specified by the | ||||
695 | B<-expand_seq> option; Any such recursive expansion needs to be handled by | ||||
696 | the specified callback routine.] | ||||
697 | |||||
698 | If a subroutine reference was given, it is invoked as: | ||||
699 | |||||
700 | &$code_ref( $parser, $text, $ptree_node ) | ||||
701 | |||||
702 | and if a method-name was given, it is invoked as: | ||||
703 | |||||
704 | $parser->method_name( $text, $ptree_node ) | ||||
705 | |||||
706 | where C<$parser> is a reference to the parser object, C<$text> is the | ||||
707 | text-string encountered, and C<$ptree_node> is a reference to the current | ||||
708 | node in the parse-tree (usually an interior-sequence object or else the | ||||
709 | top-level node of the parse-tree). | ||||
710 | |||||
711 | =item B<-expand_ptree> =E<gt> I<code-ref>|I<method-name> | ||||
712 | |||||
713 | Rather than returning a C<Pod::ParseTree>, pass the parse-tree as an | ||||
714 | argument to the referenced subroutine (or named method of the parser | ||||
715 | object) and return the result instead of the parse-tree object. | ||||
716 | |||||
717 | If a subroutine reference was given, it is invoked as: | ||||
718 | |||||
719 | &$code_ref( $parser, $ptree ) | ||||
720 | |||||
721 | and if a method-name was given, it is invoked as: | ||||
722 | |||||
723 | $parser->method_name( $ptree ) | ||||
724 | |||||
725 | where C<$parser> is a reference to the parser object, and C<$ptree> | ||||
726 | is a reference to the parse-tree object. | ||||
727 | |||||
728 | =back | ||||
729 | |||||
730 | =cut | ||||
731 | |||||
732 | sub parse_text { | ||||
733 | my $self = shift; | ||||
734 | local $_ = ''; | ||||
735 | |||||
736 | ## Get options and set any defaults | ||||
737 | my %opts = (ref $_[0]) ? %{ shift() } : (); | ||||
738 | my $expand_seq = $opts{'-expand_seq'} || undef; | ||||
739 | my $expand_text = $opts{'-expand_text'} || undef; | ||||
740 | my $expand_ptree = $opts{'-expand_ptree'} || undef; | ||||
741 | |||||
742 | my $text = shift; | ||||
743 | my $line = shift; | ||||
744 | my $file = $self->input_file(); | ||||
745 | my $cmd = ""; | ||||
746 | |||||
747 | ## Convert method calls into closures, for our convenience | ||||
748 | my $xseq_sub = $expand_seq; | ||||
749 | my $xtext_sub = $expand_text; | ||||
750 | my $xptree_sub = $expand_ptree; | ||||
751 | if (defined $expand_seq and $expand_seq eq 'interior_sequence') { | ||||
752 | ## If 'interior_sequence' is the method to use, we have to pass | ||||
753 | ## more than just the sequence object, we also need to pass the | ||||
754 | ## sequence name and text. | ||||
755 | $xseq_sub = sub { | ||||
756 | my ($sself, $iseq) = @_; | ||||
757 | my $args = join('', $iseq->parse_tree->children); | ||||
758 | return $sself->interior_sequence($iseq->name, $args, $iseq); | ||||
759 | }; | ||||
760 | } | ||||
761 | ref $xseq_sub or $xseq_sub = sub { shift()->$expand_seq(@_) }; | ||||
762 | ref $xtext_sub or $xtext_sub = sub { shift()->$expand_text(@_) }; | ||||
763 | ref $xptree_sub or $xptree_sub = sub { shift()->$expand_ptree(@_) }; | ||||
764 | |||||
765 | ## Keep track of the "current" interior sequence, and maintain a stack | ||||
766 | ## of "in progress" sequences. | ||||
767 | ## | ||||
768 | ## NOTE that we push our own "accumulator" at the very beginning of the | ||||
769 | ## stack. It's really a parse-tree, not a sequence; but it implements | ||||
770 | ## the methods we need so we can use it to gather-up all the sequences | ||||
771 | ## and strings we parse. Thus, by the end of our parsing, it should be | ||||
772 | ## the only thing left on our stack and all we have to do is return it! | ||||
773 | ## | ||||
774 | my $seq = Pod::ParseTree->new(); | ||||
775 | my @seq_stack = ($seq); | ||||
776 | my ($ldelim, $rdelim) = ('', ''); | ||||
777 | |||||
778 | ## Iterate over all sequence starts text (NOTE: split with | ||||
779 | ## capturing parens keeps the delimiters) | ||||
780 | $_ = $text; | ||||
781 | my @tokens = split /([A-Z]<(?:<+\s)?)/; | ||||
782 | while ( @tokens ) { | ||||
783 | $_ = shift @tokens; | ||||
784 | ## Look for the beginning of a sequence | ||||
785 | if ( /^([A-Z])(<(?:<+\s)?)$/ ) { | ||||
786 | ## Push a new sequence onto the stack of those "in-progress" | ||||
787 | my $ldelim_orig; | ||||
788 | ($cmd, $ldelim_orig) = ($1, $2); | ||||
789 | ($ldelim = $ldelim_orig) =~ s/\s+$//; | ||||
790 | ($rdelim = $ldelim) =~ tr/</>/; | ||||
791 | $seq = Pod::InteriorSequence->new( | ||||
792 | -name => $cmd, | ||||
793 | -ldelim => $ldelim_orig, -rdelim => $rdelim, | ||||
794 | -file => $file, -line => $line | ||||
795 | ); | ||||
796 | (@seq_stack > 1) and $seq->nested($seq_stack[-1]); | ||||
797 | push @seq_stack, $seq; | ||||
798 | } | ||||
799 | ## Look for sequence ending | ||||
800 | elsif ( @seq_stack > 1 ) { | ||||
801 | ## Make sure we match the right kind of closing delimiter | ||||
802 | my ($seq_end, $post_seq) = ('', ''); | ||||
803 | if ( ($ldelim eq '<' and /\A(.*?)(>)/s) | ||||
804 | or /\A(.*?)(\s+$rdelim)/s ) | ||||
805 | { | ||||
806 | ## Found end-of-sequence, capture the interior and the | ||||
807 | ## closing the delimiter, and put the rest back on the | ||||
808 | ## token-list | ||||
809 | $post_seq = substr($_, length($1) + length($2)); | ||||
810 | ($_, $seq_end) = ($1, $2); | ||||
811 | (length $post_seq) and unshift @tokens, $post_seq; | ||||
812 | } | ||||
813 | if (length) { | ||||
814 | ## In the middle of a sequence, append this text to it, and | ||||
815 | ## dont forget to "expand" it if that's what the caller wanted | ||||
816 | $seq->append($expand_text ? &$xtext_sub($self,$_,$seq) : $_); | ||||
817 | $_ .= $seq_end; | ||||
818 | } | ||||
819 | if (length $seq_end) { | ||||
820 | ## End of current sequence, record terminating delimiter | ||||
821 | $seq->rdelim($seq_end); | ||||
822 | ## Pop it off the stack of "in progress" sequences | ||||
823 | pop @seq_stack; | ||||
824 | ## Append result to its parent in current parse tree | ||||
825 | $seq_stack[-1]->append($expand_seq ? &$xseq_sub($self,$seq) | ||||
826 | : $seq); | ||||
827 | ## Remember the current cmd-name and left-delimiter | ||||
828 | if(@seq_stack > 1) { | ||||
829 | $cmd = $seq_stack[-1]->name; | ||||
830 | $ldelim = $seq_stack[-1]->ldelim; | ||||
831 | $rdelim = $seq_stack[-1]->rdelim; | ||||
832 | } else { | ||||
833 | $cmd = $ldelim = $rdelim = ''; | ||||
834 | } | ||||
835 | } | ||||
836 | } | ||||
837 | elsif (length) { | ||||
838 | ## In the middle of a sequence, append this text to it, and | ||||
839 | ## dont forget to "expand" it if that's what the caller wanted | ||||
840 | $seq->append($expand_text ? &$xtext_sub($self,$_,$seq) : $_); | ||||
841 | } | ||||
842 | ## Keep track of line count | ||||
843 | $line += s/\r*\n//; | ||||
844 | ## Remember the "current" sequence | ||||
845 | $seq = $seq_stack[-1]; | ||||
846 | } | ||||
847 | |||||
848 | ## Handle unterminated sequences | ||||
849 | my $errorsub = (@seq_stack > 1) ? $self->errorsub() : undef; | ||||
850 | while (@seq_stack > 1) { | ||||
851 | ($cmd, $file, $line) = ($seq->name, $seq->file_line); | ||||
852 | $ldelim = $seq->ldelim; | ||||
853 | ($rdelim = $ldelim) =~ tr/</>/; | ||||
854 | $rdelim =~ s/^(\S+)(\s*)$/$2$1/; | ||||
855 | pop @seq_stack; | ||||
856 | my $errmsg = "*** ERROR: unterminated ${cmd}${ldelim}...${rdelim}". | ||||
857 | " at line $line in file $file\n"; | ||||
858 | (ref $errorsub) and &{$errorsub}($errmsg) | ||||
859 | or (defined $errorsub) and $self->$errorsub($errmsg) | ||||
860 | or carp($errmsg); | ||||
861 | $seq_stack[-1]->append($expand_seq ? &$xseq_sub($self,$seq) : $seq); | ||||
862 | $seq = $seq_stack[-1]; | ||||
863 | } | ||||
864 | |||||
865 | ## Return the resulting parse-tree | ||||
866 | my $ptree = (pop @seq_stack)->parse_tree; | ||||
867 | return $expand_ptree ? &$xptree_sub($self, $ptree) : $ptree; | ||||
868 | } | ||||
869 | |||||
870 | ##--------------------------------------------------------------------------- | ||||
871 | |||||
872 | =head1 B<interpolate()> | ||||
873 | |||||
874 | $textblock = $parser->interpolate($text, $line_num); | ||||
875 | |||||
876 | This method translates all text (including any embedded interior sequences) | ||||
877 | in the given text string C<$text> and returns the interpolated result. The | ||||
878 | parameter C<$line_num> is the line number corresponding to the beginning | ||||
879 | of C<$text>. | ||||
880 | |||||
881 | B<interpolate()> merely invokes a private method to recursively expand | ||||
882 | nested interior sequences in bottom-up order (innermost sequences are | ||||
883 | expanded first). If there is a need to expand nested sequences in | ||||
884 | some alternate order, use B<parse_text> instead. | ||||
885 | |||||
886 | =cut | ||||
887 | |||||
888 | sub interpolate { | ||||
889 | my($self, $text, $line_num) = @_; | ||||
890 | my %parse_opts = ( -expand_seq => 'interior_sequence' ); | ||||
891 | my $ptree = $self->parse_text( \%parse_opts, $text, $line_num ); | ||||
892 | return join '', $ptree->children(); | ||||
893 | } | ||||
894 | |||||
895 | ##--------------------------------------------------------------------------- | ||||
896 | |||||
897 | =begin __PRIVATE__ | ||||
898 | |||||
899 | =head1 B<parse_paragraph()> | ||||
900 | |||||
901 | $parser->parse_paragraph($text, $line_num); | ||||
902 | |||||
903 | This method takes the text of a POD paragraph to be processed, along | ||||
904 | with its corresponding line number, and invokes the appropriate method | ||||
905 | (one of B<command()>, B<verbatim()>, or B<textblock()>). | ||||
906 | |||||
907 | For performance reasons, this method is invoked directly without any | ||||
908 | dynamic lookup; Hence subclasses may I<not> override it! | ||||
909 | |||||
910 | =end __PRIVATE__ | ||||
911 | |||||
912 | =cut | ||||
913 | |||||
914 | sub parse_paragraph { | ||||
915 | my ($self, $text, $line_num) = @_; | ||||
916 | local *myData = $self; ## alias to avoid deref-ing overhead | ||||
917 | local *myOpts = ($myData{_PARSEOPTS} ||= {}); ## get parse-options | ||||
918 | local $_; | ||||
919 | |||||
920 | ## See if we want to preprocess nonPOD paragraphs as well as POD ones. | ||||
921 | my $wantNonPods = $myOpts{'-want_nonPODs'}; | ||||
922 | |||||
923 | ## Update cutting status | ||||
924 | $myData{_CUTTING} = 0 if $text =~ /^={1,2}\S/; | ||||
925 | |||||
926 | ## Perform any desired preprocessing if we wanted it this early | ||||
927 | $wantNonPods and $text = $self->preprocess_paragraph($text, $line_num); | ||||
928 | |||||
929 | ## Ignore up until next POD directive if we are cutting | ||||
930 | return if $myData{_CUTTING}; | ||||
931 | |||||
932 | ## Now we know this is block of text in a POD section! | ||||
933 | |||||
934 | ##----------------------------------------------------------------- | ||||
935 | ## This is a hook (hack ;-) for Pod::Select to do its thing without | ||||
936 | ## having to override methods, but also without Pod::Parser assuming | ||||
937 | ## $self is an instance of Pod::Select (if the _SELECTED_SECTIONS | ||||
938 | ## field exists then we assume there is an is_selected() method for | ||||
939 | ## us to invoke (calling $self->can('is_selected') could verify this | ||||
940 | ## but that is more overhead than I want to incur) | ||||
941 | ##----------------------------------------------------------------- | ||||
942 | |||||
943 | ## Ignore this block if it isnt in one of the selected sections | ||||
944 | if (exists $myData{_SELECTED_SECTIONS}) { | ||||
945 | $self->is_selected($text) or return ($myData{_CUTTING} = 1); | ||||
946 | } | ||||
947 | |||||
948 | ## If we havent already, perform any desired preprocessing and | ||||
949 | ## then re-check the "cutting" state | ||||
950 | unless ($wantNonPods) { | ||||
951 | $text = $self->preprocess_paragraph($text, $line_num); | ||||
952 | return 1 unless ((defined $text) and (length $text)); | ||||
953 | return 1 if ($myData{_CUTTING}); | ||||
954 | } | ||||
955 | |||||
956 | ## Look for one of the three types of paragraphs | ||||
957 | my ($pfx, $cmd, $arg, $sep) = ('', '', '', ''); | ||||
958 | my $pod_para = undef; | ||||
959 | if ($text =~ /^(={1,2})(?=\S)/) { | ||||
960 | ## Looks like a command paragraph. Capture the command prefix used | ||||
961 | ## ("=" or "=="), as well as the command-name, its paragraph text, | ||||
962 | ## and whatever sequence of characters was used to separate them | ||||
963 | $pfx = $1; | ||||
964 | $_ = substr($text, length $pfx); | ||||
965 | ($cmd, $sep, $text) = split /(\s+)/, $_, 2; | ||||
966 | ## If this is a "cut" directive then we dont need to do anything | ||||
967 | ## except return to "cutting" mode. | ||||
968 | if ($cmd eq 'cut') { | ||||
969 | $myData{_CUTTING} = 1; | ||||
970 | return unless $myOpts{'-process_cut_cmd'}; | ||||
971 | } | ||||
972 | } | ||||
973 | ## Save the attributes indicating how the command was specified. | ||||
974 | $pod_para = new Pod::Paragraph( | ||||
975 | -name => $cmd, | ||||
976 | -text => $text, | ||||
977 | -prefix => $pfx, | ||||
978 | -separator => $sep, | ||||
979 | -file => $myData{_INFILE}, | ||||
980 | -line => $line_num | ||||
981 | ); | ||||
982 | # ## Invoke appropriate callbacks | ||||
983 | # if (exists $myData{_CALLBACKS}) { | ||||
984 | # ## Look through the callback list, invoke callbacks, | ||||
985 | # ## then see if we need to do the default actions | ||||
986 | # ## (invoke_callbacks will return true if we do). | ||||
987 | # return 1 unless $self->invoke_callbacks($cmd, $text, $line_num, $pod_para); | ||||
988 | # } | ||||
989 | |||||
990 | # If the last paragraph ended in whitespace, and we're not between verbatim blocks, carp | ||||
991 | if ($myData{_WHITESPACE} and $myOpts{'-warnings'} | ||||
992 | and not ($text =~ /^\s+/ and ($myData{_PREVIOUS}||"") eq "verbatim")) { | ||||
993 | my $errorsub = $self->errorsub(); | ||||
994 | my $line = $line_num - 1; | ||||
995 | my $errmsg = "*** WARNING: line containing nothing but whitespace". | ||||
996 | " in paragraph at line $line in file $myData{_INFILE}\n"; | ||||
997 | (ref $errorsub) and &{$errorsub}($errmsg) | ||||
998 | or (defined $errorsub) and $self->$errorsub($errmsg) | ||||
999 | or carp($errmsg); | ||||
1000 | } | ||||
1001 | |||||
1002 | if (length $cmd) { | ||||
1003 | ## A command paragraph | ||||
1004 | $self->command($cmd, $text, $line_num, $pod_para); | ||||
1005 | $myData{_PREVIOUS} = $cmd; | ||||
1006 | } | ||||
1007 | elsif ($text =~ /^\s+/) { | ||||
1008 | ## Indented text - must be a verbatim paragraph | ||||
1009 | $self->verbatim($text, $line_num, $pod_para); | ||||
1010 | $myData{_PREVIOUS} = "verbatim"; | ||||
1011 | } | ||||
1012 | else { | ||||
1013 | ## Looks like an ordinary block of text | ||||
1014 | $self->textblock($text, $line_num, $pod_para); | ||||
1015 | $myData{_PREVIOUS} = "textblock"; | ||||
1016 | } | ||||
1017 | |||||
1018 | # Update the whitespace for the next time around | ||||
1019 | $myData{_WHITESPACE} = $text =~ /^[^\S\r\n]+\Z/m ? 1 : 0; | ||||
1020 | |||||
1021 | return 1; | ||||
1022 | } | ||||
1023 | |||||
1024 | ##--------------------------------------------------------------------------- | ||||
1025 | |||||
1026 | =head1 B<parse_from_filehandle()> | ||||
1027 | |||||
1028 | $parser->parse_from_filehandle($in_fh,$out_fh); | ||||
1029 | |||||
1030 | This method takes an input filehandle (which is assumed to already be | ||||
1031 | opened for reading) and reads the entire input stream looking for blocks | ||||
1032 | (paragraphs) of POD documentation to be processed. If no first argument | ||||
1033 | is given the default input filehandle C<STDIN> is used. | ||||
1034 | |||||
1035 | The C<$in_fh> parameter may be any object that provides a B<getline()> | ||||
1036 | method to retrieve a single line of input text (hence, an appropriate | ||||
1037 | wrapper object could be used to parse PODs from a single string or an | ||||
1038 | array of strings). | ||||
1039 | |||||
1040 | Using C<$in_fh-E<gt>getline()>, input is read line-by-line and assembled | ||||
1041 | into paragraphs or "blocks" (which are separated by lines containing | ||||
1042 | nothing but whitespace). For each block of POD documentation | ||||
1043 | encountered it will invoke a method to parse the given paragraph. | ||||
1044 | |||||
1045 | If a second argument is given then it should correspond to a filehandle where | ||||
1046 | output should be sent (otherwise the default output filehandle is | ||||
1047 | C<STDOUT> if no output filehandle is currently in use). | ||||
1048 | |||||
1049 | B<NOTE:> For performance reasons, this method caches the input stream at | ||||
1050 | the top of the stack in a local variable. Any attempts by clients to | ||||
1051 | change the stack contents during processing when in the midst executing | ||||
1052 | of this method I<will not affect> the input stream used by the current | ||||
1053 | invocation of this method. | ||||
1054 | |||||
1055 | This method does I<not> usually need to be overridden by subclasses. | ||||
1056 | |||||
1057 | =cut | ||||
1058 | |||||
1059 | sub parse_from_filehandle { | ||||
1060 | my $self = shift; | ||||
1061 | my %opts = (ref $_[0] eq 'HASH') ? %{ shift() } : (); | ||||
1062 | my ($in_fh, $out_fh) = @_; | ||||
1063 | $in_fh = \*STDIN unless ($in_fh); | ||||
1064 | local *myData = $self; ## alias to avoid deref-ing overhead | ||||
1065 | local *myOpts = ($myData{_PARSEOPTS} ||= {}); ## get parse-options | ||||
1066 | local $_; | ||||
1067 | |||||
1068 | ## Put this stream at the top of the stack and do beginning-of-input | ||||
1069 | ## processing. NOTE that $in_fh might be reset during this process. | ||||
1070 | my $topstream = $self->_push_input_stream($in_fh, $out_fh); | ||||
1071 | (exists $opts{-cutting}) and $self->cutting( $opts{-cutting} ); | ||||
1072 | |||||
1073 | ## Initialize line/paragraph | ||||
1074 | my ($textline, $paragraph) = ('', ''); | ||||
1075 | my ($nlines, $plines) = (0, 0); | ||||
1076 | |||||
1077 | ## Use <$fh> instead of $fh->getline where possible (for speed) | ||||
1078 | $_ = ref $in_fh; | ||||
1079 | my $tied_fh = (/^(?:GLOB|FileHandle|IO::\w+)$/ or tied $in_fh); | ||||
1080 | |||||
1081 | ## Read paragraphs line-by-line | ||||
1082 | while (defined ($textline = $tied_fh ? <$in_fh> : $in_fh->getline)) { | ||||
1083 | $textline = $self->preprocess_line($textline, ++$nlines); | ||||
1084 | next unless ((defined $textline) && (length $textline)); | ||||
1085 | |||||
1086 | if ((! length $paragraph) && ($textline =~ /^==/)) { | ||||
1087 | ## '==' denotes a one-line command paragraph | ||||
1088 | $paragraph = $textline; | ||||
1089 | $plines = 1; | ||||
1090 | $textline = ''; | ||||
1091 | } else { | ||||
1092 | ## Append this line to the current paragraph | ||||
1093 | $paragraph .= $textline; | ||||
1094 | ++$plines; | ||||
1095 | } | ||||
1096 | |||||
1097 | ## See if this line is blank and ends the current paragraph. | ||||
1098 | ## If it isnt, then keep iterating until it is. | ||||
1099 | next unless (($textline =~ /^([^\S\r\n]*)[\r\n]*$/) | ||||
1100 | && (length $paragraph)); | ||||
1101 | |||||
1102 | ## Now process the paragraph | ||||
1103 | parse_paragraph($self, $paragraph, ($nlines - $plines) + 1); | ||||
1104 | $paragraph = ''; | ||||
1105 | $plines = 0; | ||||
1106 | } | ||||
1107 | ## Dont forget about the last paragraph in the file | ||||
1108 | if (length $paragraph) { | ||||
1109 | parse_paragraph($self, $paragraph, ($nlines - $plines) + 1) | ||||
1110 | } | ||||
1111 | |||||
1112 | ## Now pop the input stream off the top of the input stack. | ||||
1113 | $self->_pop_input_stream(); | ||||
1114 | } | ||||
1115 | |||||
1116 | ##--------------------------------------------------------------------------- | ||||
1117 | |||||
1118 | =head1 B<parse_from_file()> | ||||
1119 | |||||
1120 | $parser->parse_from_file($filename,$outfile); | ||||
1121 | |||||
1122 | This method takes a filename and does the following: | ||||
1123 | |||||
1124 | =over 2 | ||||
1125 | |||||
1126 | =item * | ||||
1127 | |||||
1128 | opens the input and output files for reading | ||||
1129 | (creating the appropriate filehandles) | ||||
1130 | |||||
1131 | =item * | ||||
1132 | |||||
1133 | invokes the B<parse_from_filehandle()> method passing it the | ||||
1134 | corresponding input and output filehandles. | ||||
1135 | |||||
1136 | =item * | ||||
1137 | |||||
1138 | closes the input and output files. | ||||
1139 | |||||
1140 | =back | ||||
1141 | |||||
1142 | If the special input filename "-" or "<&STDIN" is given then the STDIN | ||||
1143 | filehandle is used for input (and no open or close is performed). If no | ||||
1144 | input filename is specified then "-" is implied. Filehandle references, | ||||
1145 | or objects that support the regular IO operations (like C<E<lt>$fhE<gt>> | ||||
1146 | or C<$fh-<Egt>getline>) are also accepted; the handles must already be | ||||
1147 | opened. | ||||
1148 | |||||
1149 | If a second argument is given then it should be the name of the desired | ||||
1150 | output file. If the special output filename "-" or ">&STDOUT" is given | ||||
1151 | then the STDOUT filehandle is used for output (and no open or close is | ||||
1152 | performed). If the special output filename ">&STDERR" is given then the | ||||
1153 | STDERR filehandle is used for output (and no open or close is | ||||
1154 | performed). If no output filehandle is currently in use and no output | ||||
1155 | filename is specified, then "-" is implied. | ||||
1156 | Alternatively, filehandle references or objects that support the regular | ||||
1157 | IO operations (like C<print>, e.g. L<IO::String>) are also accepted; | ||||
1158 | the object must already be opened. | ||||
1159 | |||||
1160 | This method does I<not> usually need to be overridden by subclasses. | ||||
1161 | |||||
1162 | =cut | ||||
1163 | |||||
1164 | sub parse_from_file { | ||||
1165 | my $self = shift; | ||||
1166 | my %opts = (ref $_[0] eq 'HASH') ? %{ shift() } : (); | ||||
1167 | my ($infile, $outfile) = @_; | ||||
1168 | my ($in_fh, $out_fh); | ||||
1169 | if ($] < 5.006) { | ||||
1170 | ($in_fh, $out_fh) = (gensym(), gensym()); | ||||
1171 | } | ||||
1172 | my ($close_input, $close_output) = (0, 0); | ||||
1173 | local *myData = $self; | ||||
1174 | local *_; | ||||
1175 | |||||
1176 | ## Is $infile a filename or a (possibly implied) filehandle | ||||
1177 | if (defined $infile && ref $infile) { | ||||
1178 | if (ref($infile) =~ /^(SCALAR|ARRAY|HASH|CODE|REF)$/) { | ||||
1179 | croak "Input from $1 reference not supported!\n"; | ||||
1180 | } | ||||
1181 | ## Must be a filehandle-ref (or else assume its a ref to an object | ||||
1182 | ## that supports the common IO read operations). | ||||
1183 | $myData{_INFILE} = ${$infile}; | ||||
1184 | $in_fh = $infile; | ||||
1185 | } | ||||
1186 | elsif (!defined($infile) || !length($infile) || ($infile eq '-') | ||||
1187 | || ($infile =~ /^<&(?:STDIN|0)$/i)) | ||||
1188 | { | ||||
1189 | ## Not a filename, just a string implying STDIN | ||||
1190 | $infile ||= '-'; | ||||
1191 | $myData{_INFILE} = '<standard input>'; | ||||
1192 | $in_fh = \*STDIN; | ||||
1193 | } | ||||
1194 | else { | ||||
1195 | ## We have a filename, open it for reading | ||||
1196 | $myData{_INFILE} = $infile; | ||||
1197 | open($in_fh, "< $infile") or | ||||
1198 | croak "Can't open $infile for reading: $!\n"; | ||||
1199 | $close_input = 1; | ||||
1200 | } | ||||
1201 | |||||
1202 | ## NOTE: we need to be *very* careful when "defaulting" the output | ||||
1203 | ## file. We only want to use a default if this is the beginning of | ||||
1204 | ## the entire document (but *not* if this is an included file). We | ||||
1205 | ## determine this by seeing if the input stream stack has been set-up | ||||
1206 | ## already | ||||
1207 | |||||
1208 | ## Is $outfile a filename, a (possibly implied) filehandle, maybe a ref? | ||||
1209 | if (ref $outfile) { | ||||
1210 | ## we need to check for ref() first, as other checks involve reading | ||||
1211 | if (ref($outfile) =~ /^(ARRAY|HASH|CODE)$/) { | ||||
1212 | croak "Output to $1 reference not supported!\n"; | ||||
1213 | } | ||||
1214 | elsif (ref($outfile) eq 'SCALAR') { | ||||
1215 | # # NOTE: IO::String isn't a part of the perl distribution, | ||||
1216 | # # so probably we shouldn't support this case... | ||||
1217 | # require IO::String; | ||||
1218 | # $myData{_OUTFILE} = "$outfile"; | ||||
1219 | # $out_fh = IO::String->new($outfile); | ||||
1220 | croak "Output to SCALAR reference not supported!\n"; | ||||
1221 | } | ||||
1222 | else { | ||||
1223 | ## Must be a filehandle-ref (or else assume its a ref to an | ||||
1224 | ## object that supports the common IO write operations). | ||||
1225 | $myData{_OUTFILE} = ${$outfile}; | ||||
1226 | $out_fh = $outfile; | ||||
1227 | } | ||||
1228 | } | ||||
1229 | elsif (!defined($outfile) || !length($outfile) || ($outfile eq '-') | ||||
1230 | || ($outfile =~ /^>&?(?:STDOUT|1)$/i)) | ||||
1231 | { | ||||
1232 | if (defined $myData{_TOP_STREAM}) { | ||||
1233 | $out_fh = $myData{_OUTPUT}; | ||||
1234 | } | ||||
1235 | else { | ||||
1236 | ## Not a filename, just a string implying STDOUT | ||||
1237 | $outfile ||= '-'; | ||||
1238 | $myData{_OUTFILE} = '<standard output>'; | ||||
1239 | $out_fh = \*STDOUT; | ||||
1240 | } | ||||
1241 | } | ||||
1242 | elsif ($outfile =~ /^>&(STDERR|2)$/i) { | ||||
1243 | ## Not a filename, just a string implying STDERR | ||||
1244 | $myData{_OUTFILE} = '<standard error>'; | ||||
1245 | $out_fh = \*STDERR; | ||||
1246 | } | ||||
1247 | else { | ||||
1248 | ## We have a filename, open it for writing | ||||
1249 | $myData{_OUTFILE} = $outfile; | ||||
1250 | (-d $outfile) and croak "$outfile is a directory, not POD input!\n"; | ||||
1251 | open($out_fh, "> $outfile") or | ||||
1252 | croak "Can't open $outfile for writing: $!\n"; | ||||
1253 | $close_output = 1; | ||||
1254 | } | ||||
1255 | |||||
1256 | ## Whew! That was a lot of work to set up reasonably/robust behavior | ||||
1257 | ## in the case of a non-filename for reading and writing. Now we just | ||||
1258 | ## have to parse the input and close the handles when we're finished. | ||||
1259 | $self->parse_from_filehandle(\%opts, $in_fh, $out_fh); | ||||
1260 | |||||
1261 | $close_input and | ||||
1262 | close($in_fh) || croak "Can't close $infile after reading: $!\n"; | ||||
1263 | $close_output and | ||||
1264 | close($out_fh) || croak "Can't close $outfile after writing: $!\n"; | ||||
1265 | } | ||||
1266 | |||||
1267 | ############################################################################# | ||||
1268 | |||||
1269 | =head1 ACCESSOR METHODS | ||||
1270 | |||||
1271 | Clients of B<Pod::Parser> should use the following methods to access | ||||
1272 | instance data fields: | ||||
1273 | |||||
1274 | =cut | ||||
1275 | |||||
1276 | ##--------------------------------------------------------------------------- | ||||
1277 | |||||
1278 | =head1 B<errorsub()> | ||||
1279 | |||||
1280 | $parser->errorsub("method_name"); | ||||
1281 | $parser->errorsub(\&warn_user); | ||||
1282 | $parser->errorsub(sub { print STDERR, @_ }); | ||||
1283 | |||||
1284 | Specifies the method or subroutine to use when printing error messages | ||||
1285 | about POD syntax. The supplied method/subroutine I<must> return TRUE upon | ||||
1286 | successful printing of the message. If C<undef> is given, then the B<carp> | ||||
1287 | builtin is used to issue error messages (this is the default behavior). | ||||
1288 | |||||
1289 | my $errorsub = $parser->errorsub() | ||||
1290 | my $errmsg = "This is an error message!\n" | ||||
1291 | (ref $errorsub) and &{$errorsub}($errmsg) | ||||
1292 | or (defined $errorsub) and $parser->$errorsub($errmsg) | ||||
1293 | or carp($errmsg); | ||||
1294 | |||||
1295 | Returns a method name, or else a reference to the user-supplied subroutine | ||||
1296 | used to print error messages. Returns C<undef> if the B<carp> builtin | ||||
1297 | is used to issue error messages (this is the default behavior). | ||||
1298 | |||||
1299 | =cut | ||||
1300 | |||||
1301 | sub errorsub { | ||||
1302 | return (@_ > 1) ? ($_[0]->{_ERRORSUB} = $_[1]) : $_[0]->{_ERRORSUB}; | ||||
1303 | } | ||||
1304 | |||||
1305 | ##--------------------------------------------------------------------------- | ||||
1306 | |||||
1307 | =head1 B<cutting()> | ||||
1308 | |||||
1309 | $boolean = $parser->cutting(); | ||||
1310 | |||||
1311 | Returns the current C<cutting> state: a boolean-valued scalar which | ||||
1312 | evaluates to true if text from the input file is currently being "cut" | ||||
1313 | (meaning it is I<not> considered part of the POD document). | ||||
1314 | |||||
1315 | $parser->cutting($boolean); | ||||
1316 | |||||
1317 | Sets the current C<cutting> state to the given value and returns the | ||||
1318 | result. | ||||
1319 | |||||
1320 | =cut | ||||
1321 | |||||
1322 | sub cutting { | ||||
1323 | return (@_ > 1) ? ($_[0]->{_CUTTING} = $_[1]) : $_[0]->{_CUTTING}; | ||||
1324 | } | ||||
1325 | |||||
1326 | ##--------------------------------------------------------------------------- | ||||
1327 | |||||
1328 | ##--------------------------------------------------------------------------- | ||||
1329 | |||||
1330 | =head1 B<parseopts()> | ||||
1331 | |||||
1332 | When invoked with no additional arguments, B<parseopts> returns a hashtable | ||||
1333 | of all the current parsing options. | ||||
1334 | |||||
1335 | ## See if we are parsing non-POD sections as well as POD ones | ||||
1336 | my %opts = $parser->parseopts(); | ||||
1337 | $opts{'-want_nonPODs}' and print "-want_nonPODs\n"; | ||||
1338 | |||||
1339 | When invoked using a single string, B<parseopts> treats the string as the | ||||
1340 | name of a parse-option and returns its corresponding value if it exists | ||||
1341 | (returns C<undef> if it doesn't). | ||||
1342 | |||||
1343 | ## Did we ask to see '=cut' paragraphs? | ||||
1344 | my $want_cut = $parser->parseopts('-process_cut_cmd'); | ||||
1345 | $want_cut and print "-process_cut_cmd\n"; | ||||
1346 | |||||
1347 | When invoked with multiple arguments, B<parseopts> treats them as | ||||
1348 | key/value pairs and the specified parse-option names are set to the | ||||
1349 | given values. Any unspecified parse-options are unaffected. | ||||
1350 | |||||
1351 | ## Set them back to the default | ||||
1352 | $parser->parseopts(-warnings => 0); | ||||
1353 | |||||
1354 | When passed a single hash-ref, B<parseopts> uses that hash to completely | ||||
1355 | reset the existing parse-options, all previous parse-option values | ||||
1356 | are lost. | ||||
1357 | |||||
1358 | ## Reset all options to default | ||||
1359 | $parser->parseopts( { } ); | ||||
1360 | |||||
1361 | See L<"PARSING OPTIONS"> for more information on the name and meaning of each | ||||
1362 | parse-option currently recognized. | ||||
1363 | |||||
1364 | =cut | ||||
1365 | |||||
1366 | sub parseopts { | ||||
1367 | local *myData = shift; | ||||
1368 | local *myOpts = ($myData{_PARSEOPTS} ||= {}); | ||||
1369 | return %myOpts if (@_ == 0); | ||||
1370 | if (@_ == 1) { | ||||
1371 | local $_ = shift; | ||||
1372 | return ref($_) ? $myData{_PARSEOPTS} = $_ : $myOpts{$_}; | ||||
1373 | } | ||||
1374 | my @newOpts = (%myOpts, @_); | ||||
1375 | $myData{_PARSEOPTS} = { @newOpts }; | ||||
1376 | } | ||||
1377 | |||||
1378 | ##--------------------------------------------------------------------------- | ||||
1379 | |||||
1380 | =head1 B<output_file()> | ||||
1381 | |||||
1382 | $fname = $parser->output_file(); | ||||
1383 | |||||
1384 | Returns the name of the output file being written. | ||||
1385 | |||||
1386 | =cut | ||||
1387 | |||||
1388 | sub output_file { | ||||
1389 | return $_[0]->{_OUTFILE}; | ||||
1390 | } | ||||
1391 | |||||
1392 | ##--------------------------------------------------------------------------- | ||||
1393 | |||||
1394 | =head1 B<output_handle()> | ||||
1395 | |||||
1396 | $fhandle = $parser->output_handle(); | ||||
1397 | |||||
1398 | Returns the output filehandle object. | ||||
1399 | |||||
1400 | =cut | ||||
1401 | |||||
1402 | sub output_handle { | ||||
1403 | return $_[0]->{_OUTPUT}; | ||||
1404 | } | ||||
1405 | |||||
1406 | ##--------------------------------------------------------------------------- | ||||
1407 | |||||
1408 | =head1 B<input_file()> | ||||
1409 | |||||
1410 | $fname = $parser->input_file(); | ||||
1411 | |||||
1412 | Returns the name of the input file being read. | ||||
1413 | |||||
1414 | =cut | ||||
1415 | |||||
1416 | sub input_file { | ||||
1417 | return $_[0]->{_INFILE}; | ||||
1418 | } | ||||
1419 | |||||
1420 | ##--------------------------------------------------------------------------- | ||||
1421 | |||||
1422 | =head1 B<input_handle()> | ||||
1423 | |||||
1424 | $fhandle = $parser->input_handle(); | ||||
1425 | |||||
1426 | Returns the current input filehandle object. | ||||
1427 | |||||
1428 | =cut | ||||
1429 | |||||
1430 | sub input_handle { | ||||
1431 | return $_[0]->{_INPUT}; | ||||
1432 | } | ||||
1433 | |||||
1434 | ##--------------------------------------------------------------------------- | ||||
1435 | |||||
1436 | =begin __PRIVATE__ | ||||
1437 | |||||
1438 | =head1 B<input_streams()> | ||||
1439 | |||||
1440 | $listref = $parser->input_streams(); | ||||
1441 | |||||
1442 | Returns a reference to an array which corresponds to the stack of all | ||||
1443 | the input streams that are currently in the middle of being parsed. | ||||
1444 | |||||
1445 | While parsing an input stream, it is possible to invoke | ||||
1446 | B<parse_from_file()> or B<parse_from_filehandle()> to parse a new input | ||||
1447 | stream and then return to parsing the previous input stream. Each input | ||||
1448 | stream to be parsed is pushed onto the end of this input stack | ||||
1449 | before any of its input is read. The input stream that is currently | ||||
1450 | being parsed is always at the end (or top) of the input stack. When an | ||||
1451 | input stream has been exhausted, it is popped off the end of the | ||||
1452 | input stack. | ||||
1453 | |||||
1454 | Each element on this input stack is a reference to C<Pod::InputSource> | ||||
1455 | object. Please see L<Pod::InputObjects> for more details. | ||||
1456 | |||||
1457 | This method might be invoked when printing diagnostic messages, for example, | ||||
1458 | to obtain the name and line number of the all input files that are currently | ||||
1459 | being processed. | ||||
1460 | |||||
1461 | =end __PRIVATE__ | ||||
1462 | |||||
1463 | =cut | ||||
1464 | |||||
1465 | sub input_streams { | ||||
1466 | return $_[0]->{_INPUT_STREAMS}; | ||||
1467 | } | ||||
1468 | |||||
1469 | ##--------------------------------------------------------------------------- | ||||
1470 | |||||
1471 | =begin __PRIVATE__ | ||||
1472 | |||||
1473 | =head1 B<top_stream()> | ||||
1474 | |||||
1475 | $hashref = $parser->top_stream(); | ||||
1476 | |||||
1477 | Returns a reference to the hash-table that represents the element | ||||
1478 | that is currently at the top (end) of the input stream stack | ||||
1479 | (see L<"input_streams()">). The return value will be the C<undef> | ||||
1480 | if the input stack is empty. | ||||
1481 | |||||
1482 | This method might be used when printing diagnostic messages, for example, | ||||
1483 | to obtain the name and line number of the current input file. | ||||
1484 | |||||
1485 | =end __PRIVATE__ | ||||
1486 | |||||
1487 | =cut | ||||
1488 | |||||
1489 | sub top_stream { | ||||
1490 | return $_[0]->{_TOP_STREAM} || undef; | ||||
1491 | } | ||||
1492 | |||||
1493 | ############################################################################# | ||||
1494 | |||||
1495 | =head1 PRIVATE METHODS AND DATA | ||||
1496 | |||||
1497 | B<Pod::Parser> makes use of several internal methods and data fields | ||||
1498 | which clients should not need to see or use. For the sake of avoiding | ||||
1499 | name collisions for client data and methods, these methods and fields | ||||
1500 | are briefly discussed here. Determined hackers may obtain further | ||||
1501 | information about them by reading the B<Pod::Parser> source code. | ||||
1502 | |||||
1503 | Private data fields are stored in the hash-object whose reference is | ||||
1504 | returned by the B<new()> constructor for this class. The names of all | ||||
1505 | private methods and data-fields used by B<Pod::Parser> begin with a | ||||
1506 | prefix of "_" and match the regular expression C</^_\w+$/>. | ||||
1507 | |||||
1508 | =cut | ||||
1509 | |||||
1510 | ##--------------------------------------------------------------------------- | ||||
1511 | |||||
1512 | =begin _PRIVATE_ | ||||
1513 | |||||
1514 | =head1 B<_push_input_stream()> | ||||
1515 | |||||
1516 | $hashref = $parser->_push_input_stream($in_fh,$out_fh); | ||||
1517 | |||||
1518 | This method will push the given input stream on the input stack and | ||||
1519 | perform any necessary beginning-of-document or beginning-of-file | ||||
1520 | processing. The argument C<$in_fh> is the input stream filehandle to | ||||
1521 | push, and C<$out_fh> is the corresponding output filehandle to use (if | ||||
1522 | it is not given or is undefined, then the current output stream is used, | ||||
1523 | which defaults to standard output if it doesnt exist yet). | ||||
1524 | |||||
1525 | The value returned will be reference to the hash-table that represents | ||||
1526 | the new top of the input stream stack. I<Please Note> that it is | ||||
1527 | possible for this method to use default values for the input and output | ||||
1528 | file handles. If this happens, you will need to look at the C<INPUT> | ||||
1529 | and C<OUTPUT> instance data members to determine their new values. | ||||
1530 | |||||
1531 | =end _PRIVATE_ | ||||
1532 | |||||
1533 | =cut | ||||
1534 | |||||
1535 | sub _push_input_stream { | ||||
1536 | my ($self, $in_fh, $out_fh) = @_; | ||||
1537 | local *myData = $self; | ||||
1538 | |||||
1539 | ## Initialize stuff for the entire document if this is *not* | ||||
1540 | ## an included file. | ||||
1541 | ## | ||||
1542 | ## NOTE: we need to be *very* careful when "defaulting" the output | ||||
1543 | ## filehandle. We only want to use a default value if this is the | ||||
1544 | ## beginning of the entire document (but *not* if this is an included | ||||
1545 | ## file). | ||||
1546 | unless (defined $myData{_TOP_STREAM}) { | ||||
1547 | $out_fh = \*STDOUT unless (defined $out_fh); | ||||
1548 | $myData{_CUTTING} = 1; ## current "cutting" state | ||||
1549 | $myData{_INPUT_STREAMS} = []; ## stack of all input streams | ||||
1550 | } | ||||
1551 | |||||
1552 | ## Initialize input indicators | ||||
1553 | $myData{_OUTFILE} = '(unknown)' unless (defined $myData{_OUTFILE}); | ||||
1554 | $myData{_OUTPUT} = $out_fh if (defined $out_fh); | ||||
1555 | $in_fh = \*STDIN unless (defined $in_fh); | ||||
1556 | $myData{_INFILE} = '(unknown)' unless (defined $myData{_INFILE}); | ||||
1557 | $myData{_INPUT} = $in_fh; | ||||
1558 | my $input_top = $myData{_TOP_STREAM} | ||||
1559 | = new Pod::InputSource( | ||||
1560 | -name => $myData{_INFILE}, | ||||
1561 | -handle => $in_fh, | ||||
1562 | -was_cutting => $myData{_CUTTING} | ||||
1563 | ); | ||||
1564 | local *input_stack = $myData{_INPUT_STREAMS}; | ||||
1565 | push(@input_stack, $input_top); | ||||
1566 | |||||
1567 | ## Perform beginning-of-document and/or beginning-of-input processing | ||||
1568 | $self->begin_pod() if (@input_stack == 1); | ||||
1569 | $self->begin_input(); | ||||
1570 | |||||
1571 | return $input_top; | ||||
1572 | } | ||||
1573 | |||||
1574 | ##--------------------------------------------------------------------------- | ||||
1575 | |||||
1576 | =begin _PRIVATE_ | ||||
1577 | |||||
1578 | =head1 B<_pop_input_stream()> | ||||
1579 | |||||
1580 | $hashref = $parser->_pop_input_stream(); | ||||
1581 | |||||
1582 | This takes no arguments. It will perform any necessary end-of-file or | ||||
1583 | end-of-document processing and then pop the current input stream from | ||||
1584 | the top of the input stack. | ||||
1585 | |||||
1586 | The value returned will be reference to the hash-table that represents | ||||
1587 | the new top of the input stream stack. | ||||
1588 | |||||
1589 | =end _PRIVATE_ | ||||
1590 | |||||
1591 | =cut | ||||
1592 | |||||
1593 | sub _pop_input_stream { | ||||
1594 | my ($self) = @_; | ||||
1595 | local *myData = $self; | ||||
1596 | local *input_stack = $myData{_INPUT_STREAMS}; | ||||
1597 | |||||
1598 | ## Perform end-of-input and/or end-of-document processing | ||||
1599 | $self->end_input() if (@input_stack > 0); | ||||
1600 | $self->end_pod() if (@input_stack == 1); | ||||
1601 | |||||
1602 | ## Restore cutting state to whatever it was before we started | ||||
1603 | ## parsing this file. | ||||
1604 | my $old_top = pop(@input_stack); | ||||
1605 | $myData{_CUTTING} = $old_top->was_cutting(); | ||||
1606 | |||||
1607 | ## Dont forget to reset the input indicators | ||||
1608 | my $input_top = undef; | ||||
1609 | if (@input_stack > 0) { | ||||
1610 | $input_top = $myData{_TOP_STREAM} = $input_stack[-1]; | ||||
1611 | $myData{_INFILE} = $input_top->name(); | ||||
1612 | $myData{_INPUT} = $input_top->handle(); | ||||
1613 | } else { | ||||
1614 | delete $myData{_TOP_STREAM}; | ||||
1615 | delete $myData{_INPUT_STREAMS}; | ||||
1616 | } | ||||
1617 | |||||
1618 | return $input_top; | ||||
1619 | } | ||||
1620 | |||||
1621 | ############################################################################# | ||||
1622 | |||||
1623 | =head1 TREE-BASED PARSING | ||||
1624 | |||||
1625 | If straightforward stream-based parsing wont meet your needs (as is | ||||
1626 | likely the case for tasks such as translating PODs into structured | ||||
1627 | markup languages like HTML and XML) then you may need to take the | ||||
1628 | tree-based approach. Rather than doing everything in one pass and | ||||
1629 | calling the B<interpolate()> method to expand sequences into text, it | ||||
1630 | may be desirable to instead create a parse-tree using the B<parse_text()> | ||||
1631 | method to return a tree-like structure which may contain an ordered | ||||
1632 | list of children (each of which may be a text-string, or a similar | ||||
1633 | tree-like structure). | ||||
1634 | |||||
1635 | Pay special attention to L<"METHODS FOR PARSING AND PROCESSING"> and | ||||
1636 | to the objects described in L<Pod::InputObjects>. The former describes | ||||
1637 | the gory details and parameters for how to customize and extend the | ||||
1638 | parsing behavior of B<Pod::Parser>. B<Pod::InputObjects> provides | ||||
1639 | several objects that may all be used interchangeably as parse-trees. The | ||||
1640 | most obvious one is the B<Pod::ParseTree> object. It defines the basic | ||||
1641 | interface and functionality that all things trying to be a POD parse-tree | ||||
1642 | should do. A B<Pod::ParseTree> is defined such that each "node" may be a | ||||
1643 | text-string, or a reference to another parse-tree. Each B<Pod::Paragraph> | ||||
1644 | object and each B<Pod::InteriorSequence> object also supports the basic | ||||
1645 | parse-tree interface. | ||||
1646 | |||||
1647 | The B<parse_text()> method takes a given paragraph of text, and | ||||
1648 | returns a parse-tree that contains one or more children, each of which | ||||
1649 | may be a text-string, or an InteriorSequence object. There are also | ||||
1650 | callback-options that may be passed to B<parse_text()> to customize | ||||
1651 | the way it expands or transforms interior-sequences, as well as the | ||||
1652 | returned result. These callbacks can be used to create a parse-tree | ||||
1653 | with custom-made objects (which may or may not support the parse-tree | ||||
1654 | interface, depending on how you choose to do it). | ||||
1655 | |||||
1656 | If you wish to turn an entire POD document into a parse-tree, that process | ||||
1657 | is fairly straightforward. The B<parse_text()> method is the key to doing | ||||
1658 | this successfully. Every paragraph-callback (i.e. the polymorphic methods | ||||
1659 | for B<command()>, B<verbatim()>, and B<textblock()> paragraphs) takes | ||||
1660 | a B<Pod::Paragraph> object as an argument. Each paragraph object has a | ||||
1661 | B<parse_tree()> method that can be used to get or set a corresponding | ||||
1662 | parse-tree. So for each of those paragraph-callback methods, simply call | ||||
1663 | B<parse_text()> with the options you desire, and then use the returned | ||||
1664 | parse-tree to assign to the given paragraph object. | ||||
1665 | |||||
1666 | That gives you a parse-tree for each paragraph - so now all you need is | ||||
1667 | an ordered list of paragraphs. You can maintain that yourself as a data | ||||
1668 | element in the object/hash. The most straightforward way would be simply | ||||
1669 | to use an array-ref, with the desired set of custom "options" for each | ||||
1670 | invocation of B<parse_text>. Let's assume the desired option-set is | ||||
1671 | given by the hash C<%options>. Then we might do something like the | ||||
1672 | following: | ||||
1673 | |||||
1674 | package MyPodParserTree; | ||||
1675 | |||||
1676 | @ISA = qw( Pod::Parser ); | ||||
1677 | |||||
1678 | ... | ||||
1679 | |||||
1680 | sub begin_pod { | ||||
1681 | my $self = shift; | ||||
1682 | $self->{'-paragraphs'} = []; ## initialize paragraph list | ||||
1683 | } | ||||
1684 | |||||
1685 | sub command { | ||||
1686 | my ($parser, $command, $paragraph, $line_num, $pod_para) = @_; | ||||
1687 | my $ptree = $parser->parse_text({%options}, $paragraph, ...); | ||||
1688 | $pod_para->parse_tree( $ptree ); | ||||
1689 | push @{ $self->{'-paragraphs'} }, $pod_para; | ||||
1690 | } | ||||
1691 | |||||
1692 | sub verbatim { | ||||
1693 | my ($parser, $paragraph, $line_num, $pod_para) = @_; | ||||
1694 | push @{ $self->{'-paragraphs'} }, $pod_para; | ||||
1695 | } | ||||
1696 | |||||
1697 | sub textblock { | ||||
1698 | my ($parser, $paragraph, $line_num, $pod_para) = @_; | ||||
1699 | my $ptree = $parser->parse_text({%options}, $paragraph, ...); | ||||
1700 | $pod_para->parse_tree( $ptree ); | ||||
1701 | push @{ $self->{'-paragraphs'} }, $pod_para; | ||||
1702 | } | ||||
1703 | |||||
1704 | ... | ||||
1705 | |||||
1706 | package main; | ||||
1707 | ... | ||||
1708 | my $parser = new MyPodParserTree(...); | ||||
1709 | $parser->parse_from_file(...); | ||||
1710 | my $paragraphs_ref = $parser->{'-paragraphs'}; | ||||
1711 | |||||
1712 | Of course, in this module-author's humble opinion, I'd be more inclined to | ||||
1713 | use the existing B<Pod::ParseTree> object than a simple array. That way | ||||
1714 | everything in it, paragraphs and sequences, all respond to the same core | ||||
1715 | interface for all parse-tree nodes. The result would look something like: | ||||
1716 | |||||
1717 | package MyPodParserTree2; | ||||
1718 | |||||
1719 | ... | ||||
1720 | |||||
1721 | sub begin_pod { | ||||
1722 | my $self = shift; | ||||
1723 | $self->{'-ptree'} = new Pod::ParseTree; ## initialize parse-tree | ||||
1724 | } | ||||
1725 | |||||
1726 | sub parse_tree { | ||||
1727 | ## convenience method to get/set the parse-tree for the entire POD | ||||
1728 | (@_ > 1) and $_[0]->{'-ptree'} = $_[1]; | ||||
1729 | return $_[0]->{'-ptree'}; | ||||
1730 | } | ||||
1731 | |||||
1732 | sub command { | ||||
1733 | my ($parser, $command, $paragraph, $line_num, $pod_para) = @_; | ||||
1734 | my $ptree = $parser->parse_text({<<options>>}, $paragraph, ...); | ||||
1735 | $pod_para->parse_tree( $ptree ); | ||||
1736 | $parser->parse_tree()->append( $pod_para ); | ||||
1737 | } | ||||
1738 | |||||
1739 | sub verbatim { | ||||
1740 | my ($parser, $paragraph, $line_num, $pod_para) = @_; | ||||
1741 | $parser->parse_tree()->append( $pod_para ); | ||||
1742 | } | ||||
1743 | |||||
1744 | sub textblock { | ||||
1745 | my ($parser, $paragraph, $line_num, $pod_para) = @_; | ||||
1746 | my $ptree = $parser->parse_text({<<options>>}, $paragraph, ...); | ||||
1747 | $pod_para->parse_tree( $ptree ); | ||||
1748 | $parser->parse_tree()->append( $pod_para ); | ||||
1749 | } | ||||
1750 | |||||
1751 | ... | ||||
1752 | |||||
1753 | package main; | ||||
1754 | ... | ||||
1755 | my $parser = new MyPodParserTree2(...); | ||||
1756 | $parser->parse_from_file(...); | ||||
1757 | my $ptree = $parser->parse_tree; | ||||
1758 | ... | ||||
1759 | |||||
1760 | Now you have the entire POD document as one great big parse-tree. You | ||||
1761 | can even use the B<-expand_seq> option to B<parse_text> to insert | ||||
1762 | whole different kinds of objects. Just don't expect B<Pod::Parser> | ||||
1763 | to know what to do with them after that. That will need to be in your | ||||
1764 | code. Or, alternatively, you can insert any object you like so long as | ||||
1765 | it conforms to the B<Pod::ParseTree> interface. | ||||
1766 | |||||
1767 | One could use this to create subclasses of B<Pod::Paragraphs> and | ||||
1768 | B<Pod::InteriorSequences> for specific commands (or to create your own | ||||
1769 | custom node-types in the parse-tree) and add some kind of B<emit()> | ||||
1770 | method to each custom node/subclass object in the tree. Then all you'd | ||||
1771 | need to do is recursively walk the tree in the desired order, processing | ||||
1772 | the children (most likely from left to right) by formatting them if | ||||
1773 | they are text-strings, or by calling their B<emit()> method if they | ||||
1774 | are objects/references. | ||||
1775 | |||||
1776 | =head1 CAVEATS | ||||
1777 | |||||
1778 | Please note that POD has the notion of "paragraphs": this is something | ||||
1779 | starting I<after> a blank (read: empty) line, with the single exception | ||||
1780 | of the file start, which is also starting a paragraph. That means that | ||||
1781 | especially a command (e.g. C<=head1>) I<must> be preceded with a blank | ||||
1782 | line; C<__END__> is I<not> a blank line. | ||||
1783 | |||||
1784 | =head1 SEE ALSO | ||||
1785 | |||||
1786 | L<Pod::InputObjects>, L<Pod::Select> | ||||
1787 | |||||
1788 | B<Pod::InputObjects> defines POD input objects corresponding to | ||||
1789 | command paragraphs, parse-trees, and interior-sequences. | ||||
1790 | |||||
1791 | B<Pod::Select> is a subclass of B<Pod::Parser> which provides the ability | ||||
1792 | to selectively include and/or exclude sections of a POD document from being | ||||
1793 | translated based upon the current heading, subheading, subsubheading, etc. | ||||
1794 | |||||
1795 | =for __PRIVATE__ | ||||
1796 | B<Pod::Callbacks> is a subclass of B<Pod::Parser> which gives its users | ||||
1797 | the ability the employ I<callback functions> instead of, or in addition | ||||
1798 | to, overriding methods of the base class. | ||||
1799 | |||||
1800 | =for __PRIVATE__ | ||||
1801 | B<Pod::Select> and B<Pod::Callbacks> do not override any | ||||
1802 | methods nor do they define any new methods with the same name. Because | ||||
1803 | of this, they may I<both> be used (in combination) as a base class of | ||||
1804 | the same subclass in order to combine their functionality without | ||||
1805 | causing any namespace clashes due to multiple inheritance. | ||||
1806 | |||||
1807 | =head1 AUTHOR | ||||
1808 | |||||
1809 | Please report bugs using L<http://rt.cpan.org>. | ||||
1810 | |||||
1811 | Brad Appleton E<lt>bradapp@enteract.comE<gt> | ||||
1812 | |||||
1813 | Based on code for B<Pod::Text> written by | ||||
1814 | Tom Christiansen E<lt>tchrist@mox.perl.comE<gt> | ||||
1815 | |||||
1816 | =head1 LICENSE | ||||
1817 | |||||
1818 | Pod-Parser is free software; you can redistribute it and/or modify it | ||||
1819 | under the terms of the Artistic License distributed with Perl version | ||||
1820 | 5.000 or (at your option) any later version. Please refer to the | ||||
1821 | Artistic License that came with your Perl distribution for more | ||||
1822 | details. If your version of Perl was not distributed under the | ||||
1823 | terms of the Artistic License, than you may distribute PodParser | ||||
1824 | under the same terms as Perl itself. | ||||
1825 | |||||
1826 | =cut | ||||
1827 | |||||
1828 | 1 | 21µs | 1; | ||
1829 | # vim: ts=4 sw=4 et |