Profile of Pod/Select.pm

Filename	/Users/timbo/perl5/perlbrew/perls/perl-5.18.2/lib/5.18.2/Pod/Select.pm
Statements	Executed 15 statements in 1.29ms

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
1	1	1	2.95ms	4.93ms	Pod::Select::::BEGIN@242Pod::Select::BEGIN@242
1	1	1	14µs	27µs	Pod::Select::::BEGIN@11Pod::Select::BEGIN@11
1	1	1	9µs	51µs	Pod::Select::::BEGIN@241Pod::Select::BEGIN@241
1	1	1	8µs	86µs	Pod::Select::::BEGIN@13Pod::Select::BEGIN@13
0	0	0	0s	0s	Pod::Select::::_compile_section_specPod::Select::_compile_section_spec
0	0	0	0s	0s	Pod::Select::::_init_headingsPod::Select::_init_headings
0	0	0	0s	0s	Pod::Select::::add_selectionPod::Select::add_selection
0	0	0	0s	0s	Pod::Select::::clear_selectionsPod::Select::clear_selections
0	0	0	0s	0s	Pod::Select::::curr_headingsPod::Select::curr_headings
0	0	0	0s	0s	Pod::Select::::is_selectedPod::Select::is_selected
0	0	0	0s	0s	Pod::Select::::match_sectionPod::Select::match_section
0	0	0	0s	0s	Pod::Select::::podselectPod::Select::podselect
0	0	0	0s	0s	Pod::Select::::selectPod::Select::select

Call graph for these subroutines as a Graphviz dot language file.

