| Pod-Parser documentation | Contained in the Pod-Parser distribution. |
Pod::Select, podselect() - extract selected sections of POD from input
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);
perl5.005, Pod::Parser, Exporter, Carp
podselect()
podselect() is a function which will extract specified sections of pod documentation from an input stream. This ability is provided by the Pod::Select module which is a subclass of Pod::Parser. Pod::Select provides a method named select() to specify the set of POD sections to select for processing/printing. podselect() merely creates a Pod::Select object and then invokes the podselect() followed by parse_from_file().
podselect() and Pod::Select::select() may be given one or more "section specifications" to restrict the text processed to only the desired set of sections and their corresponding subsections. A section specification is a string containing one or more Perl-style regular expressions separated by forward slashes ("/"). If you need to use a forward slash literally within a section title you can escape it with a backslash ("\/").
The formal syntax of a section specification is:
Any omitted or empty regular expressions will default to ".*".
Please note that each regular expression given is implicitly
anchored by adding "^" and "$" to the beginning and end. Also, if a
given regular expression starts with a "!" character, then the
expression is negated (so !foo would match anything except
foo).
Some example section specifications follow.
NAME and SYNOPSIS sections and all of their subsections:
NAME|SYNOPSIS Question and Answer subsections of the DESCRIPTION
section:
DESCRIPTION/Question|Answer Comments subsection of all sections:
/Comments DESCRIPTION except for Comments:
DESCRIPTION/!Comments DESCRIPTION section but do not match any of its subsections:
DESCRIPTION/!.+ /!.+The following methods are provided in this module. Each one takes a reference to the object itself as an implicit first parameter.
($head1, $head2, $head3, ...) = $parser->curr_headings();
$head1 = $parser->curr_headings(1);
This method returns a list of the currently active section headings and subheadings in the document being parsed. The list of headings returned corresponds to the most recently parsed paragraph of the input.
If an argument is given, it must correspond to the desired section
heading number, in which case only the specified section heading is
returned. If there is no current section heading at the specified
level, then undef is returned.
$parser->select($section_spec1,$section_spec2,...);
This method is used to select the particular sections and subsections of POD documentation that are to be printed and/or processed. The existing set of selected sections is replaced with the given set of sections. See add_selection() for adding to the current set of selected sections.
Each of the $section_spec arguments should be a section specification
as described in "SECTION SPECIFICATIONS". The section specifications
are parsed by this method and the resulting regular expressions are
stored in the invoking object.
If no $section_spec arguments are given, then the existing set of
selected sections is cleared out (which means all sections will be
processed).
This method should not normally be overridden by subclasses.
$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 $section_spec arguments should be a section specification
as described in "SECTION SPECIFICATIONS". The section specifications
are parsed by this method and the resulting regular expressions are
stored in the invoking object.
This method should not normally be overridden by subclasses.
$parser->clear_selections();
This method takes no arguments, it has the exact same effect as invoking <select()> with no arguments.
$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 select() and add_selection() (or if there are no explicitly selected/deselected sections).
The arguments $heading1, $heading2, etc. are the heading titles of
the corresponding sections, subsections, etc. to try and match. If
$headingN is omitted then it defaults to the current corresponding
section heading title in the input.
This method should not normally be overridden by subclasses.
$boolean = $parser->is_selected($paragraph);
This method is used to determine if the block of text given in
$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 $paragraph is the most recently read
(but not yet processed) input paragraph.
The value returned will be true if the $paragraph and the rest of the
text in the same section as $paragraph should be selected (included)
for processing; otherwise a false value is returned.
The following functions are exported by this module. Please note that
these are functions (not methods) and therefore do not take an
implicit first argument.
podselect(\%options,@filelist);
podselect will print the raw (untranslated) POD paragraphs of all
POD sections in the given input files specified by @filelist
according to the given options.
If any argument to podselect is a reference to a hash (associative array) then the values with the following keys are processed as follows:
A string corresponding to the desired output file (or ">&STDOUT" or ">&STDERR"). The default is to use standard output.
A reference to an array of sections specifications (as described in "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.
All other arguments should correspond to the names of input files containing POD sections. A file name of "-" or "<&STDIN" will be interpreted to mean standard input (which is the default if no filenames are given).
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 Pod::Select source code.
Private data fields are stored in the hash-object whose reference is
returned by the new() constructor for this class. The names of all
private methods and data-fields used by Pod::Select begin with a
prefix of "_" and match the regular expression /^_\w+$/.
Please report bugs using http://rt.cpan.org.
Brad Appleton <bradapp@enteract.com>
Based on code for pod2text written by Tom Christiansen <tchrist@mox.perl.com>
| Pod-Parser documentation | Contained in the Pod-Parser distribution. |
############################################################################# # 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 strict; use vars qw($VERSION @ISA @EXPORT $MAX_HEADING_LEVEL %myData @section_headings @selected_sections); $VERSION = '1.36'; ## Current version of this package require 5.005; ## requires this Perl version or later #############################################################################
############################################################################# #use diagnostics; use Carp; use Pod::Parser 1.04; @ISA = qw(Pod::Parser); @EXPORT = qw(&podselect); ## Maximum number of heading levels supported for '=headN' directives *MAX_HEADING_LEVEL = \3; #############################################################################
##--------------------------------------------------------------------------- ## =begin _PRIVATE_ ## ## =head1 B<_init_headings()> ## ## Initialize the current set of active section headings. ## ## =cut ## ## =end _PRIVATE_ 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] = ''; } } } ##---------------------------------------------------------------------------
sub 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; } ##---------------------------------------------------------------------------
sub select { my ($self, @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) { 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 for my $spec (@sections) { if ( defined($_ = _compile_section_spec($spec)) ) { ## Store them in our sections array push(@selected_sections, $_); } else { carp qq{Ignoring section spec "$spec"!\n}; } } } ##---------------------------------------------------------------------------
sub add_selection { my $self = shift; return $self->select('+', @_); } ##---------------------------------------------------------------------------
sub clear_selections { my $self = shift; return $self->select(); } ##---------------------------------------------------------------------------
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}); ## 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 for my $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. ##------------------------------------------------------ my $match = 1; for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) { my $regex = $section_spec->[$i]; my $negated = ($regex =~ s/^\!//); $match &= ($negated ? ($headings[$i] !~ /${regex}/) : ($headings[$i] =~ /${regex}/)); last unless ($match); } return 1 if ($match); } return 0; ## no match } ##---------------------------------------------------------------------------
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(); } #############################################################################
##---------------------------------------------------------------------------
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); } #############################################################################
##---------------------------------------------------------------------------
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 "m{$_}"; ## check regex syntax if ($@) { ++$bad_regexs; carp qq{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; } ##---------------------------------------------------------------------------
##---------------------------------------------------------------------------
#############################################################################
1; # vim: ts=4 sw=4 et