1 #############################################################################
2 # Pod/Select.pm -- function to select portions of POD docs
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
8 #############################################################################
13 use vars qw($VERSION @ISA @EXPORT $MAX_HEADING_LEVEL %myData @section_headings @selected_sections);
14 $VERSION = '1.36'; ## Current version of this package
15 require 5.005; ## requires this Perl version or later
17 #############################################################################
21 Pod::Select, podselect() - extract selected sections of POD from input
27 ## Select all the POD sections for each file in @filelist
28 ## and print the result on standard output.
31 ## Same as above, but write to tmp.out
32 podselect({-output => "tmp.out"}, @filelist):
34 ## Select from the given filelist, only those POD sections that are
35 ## within a 1st level section named any of: NAME, SYNOPSIS, OPTIONS.
36 podselect({-sections => ["NAME|SYNOPSIS", "OPTIONS"]}, @filelist):
38 ## Select the "DESCRIPTION" section of the PODs from STDIN and write
39 ## the result to STDERR.
40 podselect({-output => ">&STDERR", -sections => ["DESCRIPTION"]}, \*STDIN);
46 ## Create a parser object for selecting POD sections from the input
47 $parser = new Pod::Select();
49 ## Select all the POD sections for each file in @filelist
50 ## and print the result to tmp.out.
51 $parser->parse_from_file("<&STDIN", "tmp.out");
53 ## Select from the given filelist, only those POD sections that are
54 ## within a 1st level section named any of: NAME, SYNOPSIS, OPTIONS.
55 $parser->select("NAME|SYNOPSIS", "OPTIONS");
56 for (@filelist) { $parser->parse_from_file($_); }
58 ## Select the "DESCRIPTION" and "SEE ALSO" sections of the PODs from
59 ## STDIN and write the result to STDERR.
60 $parser->select("DESCRIPTION");
61 $parser->add_selection("SEE ALSO");
62 $parser->parse_from_filehandle(\*STDIN, \*STDERR);
66 perl5.005, Pod::Parser, Exporter, Carp
74 B<podselect()> is a function which will extract specified sections of
75 pod documentation from an input stream. This ability is provided by the
76 B<Pod::Select> module which is a subclass of B<Pod::Parser>.
77 B<Pod::Select> provides a method named B<select()> to specify the set of
78 POD sections to select for processing/printing. B<podselect()> merely
79 creates a B<Pod::Select> object and then invokes the B<podselect()>
80 followed by B<parse_from_file()>.
82 =head1 SECTION SPECIFICATIONS
84 B<podselect()> and B<Pod::Select::select()> may be given one or more
85 "section specifications" to restrict the text processed to only the
86 desired set of sections and their corresponding subsections. A section
87 specification is a string containing one or more Perl-style regular
88 expressions separated by forward slashes ("/"). If you need to use a
89 forward slash literally within a section title you can escape it with a
92 The formal syntax of a section specification is:
98 I<head1-title-regex>/I<head2-title-regex>/...
102 Any omitted or empty regular expressions will default to ".*".
103 Please note that each regular expression given is implicitly
104 anchored by adding "^" and "$" to the beginning and end. Also, if a
105 given regular expression starts with a "!" character, then the
106 expression is I<negated> (so C<!foo> would match anything I<except>
109 Some example section specifications follow.
115 Match the C<NAME> and C<SYNOPSIS> sections and all of their subsections:
121 Match only the C<Question> and C<Answer> subsections of the C<DESCRIPTION>
124 C<DESCRIPTION/Question|Answer>
128 Match the C<Comments> subsection of I<all> sections:
134 Match all subsections of C<DESCRIPTION> I<except> for C<Comments>:
136 C<DESCRIPTION/!Comments>
140 Match the C<DESCRIPTION> section but do I<not> match any of its subsections:
146 Match all top level sections but none of their subsections:
152 =begin _NOT_IMPLEMENTED_
154 =head1 RANGE SPECIFICATIONS
156 B<podselect()> and B<Pod::Select::select()> may be given one or more
157 "range specifications" to restrict the text processed to only the
158 desired ranges of paragraphs in the desired set of sections. A range
159 specification is a string containing a single Perl-style regular
160 expression (a regex), or else two Perl-style regular expressions
161 (regexs) separated by a ".." (Perl's "range" operator is "..").
162 The regexs in a range specification are delimited by forward slashes
163 ("/"). If you need to use a forward slash literally within a regex you
164 can escape it with a backslash ("\/").
166 The formal syntax of a range specification is:
172 /I<start-range-regex>/[../I<end-range-regex>/]
176 Where each the item inside square brackets (the ".." followed by the
177 end-range-regex) is optional. Each "range-regex" is of the form:
181 Where I<cmd-expr> is intended to match the name of one or more POD
182 commands, and I<text-expr> is intended to match the paragraph text for
183 the command. If a range-regex is supposed to match a POD command, then
184 the first character of the regex (the one after the initial '/')
185 absolutely I<must> be a single '=' character; it may not be anything
186 else (not even a regex meta-character) if it is supposed to match
187 against the name of a POD command.
189 If no I<=cmd-expr> is given then the text-expr will be matched against
190 plain textblocks unless it is preceded by a space, in which case it is
191 matched against verbatim text-blocks. If no I<text-expr> is given then
192 only the command-portion of the paragraph is matched against.
194 Note that these two expressions are each implicitly anchored. This
195 means that when matching against the command-name, there will be an
196 implicit '^' and '$' around the given I<=cmd-expr>; and when matching
197 against the paragraph text there will be an implicit '\A' and '\Z'
198 around the given I<text-expr>.
200 Unlike with section-specs, the '!' character does I<not> have any special
201 meaning (negation or otherwise) at the beginning of a range-spec!
203 Some example range specifications follow.
208 Match all C<=for html> paragraphs:
213 Match all paragraphs between C<=begin html> and C<=end html>
214 (note that this will I<not> work correctly if such sections
217 C</=begin html/../=end html/>
220 Match all paragraphs between the given C<=item> name until the end of the
223 C</=item mine/../=head\d/>
226 Match all paragraphs between the given C<=item> until the next item, or
227 until the end of the itemized list (note that this will I<not> work as
228 desired if the item contains an itemized list nested within it):
230 C</=item mine/../=(item|back)/>
234 =end _NOT_IMPLEMENTED_
238 #############################################################################
242 use Pod::Parser 1.04;
244 @ISA = qw(Pod::Parser);
245 @EXPORT = qw(&podselect);
247 ## Maximum number of heading levels supported for '=headN' directives
248 *MAX_HEADING_LEVEL = \3;
250 #############################################################################
252 =head1 OBJECT METHODS
254 The following methods are provided in this module. Each one takes a
255 reference to the object itself as an implicit first parameter.
259 ##---------------------------------------------------------------------------
263 ## =head1 B<_init_headings()>
265 ## Initialize the current set of active section headings.
273 local *myData = $self;
275 ## Initialize current section heading titles if necessary
276 unless (defined $myData{_SECTION_HEADINGS}) {
277 local *section_headings = $myData{_SECTION_HEADINGS} = [];
278 for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) {
279 $section_headings[$i] = '';
284 ##---------------------------------------------------------------------------
286 =head1 B<curr_headings()>
288 ($head1, $head2, $head3, ...) = $parser->curr_headings();
289 $head1 = $parser->curr_headings(1);
291 This method returns a list of the currently active section headings and
292 subheadings in the document being parsed. The list of headings returned
293 corresponds to the most recently parsed paragraph of the input.
295 If an argument is given, it must correspond to the desired section
296 heading number, in which case only the specified section heading is
297 returned. If there is no current section heading at the specified
298 level, then C<undef> is returned.
304 $self->_init_headings() unless (defined $self->{_SECTION_HEADINGS});
305 my @headings = @{ $self->{_SECTION_HEADINGS} };
306 return (@_ > 0 and $_[0] =~ /^\d+$/) ? $headings[$_[0] - 1] : @headings;
309 ##---------------------------------------------------------------------------
313 $parser->select($section_spec1,$section_spec2,...);
315 This method is used to select the particular sections and subsections of
316 POD documentation that are to be printed and/or processed. The existing
317 set of selected sections is I<replaced> with the given set of sections.
318 See B<add_selection()> for adding to the current set of selected
321 Each of the C<$section_spec> arguments should be a section specification
322 as described in L<"SECTION SPECIFICATIONS">. The section specifications
323 are parsed by this method and the resulting regular expressions are
324 stored in the invoking object.
326 If no C<$section_spec> arguments are given, then the existing set of
327 selected sections is cleared out (which means C<all> sections will be
330 This method should I<not> normally be overridden by subclasses.
335 my ($self, @sections) = @_;
336 local *myData = $self;
339 ### NEED TO DISCERN A SECTION-SPEC FROM A RANGE-SPEC (look for m{^/.+/$}?)
341 ##---------------------------------------------------------------------
342 ## The following is a blatant hack for backward compatibility, and for
343 ## implementing add_selection(). If the *first* *argument* is the
344 ## string "+", then the remaining section specifications are *added*
345 ## to the current set of selections; otherwise the given section
346 ## specifications will *replace* the current set of selections.
348 ## This should probably be fixed someday, but for the present time,
349 ## it seems incredibly unlikely that "+" would ever correspond to
350 ## a legitimate section heading
351 ##---------------------------------------------------------------------
352 my $add = ($sections[0] eq '+') ? shift(@sections) : '';
354 ## Reset the set of sections to use
356 delete $myData{_SELECTED_SECTIONS} unless ($add);
359 $myData{_SELECTED_SECTIONS} = []
360 unless ($add && exists $myData{_SELECTED_SECTIONS});
361 local *selected_sections = $myData{_SELECTED_SECTIONS};
364 for my $spec (@sections) {
365 if ( defined($_ = _compile_section_spec($spec)) ) {
366 ## Store them in our sections array
367 push(@selected_sections, $_);
370 carp qq{Ignoring section spec "$spec"!\n};
375 ##---------------------------------------------------------------------------
377 =head1 B<add_selection()>
379 $parser->add_selection($section_spec1,$section_spec2,...);
381 This method is used to add to the currently selected sections and
382 subsections of POD documentation that are to be printed and/or
383 processed. See <select()> for replacing the currently selected sections.
385 Each of the C<$section_spec> arguments should be a section specification
386 as described in L<"SECTION SPECIFICATIONS">. The section specifications
387 are parsed by this method and the resulting regular expressions are
388 stored in the invoking object.
390 This method should I<not> normally be overridden by subclasses.
396 return $self->select('+', @_);
399 ##---------------------------------------------------------------------------
401 =head1 B<clear_selections()>
403 $parser->clear_selections();
405 This method takes no arguments, it has the exact same effect as invoking
406 <select()> with no arguments.
410 sub clear_selections {
412 return $self->select();
415 ##---------------------------------------------------------------------------
417 =head1 B<match_section()>
419 $boolean = $parser->match_section($heading1,$heading2,...);
421 Returns a value of true if the given section and subsection heading
422 titles match any of the currently selected section specifications in
423 effect from prior calls to B<select()> and B<add_selection()> (or if
424 there are no explicitly selected/deselected sections).
426 The arguments C<$heading1>, C<$heading2>, etc. are the heading titles of
427 the corresponding sections, subsections, etc. to try and match. If
428 C<$headingN> is omitted then it defaults to the current corresponding
429 section heading title in the input.
431 This method should I<not> normally be overridden by subclasses.
438 local *myData = $self;
440 ## Return true if no restrictions were explicitly specified
441 my $selections = (exists $myData{_SELECTED_SECTIONS})
442 ? $myData{_SELECTED_SECTIONS} : undef;
443 return 1 unless ((defined $selections) && @{$selections});
445 ## Default any unspecified sections to the current one
446 my @current_headings = $self->curr_headings();
447 for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) {
448 (defined $headings[$i]) or $headings[$i] = $current_headings[$i];
451 ## Look for a match against the specified section expressions
452 for my $section_spec ( @{$selections} ) {
453 ##------------------------------------------------------
454 ## Each portion of this spec must match in order for
455 ## the spec to be matched. So we will start with a
456 ## match-value of 'true' and logically 'and' it with
457 ## the results of matching a given element of the spec.
458 ##------------------------------------------------------
460 for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) {
461 my $regex = $section_spec->[$i];
462 my $negated = ($regex =~ s/^\!//);
463 $match &= ($negated ? ($headings[$i] !~ /${regex}/)
464 : ($headings[$i] =~ /${regex}/));
465 last unless ($match);
467 return 1 if ($match);
469 return 0; ## no match
472 ##---------------------------------------------------------------------------
474 =head1 B<is_selected()>
476 $boolean = $parser->is_selected($paragraph);
478 This method is used to determine if the block of text given in
479 C<$paragraph> falls within the currently selected set of POD sections
480 and subsections to be printed or processed. This method is also
481 responsible for keeping track of the current input section and
482 subsections. It is assumed that C<$paragraph> is the most recently read
483 (but not yet processed) input paragraph.
485 The value returned will be true if the C<$paragraph> and the rest of the
486 text in the same section as C<$paragraph> should be selected (included)
487 for processing; otherwise a false value is returned.
492 my ($self, $paragraph) = @_;
494 local *myData = $self;
496 $self->_init_headings() unless (defined $myData{_SECTION_HEADINGS});
498 ## Keep track of current sections levels and headings
500 if (/^=((?:sub)*)(?:head(?:ing)?|sec(?:tion)?)(\d*)\s+(.*?)\s*$/)
502 ## This is a section heading command
503 my ($level, $heading) = ($2, $3);
504 $level = 1 + (length($1) / 3) if ((! length $level) || (length $1));
505 ## Reset the current section heading at this level
506 $myData{_SECTION_HEADINGS}->[$level - 1] = $heading;
507 ## Reset subsection headings of this one to empty
508 for (my $i = $level; $i < $MAX_HEADING_LEVEL; ++$i) {
509 $myData{_SECTION_HEADINGS}->[$i] = '';
513 return $self->match_section();
516 #############################################################################
518 =head1 EXPORTED FUNCTIONS
520 The following functions are exported by this module. Please note that
521 these are functions (not methods) and therefore C<do not> take an
522 implicit first argument.
526 ##---------------------------------------------------------------------------
528 =head1 B<podselect()>
530 podselect(\%options,@filelist);
532 B<podselect> will print the raw (untranslated) POD paragraphs of all
533 POD sections in the given input files specified by C<@filelist>
534 according to the given options.
536 If any argument to B<podselect> is a reference to a hash
537 (associative array) then the values with the following keys are
538 processed as follows:
544 A string corresponding to the desired output file (or ">&STDOUT"
545 or ">&STDERR"). The default is to use standard output.
549 A reference to an array of sections specifications (as described in
550 L<"SECTION SPECIFICATIONS">) which indicate the desired set of POD
551 sections and subsections to be selected from input. If no section
552 specifications are given, then all sections of the PODs are used.
554 =begin _NOT_IMPLEMENTED_
558 A reference to an array of range specifications (as described in
559 L<"RANGE SPECIFICATIONS">) which indicate the desired range of POD
560 paragraphs to be selected from the desired input sections. If no range
561 specifications are given, then all paragraphs of the desired sections
564 =end _NOT_IMPLEMENTED_
568 All other arguments should correspond to the names of input files
569 containing POD sections. A file name of "-" or "<&STDIN" will
570 be interpreted to mean standard input (which is the default if no
571 filenames are given).
578 my $pod_parser = new Pod::Select(%defaults);
580 my $output = '>&STDOUT';
585 next unless (ref($_) eq 'HASH');
586 %opts = (%defaults, %{$_});
588 ##-------------------------------------------------------------
589 ## Need this for backward compatibility since we formerly used
590 ## options that were all uppercase words rather than ones that
591 ## looked like Unix command-line options.
592 ## to be uppercase keywords)
593 ##-------------------------------------------------------------
595 my ($key, $val) = (lc $_, $opts{$_});
596 $key =~ s/^(?=\w)/-/;
597 $key =~ /^-se[cl]/ and $key = '-sections';
598 #! $key eq '-range' and $key .= 's';
602 ## Process the options
603 (exists $opts{'-output'}) and $output = $opts{'-output'};
605 ## Select the desired sections
606 $pod_parser->select(@{ $opts{'-sections'} })
607 if ( (defined $opts{'-sections'})
608 && ((ref $opts{'-sections'}) eq 'ARRAY') );
610 #! ## Select the desired paragraph ranges
611 #! $pod_parser->select(@{ $opts{'-ranges'} })
612 #! if ( (defined $opts{'-ranges'})
613 #! && ((ref $opts{'-ranges'}) eq 'ARRAY') );
616 $pod_parser->parse_from_file($_, $output);
620 $pod_parser->parse_from_file('-') unless ($num_inputs > 0);
623 #############################################################################
625 =head1 PRIVATE METHODS AND DATA
627 B<Pod::Select> makes uses a number of internal methods and data fields
628 which clients should not need to see or use. For the sake of avoiding
629 name collisions with client data and methods, these methods and fields
630 are briefly discussed here. Determined hackers may obtain further
631 information about them by reading the B<Pod::Select> source code.
633 Private data fields are stored in the hash-object whose reference is
634 returned by the B<new()> constructor for this class. The names of all
635 private methods and data-fields used by B<Pod::Select> begin with a
636 prefix of "_" and match the regular expression C</^_\w+$/>.
640 ##---------------------------------------------------------------------------
644 =head1 B<_compile_section_spec()>
646 $listref = $parser->_compile_section_spec($section_spec);
648 This function (note it is a function and I<not> a method) takes a
649 section specification (as described in L<"SECTION SPECIFICATIONS">)
650 given in C<$section_sepc>, and compiles it into a list of regular
651 expressions. If C<$section_spec> has no syntax errors, then a reference
652 to the list (array) of corresponding regular expressions is returned;
653 otherwise C<undef> is returned and an error message is printed (using
654 B<carp>) for each invalid regex.
660 sub _compile_section_spec {
661 my ($section_spec) = @_;
662 my (@regexs, $negated);
664 ## Compile the spec into a list of regexs
665 local $_ = $section_spec;
666 s{\\\\}{\001}g; ## handle escaped backward slashes
667 s{\\/}{\002}g; ## handle escaped forward slashes
669 ## Parse the regexs for the heading titles
670 @regexs = split(/\//, $_, $MAX_HEADING_LEVEL);
672 ## Set default regex for ommitted levels
673 for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) {
674 $regexs[$i] = '.*' unless ((defined $regexs[$i])
675 && (length $regexs[$i]));
677 ## Modify the regexs as needed and validate their syntax
680 $_ .= '.+' if ($_ eq '!');
681 s{\001}{\\\\}g; ## restore escaped backward slashes
682 s{\002}{\\/}g; ## restore escaped forward slashes
683 $negated = s/^\!//; ## check for negation
684 eval "m{$_}"; ## check regex syntax
687 carp qq{Bad regular expression /$_/ in "$section_spec": $@\n};
690 ## Add the forward and rear anchors (and put the negator back)
691 $_ = '^' . $_ unless (/^\^/);
692 $_ = $_ . '$' unless (/\$$/);
693 $_ = '!' . $_ if ($negated);
696 return (! $bad_regexs) ? [ @regexs ] : undef;
699 ##---------------------------------------------------------------------------
703 =head2 $self->{_SECTION_HEADINGS}
705 A reference to an array of the current section heading titles for each
706 heading level (note that the first heading level title is at index 0).
712 ##---------------------------------------------------------------------------
716 =head2 $self->{_SELECTED_SECTIONS}
718 A reference to an array of references to arrays. Each subarray is a list
719 of anchored regular expressions (preceded by a "!" if the expression is to
720 be negated). The index of the expression in the subarray should correspond
721 to the index of the heading title in C<$self-E<gt>{_SECTION_HEADINGS}>
722 that it is to be matched against.
728 #############################################################################
736 Please report bugs using L<http://rt.cpan.org>.
738 Brad Appleton E<lt>bradapp@enteract.comE<gt>
740 Based on code for B<pod2text> written by
741 Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>