select.pm

网络监控

}

##---------------------------------------------------------------------------

=head1 B<add_selection()>

            $parser->add_selection($section_spec1,$section_spec2,...);

This method is used to add to the currently selected sections and
subsections of POD documentation that are to be printed and/or
processed. See <select()> for replacing the currently selected sections.

Each of the C<$section_spec> arguments should be a section specification
as described in L<"SECTION SPECIFICATIONS">. The section specifications
are parsed by this method and the resulting regular expressions are
stored in the invoking object.

This method should I<not> normally be overridden by subclasses.

=cut

sub add_selection {
    my $self = shift;
    $self->select("+", @_);
}

##---------------------------------------------------------------------------

=head1 B<clear_selections()>

            $parser->clear_selections();

This method takes no arguments, it has the exact same effect as invoking
<select()> with no arguments.

=cut

sub clear_selections {
    my $self = shift;
    $self->select();
}

##---------------------------------------------------------------------------

=head1 B<match_section()>

            $boolean = $parser->match_section($heading1,$heading2,...);

Returns a value of true if the given section and subsection heading
titles match any of the currently selected section specifications in
effect from prior calls to B<select()> and B<add_selection()> (or if
there are no explictly selected/deselected sections).

The arguments C<$heading1>, C<$heading2>, etc. are the heading titles of
the corresponding sections, subsections, etc. to try and match.  If
C<$headingN> is omitted then it defaults to the current corresponding
section heading title in the input.

This method should I<not> normally be overridden by subclasses.

=cut

sub match_section {
    my $self = shift;
    my (@headings) = @_;
    local *myData = $self;

    ## Return true if no restrictions were explicitly specified
    my $selections = (exists $myData{_SELECTED_SECTIONS})
                       ?  $myData{_SELECTED_SECTIONS}  :  undef;
    return  1  unless ((defined $selections) && (@{$selections} > 0));

    ## Default any unspecified sections to the current one
    my @current_headings = $self->curr_headings();
    for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) {
        (defined $headings[$i])  or  $headings[$i] = $current_headings[$i];
    }

    ## Look for a match against the specified section expressions
    my ($section_spec, $regex, $negated, $match);
    for $section_spec ( @{$selections} ) {
        ##------------------------------------------------------
        ## Each portion of this spec must match in order for
        ## the spec to be matched. So we will start with a 
        ## match-value of 'true' and logically 'and' it with
        ## the results of matching a given element of the spec.
        ##------------------------------------------------------
        $match = 1;
        for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) {
            $regex   = $section_spec->[$i];
            $negated = ($regex =~ s/^\!//);
            $match  &= ($negated ? ($headings[$i] !~ /${regex}/)
                                 : ($headings[$i] =~ /${regex}/));
            last unless ($match);
        }
        return  1  if ($match);
    }
    return  0;  ## no match
}

##---------------------------------------------------------------------------

=head1 B<is_selected()>

            $boolean = $parser->is_selected($paragraph);

This method is used to determine if the block of text given in
C<$paragraph> falls within the currently selected set of POD sections
and subsections to be printed or processed. This method is also
responsible for keeping track of the current input section and
subsections. It is assumed that C<$paragraph> is the most recently read
(but not yet processed) input paragraph.

The value returned will be true if the C<$paragraph> and the rest of the
text in the same section as C<$paragraph> should be selected (included)
for processing; otherwise a false value is returned.

=cut

sub is_selected {
    my ($self, $paragraph) = @_;
    local $_;
    local *myData = $self;

    $self->_init_headings()  unless (defined $myData{_SECTION_HEADINGS});

    ## Keep track of current sections levels and headings
    $_ = $paragraph;
    if (/^=((?:sub)*)(?:head(?:ing)?|sec(?:tion)?)(\d*)\s+(.*)\s*$/) {
        ## This is a section heading command
        my ($level, $heading) = ($2, $3);
        $level = 1 + (length($1) / 3)  if ((! length $level) || (length $1));
        ## Reset the current section heading at this level
        $myData{_SECTION_HEADINGS}->[$level - 1] = $heading;
        ## Reset subsection headings of this one to empty
        for (my $i = $level; $i < $MAX_HEADING_LEVEL; ++$i) {
            $myData{_SECTION_HEADINGS}->[$i] = '';
        }
    }

    return  $self->match_section();
}

#############################################################################

=head1 EXPORTED FUNCTIONS

The following functions are exported by this module. Please note that
these are functions (not methods) and therefore C<do not> take an
implicit first argument.

=cut

##---------------------------------------------------------------------------

=head1 B<podselect()>

            podselect(\%options,@filelist);

B<podselect> will print the raw (untranslated) POD paragraphs of all
POD sections in the given input files specified by C<@filelist>
according to the given options.

If any argument to B<podselect> is a reference to a hash
(associative array) then the values with the following keys are
processed as follows:

=over 4

=item B<-output>

A string corresponding to the desired output file (or ">&STDOUT"
or ">&STDERR"). The default is to use standard output.

=item B<-sections>

A reference to an array of sections specifications (as described in
L<"SECTION SPECIFICATIONS">) which indicate the desired set of POD
sections and subsections to be selected from input. If no section
specifications are given, then all sections of the PODs are used.

=begin _NOT_IMPLEMENTED_

=item B<-ranges>

A reference to an array of range specifications (as described in
L<"RANGE SPECIFICATIONS">) which indicate the desired range of POD
paragraphs to be selected from the desired input sections. If no range
specifications are given, then all paragraphs of the desired sections
are used.

