X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FPod%2FSelect.pm;h=4724cb79cf91d050774e5376c52b4197d2196802;hb=1bc4b319ba6d50bfdf5332d4378c85af1205184b;hp=94ded8697a3a81c13704577698539d6848455b6f;hpb=1d7c184104c076988718a01b77c8706aae05b092;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/Pod/Select.pm b/lib/Pod/Select.pm index 94ded86..4724cb7 100644 --- a/lib/Pod/Select.pm +++ b/lib/Pod/Select.pm @@ -1,17 +1,18 @@ ############################################################################# # Pod/Select.pm -- function to select portions of POD docs # -# Copyright (C) 1996-1999 by Bradford Appleton. All rights reserved. +# 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); -$VERSION = 1.090; ## Current version of this package -require 5.004; ## requires this Perl version or later +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 ############################################################################# @@ -62,7 +63,7 @@ or =head1 REQUIRES -perl5.004, Pod::Parser, Exporter, Carp +perl5.005, Pod::Parser, Exporter, Carp =head1 EXPORTS @@ -92,7 +93,7 @@ The formal syntax of a section specification is: =over 4 -=item +=item * I/I/... @@ -109,33 +110,39 @@ Some example section specifications follow. =over 4 -=item +=item * + Match the C and C sections and all of their subsections: C -=item +=item * + Match only the C and C subsections of the C section: C -=item +=item * + Match the C subsection of I sections: C -=item +=item * + Match all subsections of C I for C: C -=item +=item * + Match the C section but do I match any of its subsections: C -=item +=item * + Match all top level sections but none of their subsections: C @@ -160,7 +167,7 @@ The formal syntax of a range specification is: =over 4 -=item +=item * /I/[../I/] @@ -175,7 +182,7 @@ Where I is intended to match the name of one or more POD commands, and I is intended to match the paragraph text for the command. If a range-regex is supposed to match a POD command, then the first character of the regex (the one after the initial '/') -absolutely I be an single '=' character; it may not be anything +absolutely I be a single '=' character; it may not be anything else (not even a regex meta-character) if it is supposed to match against the name of a POD command. @@ -230,11 +237,9 @@ C ############################################################################# -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); @@ -263,8 +268,6 @@ reference to the object itself as an implicit first parameter. ## ## =end _PRIVATE_ -use vars qw(%myData @section_headings); - sub _init_headings { my $self = shift; local *myData = $self; @@ -328,11 +331,8 @@ This method should I normally be overridden by subclasses. =cut -use vars qw(@selected_sections); - sub select { - my $self = shift; - my @sections = @_; + my ($self, @sections) = @_; local *myData = $self; local $_; @@ -349,10 +349,10 @@ sub select { ## it seems incredibly unlikely that "+" would ever correspond to ## a legitimate section heading ##--------------------------------------------------------------------- - my $add = ($sections[0] eq "+") ? shift(@sections) : ""; + my $add = ($sections[0] eq '+') ? shift(@sections) : ''; ## Reset the set of sections to use - unless (@sections > 0) { + unless (@sections) { delete $myData{_SELECTED_SECTIONS} unless ($add); return; } @@ -361,14 +361,13 @@ sub select { local *selected_sections = $myData{_SELECTED_SECTIONS}; ## Compile each spec - my $spec; - for $spec (@sections) { - if ( defined($_ = &_compile_section_spec($spec)) ) { + for my $spec (@sections) { + if ( defined($_ = _compile_section_spec($spec)) ) { ## Store them in our sections array push(@selected_sections, $_); } else { - carp "Ignoring section spec \"$spec\"!\n"; + carp qq{Ignoring section spec "$spec"!\n}; } } } @@ -394,7 +393,7 @@ This method should I normally be overridden by subclasses. sub add_selection { my $self = shift; - $self->select("+", @_); + return $self->select('+', @_); } ##--------------------------------------------------------------------------- @@ -410,7 +409,7 @@ This method takes no arguments, it has the exact same effect as invoking sub clear_selections { my $self = shift; - $self->select(); + return $self->select(); } ##--------------------------------------------------------------------------- @@ -422,7 +421,7 @@ sub clear_selections { 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 and B (or if -there are no explictly selected/deselected sections). +there are no explicitly 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 @@ -441,7 +440,7 @@ sub match_section { ## 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)); + return 1 unless ((defined $selections) && @{$selections}); ## Default any unspecified sections to the current one my @current_headings = $self->curr_headings(); @@ -450,18 +449,17 @@ sub match_section { } ## Look for a match against the specified section expressions - my ($section_spec, $regex, $negated, $match); - for $section_spec ( @{$selections} ) { + 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. ##------------------------------------------------------ - $match = 1; + my $match = 1; for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) { - $regex = $section_spec->[$i]; - $negated = ($regex =~ s/^\!//); + my $regex = $section_spec->[$i]; + my $negated = ($regex =~ s/^\!//); $match &= ($negated ? ($headings[$i] !~ /${regex}/) : ($headings[$i] =~ /${regex}/)); last unless ($match); @@ -499,7 +497,8 @@ sub is_selected { ## Keep track of current sections levels and headings $_ = $paragraph; - if (/^=((?:sub)*)(?:head(?:ing)?|sec(?:tion)?)(\d*)\s+(.*)\s*$/) { + 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)); @@ -568,22 +567,22 @@ are used. 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 +be interpreted to mean standard input (which is the default if no filenames are given). =cut sub podselect { my(@argv) = @_; - my %defaults = (); + my %defaults = (); my $pod_parser = new Pod::Select(%defaults); my $num_inputs = 0; - my $output = ">&STDOUT"; - my %opts = (); + my $output = '>&STDOUT'; + my %opts; local $_; for (@argv) { if (ref($_)) { - next unless (ref($_) eq 'HASH'); + next unless (ref($_) eq 'HASH'); %opts = (%defaults, %{$_}); ##------------------------------------------------------------- @@ -597,7 +596,7 @@ sub podselect { $key =~ s/^(?=\w)/-/; $key =~ /^-se[cl]/ and $key = '-sections'; #! $key eq '-range' and $key .= 's'; - ($key => $val); + ($key => $val); } (keys %opts); ## Process the options @@ -618,7 +617,7 @@ sub podselect { ++$num_inputs; } } - $pod_parser->parse_from_file("-") unless ($num_inputs > 0); + $pod_parser->parse_from_file('-') unless ($num_inputs > 0); } ############################################################################# @@ -664,11 +663,11 @@ sub _compile_section_spec { ## 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 + 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); + @regexs = split(/\//, $_, $MAX_HEADING_LEVEL); ## Set default regex for ommitted levels for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) { @@ -679,13 +678,13 @@ sub _compile_section_spec { 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 + 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 "Bad regular expression /$_/ in \"$section_spec\": $@\n"; + carp qq{Bad regular expression /$_/ in "$section_spec": $@\n}; } else { ## Add the forward and rear anchors (and put the negator back) @@ -734,6 +733,8 @@ L =head1 AUTHOR +Please report bugs using L. + Brad Appleton Ebradapp@enteract.comE Based on code for B written by @@ -742,4 +743,4 @@ Tom Christiansen Etchrist@mox.perl.comE =cut 1; - +# vim: ts=4 sw=4 et