This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
remove FileHandle from list of PodParser dependencies (the
[perl5.git] / lib / Pod / Select.pm
CommitLineData
360aca43
GS
1#############################################################################
2# Pod/Select.pm -- function to select portions of POD docs
3#
664bb207 4# Copyright (C) 1996-1999 by Bradford Appleton. All rights reserved.
360aca43
GS
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
10package Pod::Select;
11
12use vars qw($VERSION);
664bb207 13$VERSION = 1.085; ## Current version of this package
360aca43
GS
14require 5.004; ## requires this Perl version or later
15
16#############################################################################
17
18=head1 NAME
19
20Pod::Select, podselect() - extract selected sections of POD from input
21
22=head1 SYNOPSIS
23
24 use Pod::Select;
25
26 ## Select all the POD sections for each file in @filelist
27 ## and print the result on standard output.
28 podselect(@filelist);
29
30 ## Same as above, but write to tmp.out
31 podselect({-output => "tmp.out"}, @filelist):
32
33 ## Select from the given filelist, only those POD sections that are
34 ## within a 1st level section named any of: NAME, SYNOPSIS, OPTIONS.
35 podselect({-sections => ["NAME|SYNOPSIS", "OPTIONS"]}, @filelist):
36
37 ## Select the "DESCRIPTION" section of the PODs from STDIN and write
38 ## the result to STDERR.
39 podselect({-output => ">&STDERR", -sections => ["DESCRIPTION"]}, \*STDIN);
40
41or
42
43 use Pod::Select;
44
45 ## Create a parser object for selecting POD sections from the input
46 $parser = new Pod::Select();
47
48 ## Select all the POD sections for each file in @filelist
49 ## and print the result to tmp.out.
50 $parser->parse_from_file("<&STDIN", "tmp.out");
51
52 ## Select from the given filelist, only those POD sections that are
53 ## within a 1st level section named any of: NAME, SYNOPSIS, OPTIONS.
54 $parser->select("NAME|SYNOPSIS", "OPTIONS");
55 for (@filelist) { $parser->parse_from_file($_); }
56
57 ## Select the "DESCRIPTION" and "SEE ALSO" sections of the PODs from
58 ## STDIN and write the result to STDERR.
59 $parser->select("DESCRIPTION");
60 $parser->add_selection("SEE ALSO");
61 $parser->parse_from_filehandle(\*STDIN, \*STDERR);
62
63=head1 REQUIRES
64
475d79b5 65perl5.004, Pod::Parser, Exporter, Carp
360aca43
GS
66
67=head1 EXPORTS
68
69podselect()
70
71=head1 DESCRIPTION
72
73B<podselect()> is a function which will extract specified sections of
74pod documentation from an input stream. This ability is provided by the
75B<Pod::Select> module which is a subclass of B<Pod::Parser>.
76B<Pod::Select> provides a method named B<select()> to specify the set of
77POD sections to select for processing/printing. B<podselect()> merely
78creates a B<Pod::Select> object and then invokes the B<podselect()>
79followed by B<parse_from_file()>.
80
81=head1 SECTION SPECIFICATIONS
82
83B<podselect()> and B<Pod::Select::select()> may be given one or more
84"section specifications" to restrict the text processed to only the
85desired set of sections and their corresponding subsections. A section
86specification is a string containing one or more Perl-style regular
87expressions separated by forward slashes ("/"). If you need to use a
88forward slash literally within a section title you can escape it with a
89backslash ("\/").
90
91The formal syntax of a section specification is:
92
93=over 4
94
95=item
96
97I<head1-title-regex>/I<head2-title-regex>/...
98
99=back
100
101Any omitted or empty regular expressions will default to ".*".
102Please note that each regular expression given is implicitly
103anchored by adding "^" and "$" to the beginning and end. Also, if a
104given regular expression starts with a "!" character, then the
105expression is I<negated> (so C<!foo> would match anything I<except>
106C<foo>).
107
108Some example section specifications follow.
109
110=over 4
111
112=item
113Match the C<NAME> and C<SYNOPSIS> sections and all of their subsections:
114
115C<NAME|SYNOPSIS>
116
117=item
118Match only the C<Question> and C<Answer> subsections of the C<DESCRIPTION>
119section:
120
121C<DESCRIPTION/Question|Answer>
122
123=item
124Match the C<Comments> subsection of I<all> sections:
125
126C</Comments>
127
128=item
129Match all subsections of C<DESCRIPTION> I<except> for C<Comments>:
130
131C<DESCRIPTION/!Comments>
132
133=item
134Match the C<DESCRIPTION> section but do I<not> match any of its subsections:
135
136C<DESCRIPTION/!.+>
137
138=item
139Match all top level sections but none of their subsections:
140
141C</!.+>
142
143=back
144
145=begin _NOT_IMPLEMENTED_
146
147=head1 RANGE SPECIFICATIONS
148
149B<podselect()> and B<Pod::Select::select()> may be given one or more
150"range specifications" to restrict the text processed to only the
151desired ranges of paragraphs in the desired set of sections. A range
152specification is a string containing a single Perl-style regular
153expression (a regex), or else two Perl-style regular expressions
154(regexs) separated by a ".." (Perl's "range" operator is "..").
155The regexs in a range specification are delimited by forward slashes
156("/"). If you need to use a forward slash literally within a regex you
157can escape it with a backslash ("\/").
158
159The formal syntax of a range specification is:
160
161=over 4
162
163=item
164
165/I<start-range-regex>/[../I<end-range-regex>/]
166
167=back
168
169Where each the item inside square brackets (the ".." followed by the
170end-range-regex) is optional. Each "range-regex" is of the form:
171
172 =cmd-expr text-expr
173
174Where I<cmd-expr> is intended to match the name of one or more POD
175commands, and I<text-expr> is intended to match the paragraph text for
176the command. If a range-regex is supposed to match a POD command, then
177the first character of the regex (the one after the initial '/')
178absolutely I<must> be an single '=' character; it may not be anything
179else (not even a regex meta-character) if it is supposed to match
180against the name of a POD command.
181
182If no I<=cmd-expr> is given then the text-expr will be matched against
183plain textblocks unless it is preceded by a space, in which case it is
184matched against verbatim text-blocks. If no I<text-expr> is given then
185only the command-portion of the paragraph is matched against.
186
187Note that these two expressions are each implicitly anchored. This
188means that when matching against the command-name, there will be an
189implicit '^' and '$' around the given I<=cmd-expr>; and when matching
190against the paragraph text there will be an implicit '\A' and '\Z'
191around the given I<text-expr>.
192
193Unlike with section-specs, the '!' character does I<not> have any special
194meaning (negation or otherwise) at the beginning of a range-spec!
195
196Some example range specifications follow.
197
198=over 4
199
200=item
201Match all C<=for html> paragraphs:
202
203C</=for html/>
204
205=item
206Match all paragraphs between C<=begin html> and C<=end html>
207(note that this will I<not> work correctly if such sections
208are nested):
209
210C</=begin html/../=end html/>
211
212=item
213Match all paragraphs between the given C<=item> name until the end of the
214current section:
215
216C</=item mine/../=head\d/>
217
218=item
219Match all paragraphs between the given C<=item> until the next item, or
220until the end of the itemized list (note that this will I<not> work as
221desired if the item contains an itemized list nested within it):
222
223C</=item mine/../=(item|back)/>
224
225=back
226
227=end _NOT_IMPLEMENTED_
228
229=cut
230
231#############################################################################
232
233use strict;
234#use diagnostics;
235use Carp;
236use Pod::Parser 1.04;
237use vars qw(@ISA @EXPORT $MAX_HEADING_LEVEL);
238
239@ISA = qw(Pod::Parser);
240@EXPORT = qw(&podselect);
241
242## Maximum number of heading levels supported for '=headN' directives
243*MAX_HEADING_LEVEL = \3;
244
245#############################################################################
246
247=head1 OBJECT METHODS
248
249The following methods are provided in this module. Each one takes a
250reference to the object itself as an implicit first parameter.
251
252=cut
253
254##---------------------------------------------------------------------------
255
256## =begin _PRIVATE_
257##
258## =head1 B<_init_headings()>
259##
260## Initialize the current set of active section headings.
261##
262## =cut
263##
264## =end _PRIVATE_
265
266use vars qw(%myData @section_headings);
267
268sub _init_headings {
269 my $self = shift;
270 local *myData = $self;
271
272 ## Initialize current section heading titles if necessary
273 unless (defined $myData{_SECTION_HEADINGS}) {
274 local *section_headings = $myData{_SECTION_HEADINGS} = [];
275 for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) {
276 $section_headings[$i] = '';
277 }
278 }
279}
280
281##---------------------------------------------------------------------------
282
283=head1 B<curr_headings()>
284
285 ($head1, $head2, $head3, ...) = $parser->curr_headings();
286 $head1 = $parser->curr_headings(1);
287
288This method returns a list of the currently active section headings and
289subheadings in the document being parsed. The list of headings returned
290corresponds to the most recently parsed paragraph of the input.
291
292If an argument is given, it must correspond to the desired section
293heading number, in which case only the specified section heading is
294returned. If there is no current section heading at the specified
295level, then C<undef> is returned.
296
297=cut
298
299sub curr_headings {
300 my $self = shift;
301 $self->_init_headings() unless (defined $self->{_SECTION_HEADINGS});
302 my @headings = @{ $self->{_SECTION_HEADINGS} };
303 return (@_ > 0 and $_[0] =~ /^\d+$/) ? $headings[$_[0] - 1] : @headings;
304}
305
306##---------------------------------------------------------------------------
307
308=head1 B<select()>
309
310 $parser->select($section_spec1,$section_spec2,...);
311
312This method is used to select the particular sections and subsections of
313POD documentation that are to be printed and/or processed. The existing
314set of selected sections is I<replaced> with the given set of sections.
315See B<add_selection()> for adding to the current set of selected
316sections.
317
318Each of the C<$section_spec> arguments should be a section specification
319as described in L<"SECTION SPECIFICATIONS">. The section specifications
320are parsed by this method and the resulting regular expressions are
321stored in the invoking object.
322
323If no C<$section_spec> arguments are given, then the existing set of
324selected sections is cleared out (which means C<all> sections will be
325processed).
326
327This method should I<not> normally be overridden by subclasses.
328
329=cut
330
331use vars qw(@selected_sections);
332
333sub select {
334 my $self = shift;
335 my @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 > 0) {
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 my $spec;
365 for $spec (@sections) {
366 if ( defined($_ = &_compile_section_spec($spec)) ) {
367 ## Store them in our sections array
368 push(@selected_sections, $_);
369 }
370 else {
371 carp "Ignoring section spec \"$spec\"!\n";
372 }
373 }
374}
375
376##---------------------------------------------------------------------------
377
378=head1 B<add_selection()>
379
380 $parser->add_selection($section_spec1,$section_spec2,...);
381
382This method is used to add to the currently selected sections and
383subsections of POD documentation that are to be printed and/or
384processed. See <select()> for replacing the currently selected sections.
385
386Each of the C<$section_spec> arguments should be a section specification
387as described in L<"SECTION SPECIFICATIONS">. The section specifications
388are parsed by this method and the resulting regular expressions are
389stored in the invoking object.
390
391This method should I<not> normally be overridden by subclasses.
392
393=cut
394
395sub add_selection {
396 my $self = shift;
397 $self->select("+", @_);
398}
399
400##---------------------------------------------------------------------------
401
402=head1 B<clear_selections()>
403
404 $parser->clear_selections();
405
406This method takes no arguments, it has the exact same effect as invoking
407<select()> with no arguments.
408
409=cut
410
411sub clear_selections {
412 my $self = shift;
413 $self->select();
414}
415
416##---------------------------------------------------------------------------
417
418=head1 B<match_section()>
419
420 $boolean = $parser->match_section($heading1,$heading2,...);
421
422Returns a value of true if the given section and subsection heading
423titles match any of the currently selected section specifications in
424effect from prior calls to B<select()> and B<add_selection()> (or if
425there are no explictly selected/deselected sections).
426
427The arguments C<$heading1>, C<$heading2>, etc. are the heading titles of
428the corresponding sections, subsections, etc. to try and match. If
429C<$headingN> is omitted then it defaults to the current corresponding
430section heading title in the input.
431
432This method should I<not> normally be overridden by subclasses.
433
434=cut
435
436sub match_section {
437 my $self = shift;
438 my (@headings) = @_;
439 local *myData = $self;
440
441 ## Return true if no restrictions were explicitly specified
442 my $selections = (exists $myData{_SELECTED_SECTIONS})
443 ? $myData{_SELECTED_SECTIONS} : undef;
444 return 1 unless ((defined $selections) && (@{$selections} > 0));
445
446 ## Default any unspecified sections to the current one
447 my @current_headings = $self->curr_headings();
448 for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) {
449 (defined $headings[$i]) or $headings[$i] = $current_headings[$i];
450 }
451
452 ## Look for a match against the specified section expressions
453 my ($section_spec, $regex, $negated, $match);
454 for $section_spec ( @{$selections} ) {
455 ##------------------------------------------------------
456 ## Each portion of this spec must match in order for
457 ## the spec to be matched. So we will start with a
458 ## match-value of 'true' and logically 'and' it with
459 ## the results of matching a given element of the spec.
460 ##------------------------------------------------------
461 $match = 1;
462 for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) {
463 $regex = $section_spec->[$i];
464 $negated = ($regex =~ s/^\!//);
465 $match &= ($negated ? ($headings[$i] !~ /${regex}/)
466 : ($headings[$i] =~ /${regex}/));
467 last unless ($match);
468 }
469 return 1 if ($match);
470 }
471 return 0; ## no match
472}
473
474##---------------------------------------------------------------------------
475
476=head1 B<is_selected()>
477
478 $boolean = $parser->is_selected($paragraph);
479
480This method is used to determine if the block of text given in
481C<$paragraph> falls within the currently selected set of POD sections
482and subsections to be printed or processed. This method is also
483responsible for keeping track of the current input section and
484subsections. It is assumed that C<$paragraph> is the most recently read
485(but not yet processed) input paragraph.
486
487The value returned will be true if the C<$paragraph> and the rest of the
488text in the same section as C<$paragraph> should be selected (included)
489for processing; otherwise a false value is returned.
490
491=cut
492
493sub is_selected {
494 my ($self, $paragraph) = @_;
495 local $_;
496 local *myData = $self;
497
498 $self->_init_headings() unless (defined $myData{_SECTION_HEADINGS});
499
500 ## Keep track of current sections levels and headings
501 $_ = $paragraph;
502 if (/^=((?:sub)*)(?:head(?:ing)?|sec(?:tion)?)(\d*)\s+(.*)\s*$/) {
503 ## This is a section heading command
504 my ($level, $heading) = ($2, $3);
505 $level = 1 + (length($1) / 3) if ((! length $level) || (length $1));
506 ## Reset the current section heading at this level
507 $myData{_SECTION_HEADINGS}->[$level - 1] = $heading;
508 ## Reset subsection headings of this one to empty
509 for (my $i = $level; $i < $MAX_HEADING_LEVEL; ++$i) {
510 $myData{_SECTION_HEADINGS}->[$i] = '';
511 }
512 }
513
514 return $self->match_section();
515}
516
517#############################################################################
518
519=head1 EXPORTED FUNCTIONS
520
521The following functions are exported by this module. Please note that
522these are functions (not methods) and therefore C<do not> take an
523implicit first argument.
524
525=cut
526
527##---------------------------------------------------------------------------
528
529=head1 B<podselect()>
530
531 podselect(\%options,@filelist);
532
533B<podselect> will print the raw (untranslated) POD paragraphs of all
534POD sections in the given input files specified by C<@filelist>
535according to the given options.
536
537If any argument to B<podselect> is a reference to a hash
538(associative array) then the values with the following keys are
539processed as follows:
540
541=over 4
542
543=item B<-output>
544
545A string corresponding to the desired output file (or ">&STDOUT"
546or ">&STDERR"). The default is to use standard output.
547
548=item B<-sections>
549
550A reference to an array of sections specifications (as described in
551L<"SECTION SPECIFICATIONS">) which indicate the desired set of POD
552sections and subsections to be selected from input. If no section
553specifications are given, then all sections of the PODs are used.
554
555=begin _NOT_IMPLEMENTED_
556
557=item B<-ranges>
558
559A reference to an array of range specifications (as described in
560L<"RANGE SPECIFICATIONS">) which indicate the desired range of POD
561paragraphs to be selected from the desired input sections. If no range
562specifications are given, then all paragraphs of the desired sections
563are used.
564
565=end _NOT_IMPLEMENTED_
566
567=back
568
569All other arguments should correspond to the names of input files
570containing POD sections. A file name of "-" or "<&STDIN" will
571be interpeted to mean standard input (which is the default if no
572filenames are given).
573
574=cut
575
576sub podselect {
577 my(@argv) = @_;
578 my %defaults = ();
579 my $pod_parser = new Pod::Select(%defaults);
580 my $num_inputs = 0;
581 my $output = ">&STDOUT";
582 my %opts = ();
583 local $_;
584 for (@argv) {
585 if (ref($_)) {
586 next unless (ref($_) eq 'HASH');
587 %opts = (%defaults, %{$_});
588
589 ##-------------------------------------------------------------
590 ## Need this for backward compatibility since we formerly used
591 ## options that were all uppercase words rather than ones that
592 ## looked like Unix command-line options.
593 ## to be uppercase keywords)
594 ##-------------------------------------------------------------
595 %opts = map {
596 my ($key, $val) = (lc $_, $opts{$_});
597 $key =~ s/^(?=\w)/-/;
598 $key =~ /^-se[cl]/ and $key = '-sections';
599 #! $key eq '-range' and $key .= 's';
600 ($key => $val);
601 } (keys %opts);
602
603 ## Process the options
604 (exists $opts{'-output'}) and $output = $opts{'-output'};
605
606 ## Select the desired sections
607 $pod_parser->select(@{ $opts{'-sections'} })
608 if ( (defined $opts{'-sections'})
609 && ((ref $opts{'-sections'}) eq 'ARRAY') );
610
611 #! ## Select the desired paragraph ranges
612 #! $pod_parser->select(@{ $opts{'-ranges'} })
613 #! if ( (defined $opts{'-ranges'})
614 #! && ((ref $opts{'-ranges'}) eq 'ARRAY') );
615 }
616 else {
617 $pod_parser->parse_from_file($_, $output);
618 ++$num_inputs;
619 }
620 }
621 $pod_parser->parse_from_file("-") unless ($num_inputs > 0);
622}
623
624#############################################################################
625
626=head1 PRIVATE METHODS AND DATA
627
628B<Pod::Select> makes uses a number of internal methods and data fields
629which clients should not need to see or use. For the sake of avoiding
630name collisions with client data and methods, these methods and fields
631are briefly discussed here. Determined hackers may obtain further
632information about them by reading the B<Pod::Select> source code.
633
634Private data fields are stored in the hash-object whose reference is
635returned by the B<new()> constructor for this class. The names of all
636private methods and data-fields used by B<Pod::Select> begin with a
637prefix of "_" and match the regular expression C</^_\w+$/>.
638
639=cut
640
641##---------------------------------------------------------------------------
642
643=begin _PRIVATE_
644
645=head1 B<_compile_section_spec()>
646
647 $listref = $parser->_compile_section_spec($section_spec);
648
649This function (note it is a function and I<not> a method) takes a
650section specification (as described in L<"SECTION SPECIFICATIONS">)
651given in C<$section_sepc>, and compiles it into a list of regular
652expressions. If C<$section_spec> has no syntax errors, then a reference
653to the list (array) of corresponding regular expressions is returned;
654otherwise C<undef> is returned and an error message is printed (using
655B<carp>) for each invalid regex.
656
657=end _PRIVATE_
658
659=cut
660
661sub _compile_section_spec {
662 my ($section_spec) = @_;
663 my (@regexs, $negated);
664
665 ## Compile the spec into a list of regexs
666 local $_ = $section_spec;
667 s|\\\\|\001|g; ## handle escaped backward slashes
668 s|\\/|\002|g; ## handle escaped forward slashes
669
670 ## Parse the regexs for the heading titles
671 @regexs = split('/', $_, $MAX_HEADING_LEVEL);
672
673 ## Set default regex for ommitted levels
674 for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) {
675 $regexs[$i] = '.*' unless ((defined $regexs[$i])
676 && (length $regexs[$i]));
677 }
678 ## Modify the regexs as needed and validate their syntax
679 my $bad_regexs = 0;
680 for (@regexs) {
681 $_ .= '.+' if ($_ eq '!');
682 s|\001|\\\\|g; ## restore escaped backward slashes
683 s|\002|\\/|g; ## restore escaped forward slashes
684 $negated = s/^\!//; ## check for negation
685 eval "/$_/"; ## check regex syntax
686 if ($@) {
687 ++$bad_regexs;
688 carp "Bad regular expression /$_/ in \"$section_spec\": $@\n";
689 }
690 else {
691 ## Add the forward and rear anchors (and put the negator back)
692 $_ = '^' . $_ unless (/^\^/);
693 $_ = $_ . '$' unless (/\$$/);
694 $_ = '!' . $_ if ($negated);
695 }
696 }
697 return (! $bad_regexs) ? [ @regexs ] : undef;
698}
699
700##---------------------------------------------------------------------------
701
702=begin _PRIVATE_
703
704=head2 $self->{_SECTION_HEADINGS}
705
706A reference to an array of the current section heading titles for each
707heading level (note that the first heading level title is at index 0).
708
709=end _PRIVATE_
710
711=cut
712
713##---------------------------------------------------------------------------
714
715=begin _PRIVATE_
716
717=head2 $self->{_SELECTED_SECTIONS}
718
719A reference to an array of references to arrays. Each subarray is a list
720of anchored regular expressions (preceded by a "!" if the expression is to
721be negated). The index of the expression in the subarray should correspond
722to the index of the heading title in C<$self-E<gt>{_SECTION_HEADINGS}>
723that it is to be matched against.
724
725=end _PRIVATE_
726
727=cut
728
729#############################################################################
730
731=head1 SEE ALSO
732
733L<Pod::Parser>
734
735=head1 AUTHOR
736
737Brad Appleton E<lt>bradapp@enteract.comE<gt>
738
739Based on code for B<pod2text> written by
740Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>
741
742=cut
743
7441;
745