=end _NOT_IMPLEMENTED_

=back

All other arguments should correspond to the names of input files
containing POD sections. A file name of "-" or "<&STDIN" will
be interpeted to mean standard input (which is the default if no
filenames are given).

=cut 

sub podselect {
    my(@argv) = @_;
    my %defaults   = ();
    my $pod_parser = new Pod::Select(%defaults);
    my $num_inputs = 0;
    my $output = ">&STDOUT";
    my %opts = ();
    local $_;
    for (@argv) {
        if (ref($_)) {
            next unless (ref($_) eq 'HASH');
            %opts = (%defaults, %{$_});

            ##-------------------------------------------------------------
            ## Need this for backward compatibility since we formerly used
            ## options that were all uppercase words rather than ones that
            ## looked like Unix command-line options.
            ## to be uppercase keywords)
            ##-------------------------------------------------------------
            %opts = map {
                my ($key, $val) = (lc $_, $opts{$_});
                $key =~ s/^(?=\w)/-/;
                $key =~ /^-se[cl]/  and  $key  = '-sections';
                #! $key eq '-range'    and  $key .= 's';
                ($key => $val);    
            } (keys %opts);

            ## Process the options
            (exists $opts{'-output'})  and  $output = $opts{'-output'};

            ## Select the desired sections
            $pod_parser->select(@{ $opts{'-sections'} })
                if ( (defined $opts{'-sections'})
                     && ((ref $opts{'-sections'}) eq 'ARRAY') );

            #! ## Select the desired paragraph ranges
            #! $pod_parser->select(@{ $opts{'-ranges'} })
            #!     if ( (defined $opts{'-ranges'})
            #!          && ((ref $opts{'-ranges'}) eq 'ARRAY') );
        }
        else {
            $pod_parser->parse_from_file($_, $output);
            ++$num_inputs;
        }
    }
    $pod_parser->parse_from_file("-")  unless ($num_inputs > 0);
}

#############################################################################

=head1 PRIVATE METHODS AND DATA

B<Pod::Select> makes uses a number of internal methods and data fields
which clients should not need to see or use. For the sake of avoiding
name collisions with client data and methods, these methods and fields
are briefly discussed here. Determined hackers may obtain further
information about them by reading the B<Pod::Select> source code.

Private data fields are stored in the hash-object whose reference is
returned by the B<new()> constructor for this class. The names of all
private methods and data-fields used by B<Pod::Select> begin with a
prefix of "_" and match the regular expression C</^_\w+$/>.

=cut

##---------------------------------------------------------------------------

=begin _PRIVATE_

=head1 B<_compile_section_spec()>

            $listref = $parser->_compile_section_spec($section_spec);

This function (note it is a function and I<not> a method) takes a
section specification (as described in L<"SECTION SPECIFICATIONS">)
given in C<$section_sepc>, and compiles it into a list of regular
expressions. If C<$section_spec> has no syntax errors, then a reference
to the list (array) of corresponding regular expressions is returned;
otherwise C<undef> is returned and an error message is printed (using
B<carp>) for each invalid regex.

=end _PRIVATE_

=cut

sub _compile_section_spec {
    my ($section_spec) = @_;
    my (@regexs, $negated);

    ## Compile the spec into a list of regexs
    local $_ = $section_spec;
    s|\\\\|\001|g;  ## handle escaped backward slashes
    s|\\/|\002|g;   ## handle escaped forward slashes

    ## Parse the regexs for the heading titles
    @regexs = split('/', $_, $MAX_HEADING_LEVEL);

    ## Set default regex for ommitted levels
    for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) {
        $regexs[$i]  = '.*'  unless ((defined $regexs[$i])
                                     && (length $regexs[$i]));
    }
    ## Modify the regexs as needed and validate their syntax
    my $bad_regexs = 0;
    for (@regexs) {
        $_ .= '.+'  if ($_ eq '!');
        s|\001|\\\\|g;       ## restore escaped backward slashes
        s|\002|\\/|g;        ## restore escaped forward slashes
        $negated = s/^\!//;  ## check for negation
        eval "/$_/";         ## check regex syntax
        if ($@) {
            ++$bad_regexs;
            carp "Bad regular expression /$_/ in \"$section_spec\": $@\n";
        }
        else {
            ## Add the forward and rear anchors (and put the negator back)
            $_ = '^' . $_  unless (/^\^/);
            $_ = $_ . '$'  unless (/\$$/);
            $_ = '!' . $_  if ($negated);
        }
    }
    return  (! $bad_regexs) ? [ @regexs ] : undef;
}

##---------------------------------------------------------------------------

=begin _PRIVATE_

=head2 $self->{_SECTION_HEADINGS}

A reference to an array of the current section heading titles for each
heading level (note that the first heading level title is at index 0).

=end _PRIVATE_

=cut

##---------------------------------------------------------------------------

=begin _PRIVATE_

=head2 $self->{_SELECTED_SECTIONS}

A reference to an array of references to arrays. Each subarray is a list
of anchored regular expressions (preceded by a "!" if the expression is to
be negated). The index of the expression in the subarray should correspond
to the index of the heading title in C<$self-E<gt>{_SECTION_HEADINGS}>
that it is to be matched against.

=end _PRIVATE_

=cut

#############################################################################

=head1 SEE ALSO

L<Pod::Parser>

=head1 AUTHOR

Brad Appleton E<lt>[e-mail]<gt>

Based on code for B<pod2text> written by
Tom Christiansen E<lt>[e-mail]<gt>

=cut

1;