Line	State ments	Time on line	Calls	Time in subs	Code
1					#############################################################################
2					# Pod/Select.pm -- function to select portions of POD docs
3					#
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
7					# as Perl itself.
8					#############################################################################
9
10					package Pod::Select;
11	2	29µs	2	40µs	# spent 27µs (14+13) within Pod::Select::BEGIN@11 which was called: # once (14µs+13µs) by Perl::Critic::Command::BEGIN@19 at line 11 use strict; # spent 27µs making 1 call to Pod::Select::BEGIN@11 # spent 13µs making 1 call to strict::import
12
13	2	96µs	2	164µs	# spent 86µs (8+78) within Pod::Select::BEGIN@13 which was called: # once (8µs+78µs) by Perl::Critic::Command::BEGIN@19 at line 13 use vars qw($VERSION @ISA @EXPORT $MAX_HEADING_LEVEL %myData @section_headings @selected_sections); # spent 86µs making 1 call to Pod::Select::BEGIN@13 # spent 78µs making 1 call to vars::import
14	1	700ns			$VERSION = '1.60'; ## Current version of this package
15	1	9µs			require 5.005; ## requires this Perl version or later
16
17					#############################################################################
18
19					=head1 NAME
20
21					Pod::Select, podselect() - extract selected sections of POD from input
22
23					=head1 SYNOPSIS
24
25					use Pod::Select;
26
27					## Select all the POD sections for each file in @filelist
28					## and print the result on standard output.
29					podselect(@filelist);
30
31					## Same as above, but write to tmp.out
32					podselect({-output => "tmp.out"}, @filelist):
33
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):
37
38					## Select the "DESCRIPTION" section of the PODs from STDIN and write
39					## the result to STDERR.
40					podselect({-output => ">&STDERR", -sections => ["DESCRIPTION"]}, \*STDIN);
41
42					or
43
44					use Pod::Select;
45
46					## Create a parser object for selecting POD sections from the input
47					$parser = new Pod::Select();
48
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");
52
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($_); }
57
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);
63
64					=head1 REQUIRES
65
66					perl5.005, Pod::Parser, Exporter, Carp
67
68					=head1 EXPORTS
69
70					podselect()
71
72					=head1 DESCRIPTION
73
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()>.
81
82					=head1 SECTION SPECIFICATIONS
83
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
90					backslash ("\/").
91
92					The formal syntax of a section specification is:
93
94					=over 4
95
96					=item *
97
98					I<head1-title-regex>/I<head2-title-regex>/...
99
100					=back
101
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>
107					C<foo>).
108
109					Some example section specifications follow.
110
111					=over 4
112
113					=item *
114
115					Match the C<NAME> and C<SYNOPSIS> sections and all of their subsections:
116
117					C<NAME\|SYNOPSIS>
118
119					=item *
120
121					Match only the C<Question> and C<Answer> subsections of the C<DESCRIPTION>
122					section:
123
124					C<DESCRIPTION/Question\|Answer>
125
126					=item *
127
128					Match the C<Comments> subsection of I<all> sections:
129
130					C</Comments>
131
132					=item *
133
134					Match all subsections of C<DESCRIPTION> I<except> for C<Comments>:
135
136					C<DESCRIPTION/!Comments>
137
138					=item *
139
140					Match the C<DESCRIPTION> section but do I<not> match any of its subsections:
141
142					C<DESCRIPTION/!.+>
143
144					=item *
145
146					Match all top level sections but none of their subsections:
147
148					C</!.+>
149
150					=back
151
152					=begin _NOT_IMPLEMENTED_
153
154					=head1 RANGE SPECIFICATIONS
155
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 ("\/").
165
166					The formal syntax of a range specification is:
167
168					=over 4
169
170					=item *
171
172					/I<start-range-regex>/[../I<end-range-regex>/]
173
174					=back
175
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:
178
179					=cmd-expr text-expr
180
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.
188
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.
193
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>.
199
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!
202
203					Some example range specifications follow.
204
205					=over 4
206
207					=item
208					Match all C<=for html> paragraphs:
209
210					C</=for html/>
211
212					=item
213					Match all paragraphs between C<=begin html> and C<=end html>
214					(note that this will I<not> work correctly if such sections
215					are nested):
216
217					C</=begin html/../=end html/>
218
219					=item
220					Match all paragraphs between the given C<=item> name until the end of the
221					current section:
222
223					C</=item mine/../=head\d/>
224
225					=item
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):
229
230					C</=item mine/../=(item\|back)/>
231
232					=back
233
234					=end _NOT_IMPLEMENTED_
235
236					=cut
237
238					#############################################################################
239
240					#use diagnostics;
241	2	24µs	2	93µs	# spent 51µs (9+42) within Pod::Select::BEGIN@241 which was called: # once (9µs+42µs) by Perl::Critic::Command::BEGIN@19 at line 241 use Carp; # spent 51µs making 1 call to Pod::Select::BEGIN@241 # spent 42µs making 1 call to Exporter::import
242	3	1.12ms	3	4.95ms	# spent 4.93ms (2.95+1.98) within Pod::Select::BEGIN@242 which was called: # once (2.95ms+1.98ms) by Perl::Critic::Command::BEGIN@19 at line 242 use Pod::Parser 1.04; # spent 4.93ms making 1 call to Pod::Select::BEGIN@242 # spent 16µs making 1 call to Exporter::import # spent 8µs making 1 call to UNIVERSAL::VERSION
243
244	1	6µs			@ISA = qw(Pod::Parser);
245	1	600ns			@EXPORT = qw(&podselect);
246
247					## Maximum number of heading levels supported for '=headN' directives
248	1	500ns			*MAX_HEADING_LEVEL = \3;
249
250					#############################################################################
251
252					=head1 OBJECT METHODS
253
254					The following methods are provided in this module. Each one takes a
255					reference to the object itself as an implicit first parameter.
256
257					=cut
258
259					##---------------------------------------------------------------------------
260
261					## =begin _PRIVATE_
262					##
263					## =head1 B<_init_headings()>
264					##
265					## Initialize the current set of active section headings.
266					##
267					## =cut
268					##
269					## =end _PRIVATE_
270
271					sub _init_headings {
272					my $self = shift;
273					local *myData = $self;
274
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] = '';
280					}
281					}
282					}
283
284					##---------------------------------------------------------------------------
285
286					=head1 B<curr_headings()>
287
288					($head1, $head2, $head3, ...) = $parser->curr_headings();
289					$head1 = $parser->curr_headings(1);
290
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.
294
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.
299
300					=cut
301
302					sub curr_headings {
303					my $self = shift;
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;
307					}
308
309					##---------------------------------------------------------------------------
310
311					=head1 B<select()>
312
313					$parser->select($section_spec1,$section_spec2,...);
314
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
319					sections.
320
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.
325
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
328					processed).
329
330					This method should I<not> normally be overridden by subclasses.
331
332					=cut
333
334					sub select {
335					my ($self, @sections) = @_;
336					local *myData = $self;
337					local $_;
338
339					### NEED TO DISCERN A SECTION-SPEC FROM A RANGE-SPEC (look for m{^/.+/$}?)
340
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.
347					##
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) : '';
353
354					## Reset the set of sections to use
355					unless (@sections) {
356					delete $myData{_SELECTED_SECTIONS} unless ($add);
357					return;
358					}
359					$myData{_SELECTED_SECTIONS} = []
360					unless ($add && exists $myData{_SELECTED_SECTIONS});
361					local *selected_sections = $myData{_SELECTED_SECTIONS};
362
363					## Compile each spec
364					for my $spec (@sections) {
365					if ( defined($_ = _compile_section_spec($spec)) ) {
366					## Store them in our sections array
367					push(@selected_sections, $_);
368					}
369					else {
370					carp qq{Ignoring section spec "$spec"!\n};
371					}
372					}
373					}
374
375					##---------------------------------------------------------------------------
376
377					=head1 B<add_selection()>
378
379					$parser->add_selection($section_spec1,$section_spec2,...);
380
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.
384
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.
389
390					This method should I<not> normally be overridden by subclasses.
391
392					=cut
393
394					sub add_selection {
395					my $self = shift;
396					return $self->select('+', @_);
397					}
398
399					##---------------------------------------------------------------------------
400
401					=head1 B<clear_selections()>
402
403					$parser->clear_selections();
404
405					This method takes no arguments, it has the exact same effect as invoking
406					<select()> with no arguments.
407
408					=cut
409
410					sub clear_selections {
411					my $self = shift;
412					return $self->select();
413					}
414
415					##---------------------------------------------------------------------------
416
417					=head1 B<match_section()>
418
419					$boolean = $parser->match_section($heading1,$heading2,...);
420
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).
425
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.
430
431					This method should I<not> normally be overridden by subclasses.
432
433					=cut
434
435					sub match_section {
436					my $self = shift;
437					my (@headings) = @_;
438					local *myData = $self;
439
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});
444
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];
449					}
450
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					##------------------------------------------------------
459					my $match = 1;
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);
466					}
467					return 1 if ($match);
468					}
469					return 0; ## no match
470					}
471
472					##---------------------------------------------------------------------------
473
474					=head1 B<is_selected()>
475
476					$boolean = $parser->is_selected($paragraph);
477
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.
484
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.
488
489					=cut
490
491					sub is_selected {
492					my ($self, $paragraph) = @_;
493					local $_;
494					local *myData = $self;
495
496					$self->_init_headings() unless (defined $myData{_SECTION_HEADINGS});
497
498					## Keep track of current sections levels and headings
499					$_ = $paragraph;
500					if (/^=((?:sub))(?:head(?:ing)?\|sec(?:tion)?)(\d)\s+(.?)\s$/)
501					{
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] = '';
510					}
511					}
512
513					return $self->match_section();
514					}
515
516					#############################################################################
517
518					=head1 EXPORTED FUNCTIONS
519
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.
523
524					=cut
525
526					##---------------------------------------------------------------------------
527
528					=head1 B<podselect()>
529
530					podselect(\%options,@filelist);
531
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.
535
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:
539
540					=over 4
541
542					=item B<-output>
543
544					A string corresponding to the desired output file (or ">&STDOUT"
545					or ">&STDERR"). The default is to use standard output.
546
547					=item B<-sections>
548
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.
553
554					=begin _NOT_IMPLEMENTED_
555
556					=item B<-ranges>
557
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
562					are used.
563
564					=end _NOT_IMPLEMENTED_
565
566					=back
567
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).
572
573					=cut
574
575					sub podselect {
576					my(@argv) = @_;
577					my %defaults = ();
578					my $pod_parser = new Pod::Select(%defaults);
579					my $num_inputs = 0;
580					my $output = '>&STDOUT';
581					my %opts;
582					local $_;
583					for (@argv) {
584					if (ref($_)) {
585					next unless (ref($_) eq 'HASH');
586					%opts = (%defaults, %{$_});
587
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					##-------------------------------------------------------------
594					%opts = map {
595					my ($key, $val) = (lc $_, $opts{$_});
596					$key =~ s/^(?=\w)/-/;
597					$key =~ /^-se[cl]/ and $key = '-sections';
598					#! $key eq '-range' and $key .= 's';
599					($key => $val);
600					} (keys %opts);
601
602					## Process the options
603					(exists $opts{'-output'}) and $output = $opts{'-output'};
604
605					## Select the desired sections
606					$pod_parser->select(@{ $opts{'-sections'} })
607					if ( (defined $opts{'-sections'})
608					&& ((ref $opts{'-sections'}) eq 'ARRAY') );
609
610					#! ## Select the desired paragraph ranges
611					#! $pod_parser->select(@{ $opts{'-ranges'} })
612					#! if ( (defined $opts{'-ranges'})
613					#! && ((ref $opts{'-ranges'}) eq 'ARRAY') );
614					}
615					else {
616					$pod_parser->parse_from_file($_, $output);
617					++$num_inputs;
618					}
619					}
620					$pod_parser->parse_from_file('-') unless ($num_inputs > 0);
621					}
622
623					#############################################################################
624
625					=head1 PRIVATE METHODS AND DATA
626
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.
632
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+$/>.
637
638					=cut
639
640					##---------------------------------------------------------------------------
641
642					=begin _PRIVATE_
643
644					=head1 B<_compile_section_spec()>
645
646					$listref = $parser->_compile_section_spec($section_spec);
647
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.
655
656					=end _PRIVATE_
657
658					=cut
659
660					sub _compile_section_spec {
661					my ($section_spec) = @_;
662					my (@regexs, $negated);
663
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
668
669					## Parse the regexs for the heading titles
670					@regexs = split(/\//, $_, $MAX_HEADING_LEVEL);
671
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]));
676					}
677					## Modify the regexs as needed and validate their syntax
678					my $bad_regexs = 0;
679					for (@regexs) {
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
685					if ($@) {
686					++$bad_regexs;
687					carp qq{Bad regular expression /$_/ in "$section_spec": $@\n};
688					}
689					else {
690					## Add the forward and rear anchors (and put the negator back)
691					$_ = '^' . $_ unless (/^\^/);
692					$_ = $_ . '$' unless (/\$$/);
693					$_ = '!' . $_ if ($negated);
694					}
695					}
696					return (! $bad_regexs) ? [ @regexs ] : undef;
697					}
698
699					##---------------------------------------------------------------------------
700
701					=begin _PRIVATE_
702
703					=head2 $self->{_SECTION_HEADINGS}
704
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).
707
708					=end _PRIVATE_
709
710					=cut
711
712					##---------------------------------------------------------------------------
713
714					=begin _PRIVATE_
715
716					=head2 $self->{_SELECTED_SECTIONS}
717
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.
723
724					=end _PRIVATE_
725
726					=cut
727
728					#############################################################################
729
730					=head1 SEE ALSO
731
732					L<Pod::Parser>
733
734					=head1 AUTHOR
735
736					Please report bugs using L<http://rt.cpan.org>.
737
738					Brad Appleton E<lt>bradapp@enteract.comE<gt>
739
740					Based on code for B<pod2text> written by
741					Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>
742
743					B<Pod::Select> is part of the L<Pod::Parser> distribution.
744
745					=cut
746
747	1	4µs			1;
748					# vim: ts=4 sw=4 et