Commit | Line | Data |
---|---|---|
920dae64 AT |
1 | ############################################################################# |
2 | # Pod/Select.pm -- function to select portions of 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::Select; | |
11 | ||
12 | use vars qw($VERSION); | |
13 | $VERSION = 1.30; ## Current version of this package | |
14 | require 5.005; ## requires this Perl version or later | |
15 | ||
16 | ############################################################################# | |
17 | ||
18 | =head1 NAME | |
19 | ||
20 | Pod::Select, podselect() - extract selected sections of POD from input | |
21 | ||
22 | =head1 SYNOPSIS | |
23 | ||
24 | use Pod::Select; | |
25 | ||
26 | ## Select all the POD sections for each file in @filelist | |
27 | ## and print the result on standard output. | |
28 | podselect(@filelist); | |
29 | ||
30 | ## Same as above, but write to tmp.out | |
31 | podselect({-output => "tmp.out"}, @filelist): | |
32 | ||
33 | ## Select from the given filelist, only those POD sections that are | |
34 | ## within a 1st level section named any of: NAME, SYNOPSIS, OPTIONS. | |
35 | podselect({-sections => ["NAME|SYNOPSIS", "OPTIONS"]}, @filelist): | |
36 | ||
37 | ## Select the "DESCRIPTION" section of the PODs from STDIN and write | |
38 | ## the result to STDERR. | |
39 | podselect({-output => ">&STDERR", -sections => ["DESCRIPTION"]}, \*STDIN); | |
40 | ||
41 | or | |
42 | ||
43 | use Pod::Select; | |
44 | ||
45 | ## Create a parser object for selecting POD sections from the input | |
46 | $parser = new Pod::Select(); | |
47 | ||
48 | ## Select all the POD sections for each file in @filelist | |
49 | ## and print the result to tmp.out. | |
50 | $parser->parse_from_file("<&STDIN", "tmp.out"); | |
51 | ||
52 | ## Select from the given filelist, only those POD sections that are | |
53 | ## within a 1st level section named any of: NAME, SYNOPSIS, OPTIONS. | |
54 | $parser->select("NAME|SYNOPSIS", "OPTIONS"); | |
55 | for (@filelist) { $parser->parse_from_file($_); } | |
56 | ||
57 | ## Select the "DESCRIPTION" and "SEE ALSO" sections of the PODs from | |
58 | ## STDIN and write the result to STDERR. | |
59 | $parser->select("DESCRIPTION"); | |
60 | $parser->add_selection("SEE ALSO"); | |
61 | $parser->parse_from_filehandle(\*STDIN, \*STDERR); | |
62 | ||
63 | =head1 REQUIRES | |
64 | ||
65 | perl5.005, Pod::Parser, Exporter, Carp | |
66 | ||
67 | =head1 EXPORTS | |
68 | ||
69 | podselect() | |
70 | ||
71 | =head1 DESCRIPTION | |
72 | ||
73 | B<podselect()> is a function which will extract specified sections of | |
74 | pod documentation from an input stream. This ability is provided by the | |
75 | B<Pod::Select> module which is a subclass of B<Pod::Parser>. | |
76 | B<Pod::Select> provides a method named B<select()> to specify the set of | |
77 | POD sections to select for processing/printing. B<podselect()> merely | |
78 | creates a B<Pod::Select> object and then invokes the B<podselect()> | |
79 | followed by B<parse_from_file()>. | |
80 | ||
81 | =head1 SECTION SPECIFICATIONS | |
82 | ||
83 | B<podselect()> and B<Pod::Select::select()> may be given one or more | |
84 | "section specifications" to restrict the text processed to only the | |
85 | desired set of sections and their corresponding subsections. A section | |
86 | specification is a string containing one or more Perl-style regular | |
87 | expressions separated by forward slashes ("/"). If you need to use a | |
88 | forward slash literally within a section title you can escape it with a | |
89 | backslash ("\/"). | |
90 | ||
91 | The formal syntax of a section specification is: | |
92 | ||
93 | =over 4 | |
94 | ||
95 | =item * | |
96 | ||
97 | I<head1-title-regex>/I<head2-title-regex>/... | |
98 | ||
99 | =back | |
100 | ||
101 | Any omitted or empty regular expressions will default to ".*". | |
102 | Please note that each regular expression given is implicitly | |
103 | anchored by adding "^" and "$" to the beginning and end. Also, if a | |
104 | given regular expression starts with a "!" character, then the | |
105 | expression is I<negated> (so C<!foo> would match anything I<except> | |
106 | C<foo>). | |
107 | ||
108 | Some example section specifications follow. | |
109 | ||
110 | =over 4 | |
111 | ||
112 | =item * | |
113 | ||
114 | Match the C<NAME> and C<SYNOPSIS> sections and all of their subsections: | |
115 | ||
116 | C<NAME|SYNOPSIS> | |
117 | ||
118 | =item * | |
119 | ||
120 | Match only the C<Question> and C<Answer> subsections of the C<DESCRIPTION> | |
121 | section: | |
122 | ||
123 | C<DESCRIPTION/Question|Answer> | |
124 | ||
125 | =item * | |
126 | ||
127 | Match the C<Comments> subsection of I<all> sections: | |
128 | ||
129 | C</Comments> | |
130 | ||
131 | =item * | |
132 | ||
133 | Match all subsections of C<DESCRIPTION> I<except> for C<Comments>: | |
134 | ||
135 | C<DESCRIPTION/!Comments> | |
136 | ||
137 | =item * | |
138 | ||
139 | Match the C<DESCRIPTION> section but do I<not> match any of its subsections: | |
140 | ||
141 | C<DESCRIPTION/!.+> | |
142 | ||
143 | =item * | |
144 | ||
145 | Match all top level sections but none of their subsections: | |
146 | ||
147 | C</!.+> | |
148 | ||
149 | =back | |
150 | ||
151 | =begin _NOT_IMPLEMENTED_ | |
152 | ||
153 | =head1 RANGE SPECIFICATIONS | |
154 | ||
155 | B<podselect()> and B<Pod::Select::select()> may be given one or more | |
156 | "range specifications" to restrict the text processed to only the | |
157 | desired ranges of paragraphs in the desired set of sections. A range | |
158 | specification is a string containing a single Perl-style regular | |
159 | expression (a regex), or else two Perl-style regular expressions | |
160 | (regexs) separated by a ".." (Perl's "range" operator is ".."). | |
161 | The regexs in a range specification are delimited by forward slashes | |
162 | ("/"). If you need to use a forward slash literally within a regex you | |
163 | can escape it with a backslash ("\/"). | |
164 | ||
165 | The formal syntax of a range specification is: | |
166 | ||
167 | =over 4 | |
168 | ||
169 | =item * | |
170 | ||
171 | /I<start-range-regex>/[../I<end-range-regex>/] | |
172 | ||
173 | =back | |
174 | ||
175 | Where each the item inside square brackets (the ".." followed by the | |
176 | end-range-regex) is optional. Each "range-regex" is of the form: | |
177 | ||
178 | =cmd-expr text-expr | |
179 | ||
180 | Where I<cmd-expr> is intended to match the name of one or more POD | |
181 | commands, and I<text-expr> is intended to match the paragraph text for | |
182 | the command. If a range-regex is supposed to match a POD command, then | |
183 | the first character of the regex (the one after the initial '/') | |
184 | absolutely I<must> be a single '=' character; it may not be anything | |
185 | else (not even a regex meta-character) if it is supposed to match | |
186 | against the name of a POD command. | |
187 | ||
188 | If no I<=cmd-expr> is given then the text-expr will be matched against | |
189 | plain textblocks unless it is preceded by a space, in which case it is | |
190 | matched against verbatim text-blocks. If no I<text-expr> is given then | |
191 | only the command-portion of the paragraph is matched against. | |
192 | ||
193 | Note that these two expressions are each implicitly anchored. This | |
194 | means that when matching against the command-name, there will be an | |
195 | implicit '^' and '$' around the given I<=cmd-expr>; and when matching | |
196 | against the paragraph text there will be an implicit '\A' and '\Z' | |
197 | around the given I<text-expr>. | |
198 | ||
199 | Unlike with section-specs, the '!' character does I<not> have any special | |
200 | meaning (negation or otherwise) at the beginning of a range-spec! | |
201 | ||
202 | Some example range specifications follow. | |
203 | ||
204 | =over 4 | |
205 | ||
206 | =item | |
207 | Match all C<=for html> paragraphs: | |
208 | ||
209 | C</=for html/> | |
210 | ||
211 | =item | |
212 | Match all paragraphs between C<=begin html> and C<=end html> | |
213 | (note that this will I<not> work correctly if such sections | |
214 | are nested): | |
215 | ||
216 | C</=begin html/../=end html/> | |
217 | ||
218 | =item | |
219 | Match all paragraphs between the given C<=item> name until the end of the | |
220 | current section: | |
221 | ||
222 | C</=item mine/../=head\d/> | |
223 | ||
224 | =item | |
225 | Match all paragraphs between the given C<=item> until the next item, or | |
226 | until the end of the itemized list (note that this will I<not> work as | |
227 | desired if the item contains an itemized list nested within it): | |
228 | ||
229 | C</=item mine/../=(item|back)/> | |
230 | ||
231 | =back | |
232 | ||
233 | =end _NOT_IMPLEMENTED_ | |
234 | ||
235 | =cut | |
236 | ||
237 | ############################################################################# | |
238 | ||
239 | use strict; | |
240 | #use diagnostics; | |
241 | use Carp; | |
242 | use Pod::Parser 1.04; | |
243 | use vars qw(@ISA @EXPORT $MAX_HEADING_LEVEL); | |
244 | ||
245 | @ISA = qw(Pod::Parser); | |
246 | @EXPORT = qw(&podselect); | |
247 | ||
248 | ## Maximum number of heading levels supported for '=headN' directives | |
249 | *MAX_HEADING_LEVEL = \3; | |
250 | ||
251 | ############################################################################# | |
252 | ||
253 | =head1 OBJECT METHODS | |
254 | ||
255 | The following methods are provided in this module. Each one takes a | |
256 | reference to the object itself as an implicit first parameter. | |
257 | ||
258 | =cut | |
259 | ||
260 | ##--------------------------------------------------------------------------- | |
261 | ||
262 | ## =begin _PRIVATE_ | |
263 | ## | |
264 | ## =head1 B<_init_headings()> | |
265 | ## | |
266 | ## Initialize the current set of active section headings. | |
267 | ## | |
268 | ## =cut | |
269 | ## | |
270 | ## =end _PRIVATE_ | |
271 | ||
272 | use vars qw(%myData @section_headings); | |
273 | ||
274 | sub _init_headings { | |
275 | my $self = shift; | |
276 | local *myData = $self; | |
277 | ||
278 | ## Initialize current section heading titles if necessary | |
279 | unless (defined $myData{_SECTION_HEADINGS}) { | |
280 | local *section_headings = $myData{_SECTION_HEADINGS} = []; | |
281 | for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) { | |
282 | $section_headings[$i] = ''; | |
283 | } | |
284 | } | |
285 | } | |
286 | ||
287 | ##--------------------------------------------------------------------------- | |
288 | ||
289 | =head1 B<curr_headings()> | |
290 | ||
291 | ($head1, $head2, $head3, ...) = $parser->curr_headings(); | |
292 | $head1 = $parser->curr_headings(1); | |
293 | ||
294 | This method returns a list of the currently active section headings and | |
295 | subheadings in the document being parsed. The list of headings returned | |
296 | corresponds to the most recently parsed paragraph of the input. | |
297 | ||
298 | If an argument is given, it must correspond to the desired section | |
299 | heading number, in which case only the specified section heading is | |
300 | returned. If there is no current section heading at the specified | |
301 | level, then C<undef> is returned. | |
302 | ||
303 | =cut | |
304 | ||
305 | sub curr_headings { | |
306 | my $self = shift; | |
307 | $self->_init_headings() unless (defined $self->{_SECTION_HEADINGS}); | |
308 | my @headings = @{ $self->{_SECTION_HEADINGS} }; | |
309 | return (@_ > 0 and $_[0] =~ /^\d+$/) ? $headings[$_[0] - 1] : @headings; | |
310 | } | |
311 | ||
312 | ##--------------------------------------------------------------------------- | |
313 | ||
314 | =head1 B<select()> | |
315 | ||
316 | $parser->select($section_spec1,$section_spec2,...); | |
317 | ||
318 | This method is used to select the particular sections and subsections of | |
319 | POD documentation that are to be printed and/or processed. The existing | |
320 | set of selected sections is I<replaced> with the given set of sections. | |
321 | See B<add_selection()> for adding to the current set of selected | |
322 | sections. | |
323 | ||
324 | Each of the C<$section_spec> arguments should be a section specification | |
325 | as described in L<"SECTION SPECIFICATIONS">. The section specifications | |
326 | are parsed by this method and the resulting regular expressions are | |
327 | stored in the invoking object. | |
328 | ||
329 | If no C<$section_spec> arguments are given, then the existing set of | |
330 | selected sections is cleared out (which means C<all> sections will be | |
331 | processed). | |
332 | ||
333 | This method should I<not> normally be overridden by subclasses. | |
334 | ||
335 | =cut | |
336 | ||
337 | use vars qw(@selected_sections); | |
338 | ||
339 | sub select { | |
340 | my $self = shift; | |
341 | my @sections = @_; | |
342 | local *myData = $self; | |
343 | local $_; | |
344 | ||
345 | ### NEED TO DISCERN A SECTION-SPEC FROM A RANGE-SPEC (look for m{^/.+/$}?) | |
346 | ||
347 | ##--------------------------------------------------------------------- | |
348 | ## The following is a blatant hack for backward compatibility, and for | |
349 | ## implementing add_selection(). If the *first* *argument* is the | |
350 | ## string "+", then the remaining section specifications are *added* | |
351 | ## to the current set of selections; otherwise the given section | |
352 | ## specifications will *replace* the current set of selections. | |
353 | ## | |
354 | ## This should probably be fixed someday, but for the present time, | |
355 | ## it seems incredibly unlikely that "+" would ever correspond to | |
356 | ## a legitimate section heading | |
357 | ##--------------------------------------------------------------------- | |
358 | my $add = ($sections[0] eq "+") ? shift(@sections) : ""; | |
359 | ||
360 | ## Reset the set of sections to use | |
361 | unless (@sections > 0) { | |
362 | delete $myData{_SELECTED_SECTIONS} unless ($add); | |
363 | return; | |
364 | } | |
365 | $myData{_SELECTED_SECTIONS} = [] | |
366 | unless ($add && exists $myData{_SELECTED_SECTIONS}); | |
367 | local *selected_sections = $myData{_SELECTED_SECTIONS}; | |
368 | ||
369 | ## Compile each spec | |
370 | my $spec; | |
371 | for $spec (@sections) { | |
372 | if ( defined($_ = &_compile_section_spec($spec)) ) { | |
373 | ## Store them in our sections array | |
374 | push(@selected_sections, $_); | |
375 | } | |
376 | else { | |
377 | carp "Ignoring section spec \"$spec\"!\n"; | |
378 | } | |
379 | } | |
380 | } | |
381 | ||
382 | ##--------------------------------------------------------------------------- | |
383 | ||
384 | =head1 B<add_selection()> | |
385 | ||
386 | $parser->add_selection($section_spec1,$section_spec2,...); | |
387 | ||
388 | This method is used to add to the currently selected sections and | |
389 | subsections of POD documentation that are to be printed and/or | |
390 | processed. See <select()> for replacing the currently selected sections. | |
391 | ||
392 | Each of the C<$section_spec> arguments should be a section specification | |
393 | as described in L<"SECTION SPECIFICATIONS">. The section specifications | |
394 | are parsed by this method and the resulting regular expressions are | |
395 | stored in the invoking object. | |
396 | ||
397 | This method should I<not> normally be overridden by subclasses. | |
398 | ||
399 | =cut | |
400 | ||
401 | sub add_selection { | |
402 | my $self = shift; | |
403 | $self->select("+", @_); | |
404 | } | |
405 | ||
406 | ##--------------------------------------------------------------------------- | |
407 | ||
408 | =head1 B<clear_selections()> | |
409 | ||
410 | $parser->clear_selections(); | |
411 | ||
412 | This method takes no arguments, it has the exact same effect as invoking | |
413 | <select()> with no arguments. | |
414 | ||
415 | =cut | |
416 | ||
417 | sub clear_selections { | |
418 | my $self = shift; | |
419 | $self->select(); | |
420 | } | |
421 | ||
422 | ##--------------------------------------------------------------------------- | |
423 | ||
424 | =head1 B<match_section()> | |
425 | ||
426 | $boolean = $parser->match_section($heading1,$heading2,...); | |
427 | ||
428 | Returns a value of true if the given section and subsection heading | |
429 | titles match any of the currently selected section specifications in | |
430 | effect from prior calls to B<select()> and B<add_selection()> (or if | |
431 | there are no explictly selected/deselected sections). | |
432 | ||
433 | The arguments C<$heading1>, C<$heading2>, etc. are the heading titles of | |
434 | the corresponding sections, subsections, etc. to try and match. If | |
435 | C<$headingN> is omitted then it defaults to the current corresponding | |
436 | section heading title in the input. | |
437 | ||
438 | This method should I<not> normally be overridden by subclasses. | |
439 | ||
440 | =cut | |
441 | ||
442 | sub match_section { | |
443 | my $self = shift; | |
444 | my (@headings) = @_; | |
445 | local *myData = $self; | |
446 | ||
447 | ## Return true if no restrictions were explicitly specified | |
448 | my $selections = (exists $myData{_SELECTED_SECTIONS}) | |
449 | ? $myData{_SELECTED_SECTIONS} : undef; | |
450 | return 1 unless ((defined $selections) && (@{$selections} > 0)); | |
451 | ||
452 | ## Default any unspecified sections to the current one | |
453 | my @current_headings = $self->curr_headings(); | |
454 | for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) { | |
455 | (defined $headings[$i]) or $headings[$i] = $current_headings[$i]; | |
456 | } | |
457 | ||
458 | ## Look for a match against the specified section expressions | |
459 | my ($section_spec, $regex, $negated, $match); | |
460 | for $section_spec ( @{$selections} ) { | |
461 | ##------------------------------------------------------ | |
462 | ## Each portion of this spec must match in order for | |
463 | ## the spec to be matched. So we will start with a | |
464 | ## match-value of 'true' and logically 'and' it with | |
465 | ## the results of matching a given element of the spec. | |
466 | ##------------------------------------------------------ | |
467 | $match = 1; | |
468 | for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) { | |
469 | $regex = $section_spec->[$i]; | |
470 | $negated = ($regex =~ s/^\!//); | |
471 | $match &= ($negated ? ($headings[$i] !~ /${regex}/) | |
472 | : ($headings[$i] =~ /${regex}/)); | |
473 | last unless ($match); | |
474 | } | |
475 | return 1 if ($match); | |
476 | } | |
477 | return 0; ## no match | |
478 | } | |
479 | ||
480 | ##--------------------------------------------------------------------------- | |
481 | ||
482 | =head1 B<is_selected()> | |
483 | ||
484 | $boolean = $parser->is_selected($paragraph); | |
485 | ||
486 | This method is used to determine if the block of text given in | |
487 | C<$paragraph> falls within the currently selected set of POD sections | |
488 | and subsections to be printed or processed. This method is also | |
489 | responsible for keeping track of the current input section and | |
490 | subsections. It is assumed that C<$paragraph> is the most recently read | |
491 | (but not yet processed) input paragraph. | |
492 | ||
493 | The value returned will be true if the C<$paragraph> and the rest of the | |
494 | text in the same section as C<$paragraph> should be selected (included) | |
495 | for processing; otherwise a false value is returned. | |
496 | ||
497 | =cut | |
498 | ||
499 | sub is_selected { | |
500 | my ($self, $paragraph) = @_; | |
501 | local $_; | |
502 | local *myData = $self; | |
503 | ||
504 | $self->_init_headings() unless (defined $myData{_SECTION_HEADINGS}); | |
505 | ||
506 | ## Keep track of current sections levels and headings | |
507 | $_ = $paragraph; | |
508 | if (/^=((?:sub)*)(?:head(?:ing)?|sec(?:tion)?)(\d*)\s+(.*)\s*$/) | |
509 | { | |
510 | ## This is a section heading command | |
511 | my ($level, $heading) = ($2, $3); | |
512 | $level = 1 + (length($1) / 3) if ((! length $level) || (length $1)); | |
513 | ## Reset the current section heading at this level | |
514 | $myData{_SECTION_HEADINGS}->[$level - 1] = $heading; | |
515 | ## Reset subsection headings of this one to empty | |
516 | for (my $i = $level; $i < $MAX_HEADING_LEVEL; ++$i) { | |
517 | $myData{_SECTION_HEADINGS}->[$i] = ''; | |
518 | } | |
519 | } | |
520 | ||
521 | return $self->match_section(); | |
522 | } | |
523 | ||
524 | ############################################################################# | |
525 | ||
526 | =head1 EXPORTED FUNCTIONS | |
527 | ||
528 | The following functions are exported by this module. Please note that | |
529 | these are functions (not methods) and therefore C<do not> take an | |
530 | implicit first argument. | |
531 | ||
532 | =cut | |
533 | ||
534 | ##--------------------------------------------------------------------------- | |
535 | ||
536 | =head1 B<podselect()> | |
537 | ||
538 | podselect(\%options,@filelist); | |
539 | ||
540 | B<podselect> will print the raw (untranslated) POD paragraphs of all | |
541 | POD sections in the given input files specified by C<@filelist> | |
542 | according to the given options. | |
543 | ||
544 | If any argument to B<podselect> is a reference to a hash | |
545 | (associative array) then the values with the following keys are | |
546 | processed as follows: | |
547 | ||
548 | =over 4 | |
549 | ||
550 | =item B<-output> | |
551 | ||
552 | A string corresponding to the desired output file (or ">&STDOUT" | |
553 | or ">&STDERR"). The default is to use standard output. | |
554 | ||
555 | =item B<-sections> | |
556 | ||
557 | A reference to an array of sections specifications (as described in | |
558 | L<"SECTION SPECIFICATIONS">) which indicate the desired set of POD | |
559 | sections and subsections to be selected from input. If no section | |
560 | specifications are given, then all sections of the PODs are used. | |
561 | ||
562 | =begin _NOT_IMPLEMENTED_ | |
563 | ||
564 | =item B<-ranges> | |
565 | ||
566 | A reference to an array of range specifications (as described in | |
567 | L<"RANGE SPECIFICATIONS">) which indicate the desired range of POD | |
568 | paragraphs to be selected from the desired input sections. If no range | |
569 | specifications are given, then all paragraphs of the desired sections | |
570 | are used. | |
571 | ||
572 | =end _NOT_IMPLEMENTED_ | |
573 | ||
574 | =back | |
575 | ||
576 | All other arguments should correspond to the names of input files | |
577 | containing POD sections. A file name of "-" or "<&STDIN" will | |
578 | be interpeted to mean standard input (which is the default if no | |
579 | filenames are given). | |
580 | ||
581 | =cut | |
582 | ||
583 | sub podselect { | |
584 | my(@argv) = @_; | |
585 | my %defaults = (); | |
586 | my $pod_parser = new Pod::Select(%defaults); | |
587 | my $num_inputs = 0; | |
588 | my $output = ">&STDOUT"; | |
589 | my %opts; | |
590 | local $_; | |
591 | for (@argv) { | |
592 | if (ref($_)) { | |
593 | next unless (ref($_) eq 'HASH'); | |
594 | %opts = (%defaults, %{$_}); | |
595 | ||
596 | ##------------------------------------------------------------- | |
597 | ## Need this for backward compatibility since we formerly used | |
598 | ## options that were all uppercase words rather than ones that | |
599 | ## looked like Unix command-line options. | |
600 | ## to be uppercase keywords) | |
601 | ##------------------------------------------------------------- | |
602 | %opts = map { | |
603 | my ($key, $val) = (lc $_, $opts{$_}); | |
604 | $key =~ s/^(?=\w)/-/; | |
605 | $key =~ /^-se[cl]/ and $key = '-sections'; | |
606 | #! $key eq '-range' and $key .= 's'; | |
607 | ($key => $val); | |
608 | } (keys %opts); | |
609 | ||
610 | ## Process the options | |
611 | (exists $opts{'-output'}) and $output = $opts{'-output'}; | |
612 | ||
613 | ## Select the desired sections | |
614 | $pod_parser->select(@{ $opts{'-sections'} }) | |
615 | if ( (defined $opts{'-sections'}) | |
616 | && ((ref $opts{'-sections'}) eq 'ARRAY') ); | |
617 | ||
618 | #! ## Select the desired paragraph ranges | |
619 | #! $pod_parser->select(@{ $opts{'-ranges'} }) | |
620 | #! if ( (defined $opts{'-ranges'}) | |
621 | #! && ((ref $opts{'-ranges'}) eq 'ARRAY') ); | |
622 | } | |
623 | else { | |
624 | $pod_parser->parse_from_file($_, $output); | |
625 | ++$num_inputs; | |
626 | } | |
627 | } | |
628 | $pod_parser->parse_from_file("-") unless ($num_inputs > 0); | |
629 | } | |
630 | ||
631 | ############################################################################# | |
632 | ||
633 | =head1 PRIVATE METHODS AND DATA | |
634 | ||
635 | B<Pod::Select> makes uses a number of internal methods and data fields | |
636 | which clients should not need to see or use. For the sake of avoiding | |
637 | name collisions with client data and methods, these methods and fields | |
638 | are briefly discussed here. Determined hackers may obtain further | |
639 | information about them by reading the B<Pod::Select> source code. | |
640 | ||
641 | Private data fields are stored in the hash-object whose reference is | |
642 | returned by the B<new()> constructor for this class. The names of all | |
643 | private methods and data-fields used by B<Pod::Select> begin with a | |
644 | prefix of "_" and match the regular expression C</^_\w+$/>. | |
645 | ||
646 | =cut | |
647 | ||
648 | ##--------------------------------------------------------------------------- | |
649 | ||
650 | =begin _PRIVATE_ | |
651 | ||
652 | =head1 B<_compile_section_spec()> | |
653 | ||
654 | $listref = $parser->_compile_section_spec($section_spec); | |
655 | ||
656 | This function (note it is a function and I<not> a method) takes a | |
657 | section specification (as described in L<"SECTION SPECIFICATIONS">) | |
658 | given in C<$section_sepc>, and compiles it into a list of regular | |
659 | expressions. If C<$section_spec> has no syntax errors, then a reference | |
660 | to the list (array) of corresponding regular expressions is returned; | |
661 | otherwise C<undef> is returned and an error message is printed (using | |
662 | B<carp>) for each invalid regex. | |
663 | ||
664 | =end _PRIVATE_ | |
665 | ||
666 | =cut | |
667 | ||
668 | sub _compile_section_spec { | |
669 | my ($section_spec) = @_; | |
670 | my (@regexs, $negated); | |
671 | ||
672 | ## Compile the spec into a list of regexs | |
673 | local $_ = $section_spec; | |
674 | s|\\\\|\001|g; ## handle escaped backward slashes | |
675 | s|\\/|\002|g; ## handle escaped forward slashes | |
676 | ||
677 | ## Parse the regexs for the heading titles | |
678 | @regexs = split('/', $_, $MAX_HEADING_LEVEL); | |
679 | ||
680 | ## Set default regex for ommitted levels | |
681 | for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) { | |
682 | $regexs[$i] = '.*' unless ((defined $regexs[$i]) | |
683 | && (length $regexs[$i])); | |
684 | } | |
685 | ## Modify the regexs as needed and validate their syntax | |
686 | my $bad_regexs = 0; | |
687 | for (@regexs) { | |
688 | $_ .= '.+' if ($_ eq '!'); | |
689 | s|\001|\\\\|g; ## restore escaped backward slashes | |
690 | s|\002|\\/|g; ## restore escaped forward slashes | |
691 | $negated = s/^\!//; ## check for negation | |
692 | eval "/$_/"; ## check regex syntax | |
693 | if ($@) { | |
694 | ++$bad_regexs; | |
695 | carp "Bad regular expression /$_/ in \"$section_spec\": $@\n"; | |
696 | } | |
697 | else { | |
698 | ## Add the forward and rear anchors (and put the negator back) | |
699 | $_ = '^' . $_ unless (/^\^/); | |
700 | $_ = $_ . '$' unless (/\$$/); | |
701 | $_ = '!' . $_ if ($negated); | |
702 | } | |
703 | } | |
704 | return (! $bad_regexs) ? [ @regexs ] : undef; | |
705 | } | |
706 | ||
707 | ##--------------------------------------------------------------------------- | |
708 | ||
709 | =begin _PRIVATE_ | |
710 | ||
711 | =head2 $self->{_SECTION_HEADINGS} | |
712 | ||
713 | A reference to an array of the current section heading titles for each | |
714 | heading level (note that the first heading level title is at index 0). | |
715 | ||
716 | =end _PRIVATE_ | |
717 | ||
718 | =cut | |
719 | ||
720 | ##--------------------------------------------------------------------------- | |
721 | ||
722 | =begin _PRIVATE_ | |
723 | ||
724 | =head2 $self->{_SELECTED_SECTIONS} | |
725 | ||
726 | A reference to an array of references to arrays. Each subarray is a list | |
727 | of anchored regular expressions (preceded by a "!" if the expression is to | |
728 | be negated). The index of the expression in the subarray should correspond | |
729 | to the index of the heading title in C<$self-E<gt>{_SECTION_HEADINGS}> | |
730 | that it is to be matched against. | |
731 | ||
732 | =end _PRIVATE_ | |
733 | ||
734 | =cut | |
735 | ||
736 | ############################################################################# | |
737 | ||
738 | =head1 SEE ALSO | |
739 | ||
740 | L<Pod::Parser> | |
741 | ||
742 | =head1 AUTHOR | |
743 | ||
744 | Please report bugs using L<http://rt.cpan.org>. | |
745 | ||
746 | Brad Appleton E<lt>bradapp@enteract.comE<gt> | |
747 | ||
748 | Based on code for B<pod2text> written by | |
749 | Tom Christiansen E<lt>tchrist@mox.perl.comE<gt> | |
750 | ||
751 | =cut | |
752 | ||
753 | 1; | |
754 | # vim: ts=4 sw=4 et |