############################################################################## Pod/Select.pm -- function to select portions of POD docs## Copyright (C) 1996-2000 by Bradford Appleton. All rights reserved.# This file is part of "PodParser". PodParser is free software;# you can redistribute it and/or modify it under the same terms# as Perl itself.#############################################################################package Pod::Select;use vars qw($VERSION);$VERSION = 1.13;  ## Current version of this packagerequire  5.005;    ## requires this Perl version or later#############################################################################=head1 NAMEPod::Select, podselect() - extract selected sections of POD from input=head1 SYNOPSIS    use Pod::Select;    ## Select all the POD sections for each file in @filelist    ## and print the result on standard output.    podselect(@filelist);    ## Same as above, but write to tmp.out    podselect({-output => "tmp.out"}, @filelist):    ## Select from the given filelist, only those POD sections that are    ## within a 1st level section named any of: NAME, SYNOPSIS, OPTIONS.    podselect({-sections => ["NAME|SYNOPSIS", "OPTIONS"]}, @filelist):    ## Select the "DESCRIPTION" section of the PODs from STDIN and write    ## the result to STDERR.    podselect({-output => ">&STDERR", -sections => ["DESCRIPTION"]}, \*STDIN);or    use Pod::Select;    ## Create a parser object for selecting POD sections from the input    $parser = new Pod::Select();    ## Select all the POD sections for each file in @filelist    ## and print the result to tmp.out.    $parser->parse_from_file("<&STDIN", "tmp.out");    ## Select from the given filelist, only those POD sections that are    ## within a 1st level section named any of: NAME, SYNOPSIS, OPTIONS.    $parser->select("NAME|SYNOPSIS", "OPTIONS");    for (@filelist) { $parser->parse_from_file($_); }    ## Select the "DESCRIPTION" and "SEE ALSO" sections of the PODs from    ## STDIN and write the result to STDERR.    $parser->select("DESCRIPTION");    $parser->add_selection("SEE ALSO");    $parser->parse_from_filehandle(\*STDIN, \*STDERR);=head1 REQUIRESperl5.005, Pod::Parser, Exporter, Carp=head1 EXPORTSpodselect()=head1 DESCRIPTIONB<podselect()> is a function which will extract specified sections ofpod documentation from an input stream. This ability is provided by theB<Pod::Select> module which is a subclass of B<Pod::Parser>.B<Pod::Select> provides a method named B<select()> to specify the set ofPOD sections to select for processing/printing. B<podselect()> merelycreates a B<Pod::Select> object and then invokes the B<podselect()>followed by B<parse_from_file()>.=head1 SECTION SPECIFICATIONSB<podselect()> and B<Pod::Select::select()> may be given one or more"section specifications" to restrict the text processed to only thedesired set of sections and their corresponding subsections.  A sectionspecification is a string containing one or more Perl-style regularexpressions separated by forward slashes ("/").  If you need to use aforward slash literally within a section title you can escape it with abackslash ("\/").The formal syntax of a section specification is:=over 4=item *I<head1-title-regex>/I<head2-title-regex>/...=backAny omitted or empty regular expressions will default to ".*".Please note that each regular expression given is implicitlyanchored by adding "^" and "$" to the beginning and end.  Also, if agiven regular expression starts with a "!" character, then theexpression is I<negated> (so C<!foo> would match anything I<except>C<foo>).Some example section specifications follow.=over 4=item *Match the C<NAME> and C<SYNOPSIS> sections and all of their subsections:C<NAME|SYNOPSIS>=item *Match only the C<Question> and C<Answer> subsections of the C<DESCRIPTION>section:C<DESCRIPTION/Question|Answer>=item *Match the C<Comments> subsection of I<all> sections:C</Comments>=item *Match all subsections of C<DESCRIPTION> I<except> for C<Comments>:C<DESCRIPTION/!Comments>=item *Match the C<DESCRIPTION> section but do I<not> match any of its subsections:C<DESCRIPTION/!.+>=item *Match all top level sections but none of their subsections:C</!.+>=back =begin _NOT_IMPLEMENTED_=head1 RANGE SPECIFICATIONSB<podselect()> and B<Pod::Select::select()> may be given one or more"range specifications" to restrict the text processed to only thedesired ranges of paragraphs in the desired set of sections. A rangespecification is a string containing a single Perl-style regularexpression (a regex), or else two Perl-style regular expressions(regexs) separated by a ".." (Perl's "range" operator is "..").The regexs in a range specification are delimited by forward slashes("/").  If you need to use a forward slash literally within a regex youcan escape it with a backslash ("\/").The formal syntax of a range specification is:=over 4=item */I<start-range-regex>/[../I<end-range-regex>/]=backWhere each the item inside square brackets (the ".." followed by theend-range-regex) is optional. Each "range-regex" is of the form:    =cmd-expr text-exprWhere I<cmd-expr> is intended to match the name of one or more PODcommands, and I<text-expr> is intended to match the paragraph text forthe command. If a range-regex is supposed to match a POD command, thenthe first character of the regex (the one after the initial '/')absolutely I<must> be an single '=' character; it may not be anythingelse (not even a regex meta-character) if it is supposed to matchagainst the name of a POD command.If no I<=cmd-expr> is given then the text-expr will be matched againstplain textblocks unless it is preceded by a space, in which case it ismatched against verbatim text-blocks. If no I<text-expr> is given thenonly the command-portion of the paragraph is matched against.Note that these two expressions are each implicitly anchored. Thismeans that when matching against the command-name, there will be animplicit '^' and '$' around the given I<=cmd-expr>; and when matchingagainst the paragraph text there will be an implicit '\A' and '\Z'around the given I<text-expr>.Unlike with section-specs, the '!' character does I<not> have any specialmeaning (negation or otherwise) at the beginning of a range-spec!Some example range specifications follow.=over 4=itemMatch all C<=for html> paragraphs:C</=for html/>=itemMatch all paragraphs between C<=begin html> and C<=end html>(note that this will I<not> work correctly if such sectionsare nested):C</=begin html/../=end html/>=itemMatch all paragraphs between the given C<=item> name until the end of thecurrent section:C</=item mine/../=head\d/>=itemMatch all paragraphs between the given C<=item> until the next item, oruntil the end of the itemized list (note that this will I<not> work asdesired if the item contains an itemized list nested within it):C</=item mine/../=(item|back)/>=back =end _NOT_IMPLEMENTED_=cut#############################################################################use strict;#use diagnostics;use Carp;use Pod::Parser 1.04;use vars qw(@ISA @EXPORT $MAX_HEADING_LEVEL);@ISA = qw(Pod::Parser);@EXPORT = qw(&podselect);## Maximum number of heading levels supported for '=headN' directives*MAX_HEADING_LEVEL = \3;#############################################################################=head1 OBJECT METHODSThe following methods are provided in this module. Each one takes areference to the object itself as an implicit first parameter.=cut##---------------------------------------------------------------------------## =begin _PRIVATE_## ## =head1 B<_init_headings()>## ## Initialize the current set of active section headings.## ## =cut## ## =end _PRIVATE_use vars qw(%myData @section_headings);sub _init_headings {    my $self = shift;    local *myData = $self;    ## Initialize current section heading titles if necessary    unless (defined $myData{_SECTION_HEADINGS}) {        local *section_headings = $myData{_SECTION_HEADINGS} = [];        for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) {            $section_headings[$i] = '';        }    }}##---------------------------------------------------------------------------=head1 B<curr_headings()>            ($head1, $head2, $head3, ...) = $parser->curr_headings();            $head1 = $parser->curr_headings(1);This method returns a list of the currently active section headings andsubheadings in the document being parsed. The list of headings returnedcorresponds to the most recently parsed paragraph of the input.If an argument is given, it must correspond to the desired sectionheading number, in which case only the specified section heading isreturned. If there is no current section heading at the specifiedlevel, then C<undef> is returned.=cutsub curr_headings {    my $self = shift;    $self->_init_headings()  unless (defined $self->{_SECTION_HEADINGS});    my @headings = @{ $self->{_SECTION_HEADINGS} };    return (@_ > 0  and  $_[0] =~ /^\d+$/) ? $headings[$_[0] - 1] : @headings;}##---------------------------------------------------------------------------=head1 B<select()>            $parser->select($section_spec1,$section_spec2,...);This method is used to select the particular sections and subsections ofPOD documentation that are to be printed and/or processed. The existingset of selected sections is I<replaced> with the given set of sections.See B<add_selection()> for adding to the current set of selectedsections.Each of the C<$section_spec> arguments should be a section specificationas described in L<"SECTION SPECIFICATIONS">.  The section specificationsare parsed by this method and the resulting regular expressions arestored in the invoking object.If no C<$section_spec> arguments are given, then the existing set ofselected sections is cleared out (which means C<all> sections will beprocessed).This method should I<not> normally be overridden by subclasses.=cutuse vars qw(@selected_sections);sub select {    my $self = shift;    my @sections = @_;    local *myData = $self;    local $_;### NEED TO DISCERN A SECTION-SPEC FROM A RANGE-SPEC (look for m{^/.+/$}?)    ##---------------------------------------------------------------------    ## The following is a blatant hack for backward compatibility, and for    ## implementing add_selection(). If the *first* *argument* is the    ## string "+", then the remaining section specifications are *added*    ## to the current set of selections; otherwise the given section    ## specifications will *replace* the current set of selections.    ##    ## This should probably be fixed someday, but for the present time,    ## it seems incredibly unlikely that "+" would ever correspond to    ## a legitimate section heading    ##---------------------------------------------------------------------    my $add = ($sections[0] eq "+") ? shift(@sections) : "";    ## Reset the set of sections to use    unless (@sections > 0) {        delete $myData{_SELECTED_SECTIONS}  unless ($add);        return;    }    $myData{_SELECTED_SECTIONS} = []        unless ($add  &&  exists $myData{_SELECTED_SECTIONS});    local *selected_sections = $myData{_SELECTED_SECTIONS};    ## Compile each spec    my $spec;    for $spec (@sections) {        if ( defined($_ = &_compile_section_spec($spec)) ) {            ## Store them in our sections array            push(@selected_sections, $_);        }        else {