xref: /openbsd-src/gnu/usr.bin/perl/cpan/Pod-Usage/t/inc/Pod/Parser.pm (revision 256a93a44f36679bee503f12e49566c2183f6181)
15759b3d2Safresh1#############################################################################
25759b3d2Safresh1# Pod/Parser.pm -- package which defines a base class for parsing POD docs.
35759b3d2Safresh1#
45759b3d2Safresh1# Copyright (C) 1996-2000 by Bradford Appleton. All rights reserved.
55759b3d2Safresh1# This file is part of "PodParser". PodParser is free software;
65759b3d2Safresh1# you can redistribute it and/or modify it under the same terms
75759b3d2Safresh1# as Perl itself.
85759b3d2Safresh1#############################################################################
95759b3d2Safresh1
105759b3d2Safresh1package Pod::Parser;
115759b3d2Safresh1use strict;
12*256a93a4Safresh1use warnings;
135759b3d2Safresh1
145759b3d2Safresh1## These "variables" are used as local "glob aliases" for performance
155759b3d2Safresh1use vars qw($VERSION @ISA %myData %myOpts @input_stack);
165759b3d2Safresh1$VERSION = '1.60';  ## Current version of this package
175759b3d2Safresh1require  5.005;    ## requires this Perl version or later
185759b3d2Safresh1
195759b3d2Safresh1#############################################################################
205759b3d2Safresh1
215759b3d2Safresh1=head1 NAME
225759b3d2Safresh1
235759b3d2Safresh1Pod::Parser - base class for creating POD filters and translators
245759b3d2Safresh1
255759b3d2Safresh1=head1 SYNOPSIS
265759b3d2Safresh1
275759b3d2Safresh1    use Pod::Parser;
285759b3d2Safresh1
295759b3d2Safresh1    package MyParser;
305759b3d2Safresh1    @ISA = qw(Pod::Parser);
315759b3d2Safresh1
325759b3d2Safresh1    sub command {
335759b3d2Safresh1        my ($parser, $command, $paragraph, $line_num) = @_;
345759b3d2Safresh1        ## Interpret the command and its text; sample actions might be:
355759b3d2Safresh1        if ($command eq 'head1') { ... }
365759b3d2Safresh1        elsif ($command eq 'head2') { ... }
375759b3d2Safresh1        ## ... other commands and their actions
385759b3d2Safresh1        my $out_fh = $parser->output_handle();
395759b3d2Safresh1        my $expansion = $parser->interpolate($paragraph, $line_num);
405759b3d2Safresh1        print $out_fh $expansion;
415759b3d2Safresh1    }
425759b3d2Safresh1
435759b3d2Safresh1    sub verbatim {
445759b3d2Safresh1        my ($parser, $paragraph, $line_num) = @_;
455759b3d2Safresh1        ## Format verbatim paragraph; sample actions might be:
465759b3d2Safresh1        my $out_fh = $parser->output_handle();
475759b3d2Safresh1        print $out_fh $paragraph;
485759b3d2Safresh1    }
495759b3d2Safresh1
505759b3d2Safresh1    sub textblock {
515759b3d2Safresh1        my ($parser, $paragraph, $line_num) = @_;
525759b3d2Safresh1        ## Translate/Format this block of text; sample actions might be:
535759b3d2Safresh1        my $out_fh = $parser->output_handle();
545759b3d2Safresh1        my $expansion = $parser->interpolate($paragraph, $line_num);
555759b3d2Safresh1        print $out_fh $expansion;
565759b3d2Safresh1    }
575759b3d2Safresh1
585759b3d2Safresh1    sub interior_sequence {
595759b3d2Safresh1        my ($parser, $seq_command, $seq_argument) = @_;
605759b3d2Safresh1        ## Expand an interior sequence; sample actions might be:
615759b3d2Safresh1        return "*$seq_argument*"     if ($seq_command eq 'B');
625759b3d2Safresh1        return "`$seq_argument'"     if ($seq_command eq 'C');
635759b3d2Safresh1        return "_${seq_argument}_'"  if ($seq_command eq 'I');
645759b3d2Safresh1        ## ... other sequence commands and their resulting text
655759b3d2Safresh1    }
665759b3d2Safresh1
675759b3d2Safresh1    package main;
685759b3d2Safresh1
695759b3d2Safresh1    ## Create a parser object and have it parse file whose name was
705759b3d2Safresh1    ## given on the command-line (use STDIN if no files were given).
71*256a93a4Safresh1    $parser = MyParser->new();
725759b3d2Safresh1    $parser->parse_from_filehandle(\*STDIN)  if (@ARGV == 0);
735759b3d2Safresh1    for (@ARGV) { $parser->parse_from_file($_); }
745759b3d2Safresh1
755759b3d2Safresh1=head1 REQUIRES
765759b3d2Safresh1
775759b3d2Safresh1perl5.005, Pod::InputObjects, Exporter, Symbol, Carp
785759b3d2Safresh1
795759b3d2Safresh1=head1 EXPORTS
805759b3d2Safresh1
815759b3d2Safresh1Nothing.
825759b3d2Safresh1
835759b3d2Safresh1=head1 DESCRIPTION
845759b3d2Safresh1
855759b3d2Safresh1B<Pod::Parser> is a base class for creating POD filters and translators.
865759b3d2Safresh1It handles most of the effort involved with parsing the POD sections
875759b3d2Safresh1from an input stream, leaving subclasses free to be concerned only with
885759b3d2Safresh1performing the actual translation of text.
895759b3d2Safresh1
905759b3d2Safresh1B<Pod::Parser> parses PODs, and makes method calls to handle the various
915759b3d2Safresh1components of the POD. Subclasses of B<Pod::Parser> override these methods
925759b3d2Safresh1to translate the POD into whatever output format they desire.
935759b3d2Safresh1
945759b3d2Safresh1Note: This module is considered as legacy; modern Perl releases (5.18 and
955759b3d2Safresh1higher) are going to remove Pod::Parser from core and use L<Pod::Simple>
965759b3d2Safresh1for all things POD.
975759b3d2Safresh1
985759b3d2Safresh1=head1 QUICK OVERVIEW
995759b3d2Safresh1
1005759b3d2Safresh1To create a POD filter for translating POD documentation into some other
1015759b3d2Safresh1format, you create a subclass of B<Pod::Parser> which typically overrides
1025759b3d2Safresh1just the base class implementation for the following methods:
1035759b3d2Safresh1
1045759b3d2Safresh1=over 2
1055759b3d2Safresh1
1065759b3d2Safresh1=item *
1075759b3d2Safresh1
1085759b3d2Safresh1B<command()>
1095759b3d2Safresh1
1105759b3d2Safresh1=item *
1115759b3d2Safresh1
1125759b3d2Safresh1B<verbatim()>
1135759b3d2Safresh1
1145759b3d2Safresh1=item *
1155759b3d2Safresh1
1165759b3d2Safresh1B<textblock()>
1175759b3d2Safresh1
1185759b3d2Safresh1=item *
1195759b3d2Safresh1
1205759b3d2Safresh1B<interior_sequence()>
1215759b3d2Safresh1
1225759b3d2Safresh1=back
1235759b3d2Safresh1
1245759b3d2Safresh1You may also want to override the B<begin_input()> and B<end_input()>
1255759b3d2Safresh1methods for your subclass (to perform any needed per-file and/or
1265759b3d2Safresh1per-document initialization or cleanup).
1275759b3d2Safresh1
1285759b3d2Safresh1If you need to perform any preprocessing of input before it is parsed
1295759b3d2Safresh1you may want to override one or more of B<preprocess_line()> and/or
1305759b3d2Safresh1B<preprocess_paragraph()>.
1315759b3d2Safresh1
1325759b3d2Safresh1Sometimes it may be necessary to make more than one pass over the input
1335759b3d2Safresh1files. If this is the case you have several options. You can make the
1345759b3d2Safresh1first pass using B<Pod::Parser> and override your methods to store the
1355759b3d2Safresh1intermediate results in memory somewhere for the B<end_pod()> method to
1365759b3d2Safresh1process. You could use B<Pod::Parser> for several passes with an
1375759b3d2Safresh1appropriate state variable to control the operation for each pass. If
1385759b3d2Safresh1your input source can't be reset to start at the beginning, you can
1395759b3d2Safresh1store it in some other structure as a string or an array and have that
1405759b3d2Safresh1structure implement a B<getline()> method (which is all that
1415759b3d2Safresh1B<parse_from_filehandle()> uses to read input).
1425759b3d2Safresh1
1435759b3d2Safresh1Feel free to add any member data fields you need to keep track of things
1445759b3d2Safresh1like current font, indentation, horizontal or vertical position, or
1455759b3d2Safresh1whatever else you like. Be sure to read L<"PRIVATE METHODS AND DATA">
1465759b3d2Safresh1to avoid name collisions.
1475759b3d2Safresh1
1485759b3d2Safresh1For the most part, the B<Pod::Parser> base class should be able to
1495759b3d2Safresh1do most of the input parsing for you and leave you free to worry about
1505759b3d2Safresh1how to interpret the commands and translate the result.
1515759b3d2Safresh1
1525759b3d2Safresh1Note that all we have described here in this quick overview is the
1535759b3d2Safresh1simplest most straightforward use of B<Pod::Parser> to do stream-based
1545759b3d2Safresh1parsing. It is also possible to use the B<Pod::Parser::parse_text> function
1555759b3d2Safresh1to do more sophisticated tree-based parsing. See L<"TREE-BASED PARSING">.
1565759b3d2Safresh1
1575759b3d2Safresh1=head1 PARSING OPTIONS
1585759b3d2Safresh1
1595759b3d2Safresh1A I<parse-option> is simply a named option of B<Pod::Parser> with a
1605759b3d2Safresh1value that corresponds to a certain specified behavior. These various
1615759b3d2Safresh1behaviors of B<Pod::Parser> may be enabled/disabled by setting
1625759b3d2Safresh1or unsetting one or more I<parse-options> using the B<parseopts()> method.
1635759b3d2Safresh1The set of currently accepted parse-options is as follows:
1645759b3d2Safresh1
1655759b3d2Safresh1=over 3
1665759b3d2Safresh1
1675759b3d2Safresh1=item B<-want_nonPODs> (default: unset)
1685759b3d2Safresh1
1695759b3d2Safresh1Normally (by default) B<Pod::Parser> will only provide access to
1705759b3d2Safresh1the POD sections of the input. Input paragraphs that are not part
1715759b3d2Safresh1of the POD-format documentation are not made available to the caller
1725759b3d2Safresh1(not even using B<preprocess_paragraph()>). Setting this option to a
1735759b3d2Safresh1non-empty, non-zero value will allow B<preprocess_paragraph()> to see
1745759b3d2Safresh1non-POD sections of the input as well as POD sections. The B<cutting()>
1755759b3d2Safresh1method can be used to determine if the corresponding paragraph is a POD
1765759b3d2Safresh1paragraph, or some other input paragraph.
1775759b3d2Safresh1
1785759b3d2Safresh1=item B<-process_cut_cmd> (default: unset)
1795759b3d2Safresh1
1805759b3d2Safresh1Normally (by default) B<Pod::Parser> handles the C<=cut> POD directive
1815759b3d2Safresh1by itself and does not pass it on to the caller for processing. Setting
1825759b3d2Safresh1this option to a non-empty, non-zero value will cause B<Pod::Parser> to
1835759b3d2Safresh1pass the C<=cut> directive to the caller just like any other POD command
1845759b3d2Safresh1(and hence it may be processed by the B<command()> method).
1855759b3d2Safresh1
1865759b3d2Safresh1B<Pod::Parser> will still interpret the C<=cut> directive to mean that
1875759b3d2Safresh1"cutting mode" has been (re)entered, but the caller will get a chance
1885759b3d2Safresh1to capture the actual C<=cut> paragraph itself for whatever purpose
1895759b3d2Safresh1it desires.
1905759b3d2Safresh1
1915759b3d2Safresh1=item B<-warnings> (default: unset)
1925759b3d2Safresh1
1935759b3d2Safresh1Normally (by default) B<Pod::Parser> recognizes a bare minimum of
1945759b3d2Safresh1pod syntax errors and warnings and issues diagnostic messages
1955759b3d2Safresh1for errors, but not for warnings. (Use B<Pod::Checker> to do more
1965759b3d2Safresh1thorough checking of POD syntax.) Setting this option to a non-empty,
1975759b3d2Safresh1non-zero value will cause B<Pod::Parser> to issue diagnostics for
1985759b3d2Safresh1the few warnings it recognizes as well as the errors.
1995759b3d2Safresh1
2005759b3d2Safresh1=back
2015759b3d2Safresh1
2025759b3d2Safresh1Please see L<"parseopts()"> for a complete description of the interface
2035759b3d2Safresh1for the setting and unsetting of parse-options.
2045759b3d2Safresh1
2055759b3d2Safresh1=cut
2065759b3d2Safresh1
2075759b3d2Safresh1#############################################################################
2085759b3d2Safresh1
2095759b3d2Safresh1#use diagnostics;
2105759b3d2Safresh1use Pod::InputObjects;
2115759b3d2Safresh1use Carp;
2125759b3d2Safresh1use Exporter;
2135759b3d2Safresh1BEGIN {
2145759b3d2Safresh1   if ($] < 5.006) {
2155759b3d2Safresh1      require Symbol;
216*256a93a4Safresh1      Symbol->import;
2175759b3d2Safresh1   }
2185759b3d2Safresh1}
2195759b3d2Safresh1@ISA = qw(Exporter);
2205759b3d2Safresh1
2215759b3d2Safresh1#############################################################################
2225759b3d2Safresh1
2235759b3d2Safresh1=head1 RECOMMENDED SUBROUTINE/METHOD OVERRIDES
2245759b3d2Safresh1
2255759b3d2Safresh1B<Pod::Parser> provides several methods which most subclasses will probably
2265759b3d2Safresh1want to override. These methods are as follows:
2275759b3d2Safresh1
2285759b3d2Safresh1=cut
2295759b3d2Safresh1
2305759b3d2Safresh1##---------------------------------------------------------------------------
2315759b3d2Safresh1
2325759b3d2Safresh1=head1 B<command()>
2335759b3d2Safresh1
2345759b3d2Safresh1            $parser->command($cmd,$text,$line_num,$pod_para);
2355759b3d2Safresh1
2365759b3d2Safresh1This method should be overridden by subclasses to take the appropriate
2375759b3d2Safresh1action when a POD command paragraph (denoted by a line beginning with
2385759b3d2Safresh1"=") is encountered. When such a POD directive is seen in the input,
2395759b3d2Safresh1this method is called and is passed:
2405759b3d2Safresh1
2415759b3d2Safresh1=over 3
2425759b3d2Safresh1
2435759b3d2Safresh1=item C<$cmd>
2445759b3d2Safresh1
2455759b3d2Safresh1the name of the command for this POD paragraph
2465759b3d2Safresh1
2475759b3d2Safresh1=item C<$text>
2485759b3d2Safresh1
2495759b3d2Safresh1the paragraph text for the given POD paragraph command.
2505759b3d2Safresh1
2515759b3d2Safresh1=item C<$line_num>
2525759b3d2Safresh1
2535759b3d2Safresh1the line-number of the beginning of the paragraph
2545759b3d2Safresh1
2555759b3d2Safresh1=item C<$pod_para>
2565759b3d2Safresh1
2575759b3d2Safresh1a reference to a C<Pod::Paragraph> object which contains further
2585759b3d2Safresh1information about the paragraph command (see L<Pod::InputObjects>
2595759b3d2Safresh1for details).
2605759b3d2Safresh1
2615759b3d2Safresh1=back
2625759b3d2Safresh1
2635759b3d2Safresh1B<Note> that this method I<is> called for C<=pod> paragraphs.
2645759b3d2Safresh1
2655759b3d2Safresh1The base class implementation of this method simply treats the raw POD
2665759b3d2Safresh1command as normal block of paragraph text (invoking the B<textblock()>
2675759b3d2Safresh1method with the command paragraph).
2685759b3d2Safresh1
2695759b3d2Safresh1=cut
2705759b3d2Safresh1
2715759b3d2Safresh1sub command {
2725759b3d2Safresh1    my ($self, $cmd, $text, $line_num, $pod_para)  = @_;
2735759b3d2Safresh1    ## Just treat this like a textblock
2745759b3d2Safresh1    $self->textblock($pod_para->raw_text(), $line_num, $pod_para);
2755759b3d2Safresh1}
2765759b3d2Safresh1
2775759b3d2Safresh1##---------------------------------------------------------------------------
2785759b3d2Safresh1
2795759b3d2Safresh1=head1 B<verbatim()>
2805759b3d2Safresh1
2815759b3d2Safresh1            $parser->verbatim($text,$line_num,$pod_para);
2825759b3d2Safresh1
2835759b3d2Safresh1This method may be overridden by subclasses to take the appropriate
2845759b3d2Safresh1action when a block of verbatim text is encountered. It is passed the
2855759b3d2Safresh1following parameters:
2865759b3d2Safresh1
2875759b3d2Safresh1=over 3
2885759b3d2Safresh1
2895759b3d2Safresh1=item C<$text>
2905759b3d2Safresh1
2915759b3d2Safresh1the block of text for the verbatim paragraph
2925759b3d2Safresh1
2935759b3d2Safresh1=item C<$line_num>
2945759b3d2Safresh1
2955759b3d2Safresh1the line-number of the beginning of the paragraph
2965759b3d2Safresh1
2975759b3d2Safresh1=item C<$pod_para>
2985759b3d2Safresh1
2995759b3d2Safresh1a reference to a C<Pod::Paragraph> object which contains further
3005759b3d2Safresh1information about the paragraph (see L<Pod::InputObjects>
3015759b3d2Safresh1for details).
3025759b3d2Safresh1
3035759b3d2Safresh1=back
3045759b3d2Safresh1
3055759b3d2Safresh1The base class implementation of this method simply prints the textblock
3065759b3d2Safresh1(unmodified) to the output filehandle.
3075759b3d2Safresh1
3085759b3d2Safresh1=cut
3095759b3d2Safresh1
3105759b3d2Safresh1sub verbatim {
3115759b3d2Safresh1    my ($self, $text, $line_num, $pod_para) = @_;
3125759b3d2Safresh1    my $out_fh = $self->{_OUTPUT};
3135759b3d2Safresh1    print $out_fh $text;
3145759b3d2Safresh1}
3155759b3d2Safresh1
3165759b3d2Safresh1##---------------------------------------------------------------------------
3175759b3d2Safresh1
3185759b3d2Safresh1=head1 B<textblock()>
3195759b3d2Safresh1
3205759b3d2Safresh1            $parser->textblock($text,$line_num,$pod_para);
3215759b3d2Safresh1
3225759b3d2Safresh1This method may be overridden by subclasses to take the appropriate
3235759b3d2Safresh1action when a normal block of POD text is encountered (although the base
3245759b3d2Safresh1class method will usually do what you want). It is passed the following
3255759b3d2Safresh1parameters:
3265759b3d2Safresh1
3275759b3d2Safresh1=over 3
3285759b3d2Safresh1
3295759b3d2Safresh1=item C<$text>
3305759b3d2Safresh1
3315759b3d2Safresh1the block of text for the a POD paragraph
3325759b3d2Safresh1
3335759b3d2Safresh1=item C<$line_num>
3345759b3d2Safresh1
3355759b3d2Safresh1the line-number of the beginning of the paragraph
3365759b3d2Safresh1
3375759b3d2Safresh1=item C<$pod_para>
3385759b3d2Safresh1
3395759b3d2Safresh1a reference to a C<Pod::Paragraph> object which contains further
3405759b3d2Safresh1information about the paragraph (see L<Pod::InputObjects>
3415759b3d2Safresh1for details).
3425759b3d2Safresh1
3435759b3d2Safresh1=back
3445759b3d2Safresh1
3455759b3d2Safresh1In order to process interior sequences, subclasses implementations of
3465759b3d2Safresh1this method will probably want to invoke either B<interpolate()> or
3475759b3d2Safresh1B<parse_text()>, passing it the text block C<$text>, and the corresponding
3485759b3d2Safresh1line number in C<$line_num>, and then perform any desired processing upon
3495759b3d2Safresh1the returned result.
3505759b3d2Safresh1
3515759b3d2Safresh1The base class implementation of this method simply prints the text block
3525759b3d2Safresh1as it occurred in the input stream).
3535759b3d2Safresh1
3545759b3d2Safresh1=cut
3555759b3d2Safresh1
3565759b3d2Safresh1sub textblock {
3575759b3d2Safresh1    my ($self, $text, $line_num, $pod_para) = @_;
3585759b3d2Safresh1    my $out_fh = $self->{_OUTPUT};
3595759b3d2Safresh1    print $out_fh $self->interpolate($text, $line_num);
3605759b3d2Safresh1}
3615759b3d2Safresh1
3625759b3d2Safresh1##---------------------------------------------------------------------------
3635759b3d2Safresh1
3645759b3d2Safresh1=head1 B<interior_sequence()>
3655759b3d2Safresh1
3665759b3d2Safresh1            $parser->interior_sequence($seq_cmd,$seq_arg,$pod_seq);
3675759b3d2Safresh1
3685759b3d2Safresh1This method should be overridden by subclasses to take the appropriate
3695759b3d2Safresh1action when an interior sequence is encountered. An interior sequence is
3705759b3d2Safresh1an embedded command within a block of text which appears as a command
3715759b3d2Safresh1name (usually a single uppercase character) followed immediately by a
3725759b3d2Safresh1string of text which is enclosed in angle brackets. This method is
3735759b3d2Safresh1passed the sequence command C<$seq_cmd> and the corresponding text
3745759b3d2Safresh1C<$seq_arg>. It is invoked by the B<interpolate()> method for each interior
3755759b3d2Safresh1sequence that occurs in the string that it is passed. It should return
3765759b3d2Safresh1the desired text string to be used in place of the interior sequence.
3775759b3d2Safresh1The C<$pod_seq> argument is a reference to a C<Pod::InteriorSequence>
3785759b3d2Safresh1object which contains further information about the interior sequence.
3795759b3d2Safresh1Please see L<Pod::InputObjects> for details if you need to access this
3805759b3d2Safresh1additional information.
3815759b3d2Safresh1
3825759b3d2Safresh1Subclass implementations of this method may wish to invoke the
3835759b3d2Safresh1B<nested()> method of C<$pod_seq> to see if it is nested inside
3845759b3d2Safresh1some other interior-sequence (and if so, which kind).
3855759b3d2Safresh1
3865759b3d2Safresh1The base class implementation of the B<interior_sequence()> method
3875759b3d2Safresh1simply returns the raw text of the interior sequence (as it occurred
3885759b3d2Safresh1in the input) to the caller.
3895759b3d2Safresh1
3905759b3d2Safresh1=cut
3915759b3d2Safresh1
3925759b3d2Safresh1sub interior_sequence {
3935759b3d2Safresh1    my ($self, $seq_cmd, $seq_arg, $pod_seq) = @_;
3945759b3d2Safresh1    ## Just return the raw text of the interior sequence
3955759b3d2Safresh1    return  $pod_seq->raw_text();
3965759b3d2Safresh1}
3975759b3d2Safresh1
3985759b3d2Safresh1#############################################################################
3995759b3d2Safresh1
4005759b3d2Safresh1=head1 OPTIONAL SUBROUTINE/METHOD OVERRIDES
4015759b3d2Safresh1
4025759b3d2Safresh1B<Pod::Parser> provides several methods which subclasses may want to override
4035759b3d2Safresh1to perform any special pre/post-processing. These methods do I<not> have to
4045759b3d2Safresh1be overridden, but it may be useful for subclasses to take advantage of them.
4055759b3d2Safresh1
4065759b3d2Safresh1=cut
4075759b3d2Safresh1
4085759b3d2Safresh1##---------------------------------------------------------------------------
4095759b3d2Safresh1
4105759b3d2Safresh1=head1 B<new()>
4115759b3d2Safresh1
4125759b3d2Safresh1            my $parser = Pod::Parser->new();
4135759b3d2Safresh1
4145759b3d2Safresh1This is the constructor for B<Pod::Parser> and its subclasses. You
4155759b3d2Safresh1I<do not> need to override this method! It is capable of constructing
4165759b3d2Safresh1subclass objects as well as base class objects, provided you use
4175759b3d2Safresh1any of the following constructor invocation styles:
4185759b3d2Safresh1
4195759b3d2Safresh1    my $parser1 = MyParser->new();
420*256a93a4Safresh1    my $parser2 = $parser1->new();
4215759b3d2Safresh1
4225759b3d2Safresh1where C<MyParser> is some subclass of B<Pod::Parser>.
4235759b3d2Safresh1
4245759b3d2Safresh1Using the syntax C<MyParser::new()> to invoke the constructor is I<not>
4255759b3d2Safresh1recommended, but if you insist on being able to do this, then the
4265759b3d2Safresh1subclass I<will> need to override the B<new()> constructor method. If
4275759b3d2Safresh1you do override the constructor, you I<must> be sure to invoke the
4285759b3d2Safresh1B<initialize()> method of the newly blessed object.
4295759b3d2Safresh1
4305759b3d2Safresh1Using any of the above invocations, the first argument to the
4315759b3d2Safresh1constructor is always the corresponding package name (or object
4325759b3d2Safresh1reference). No other arguments are required, but if desired, an
4335759b3d2Safresh1associative array (or hash-table) my be passed to the B<new()>
4345759b3d2Safresh1constructor, as in:
4355759b3d2Safresh1
4365759b3d2Safresh1    my $parser1 = MyParser->new( MYDATA => $value1, MOREDATA => $value2 );
437*256a93a4Safresh1    my $parser2 = MyParser->new( -myflag => 1 );
4385759b3d2Safresh1
4395759b3d2Safresh1All arguments passed to the B<new()> constructor will be treated as
4405759b3d2Safresh1key/value pairs in a hash-table. The newly constructed object will be
4415759b3d2Safresh1initialized by copying the contents of the given hash-table (which may
4425759b3d2Safresh1have been empty). The B<new()> constructor for this class and all of its
4435759b3d2Safresh1subclasses returns a blessed reference to the initialized object (hash-table).
4445759b3d2Safresh1
4455759b3d2Safresh1=cut
4465759b3d2Safresh1
4475759b3d2Safresh1sub new {
4485759b3d2Safresh1    ## Determine if we were called via an object-ref or a classname
4495759b3d2Safresh1    my ($this,%params) = @_;
4505759b3d2Safresh1    my $class = ref($this) || $this;
4515759b3d2Safresh1    ## Any remaining arguments are treated as initial values for the
4525759b3d2Safresh1    ## hash that is used to represent this object.
4535759b3d2Safresh1    my $self = { %params };
4545759b3d2Safresh1    ## Bless ourselves into the desired class and perform any initialization
4555759b3d2Safresh1    bless $self, $class;
4565759b3d2Safresh1    $self->initialize();
4575759b3d2Safresh1    return $self;
4585759b3d2Safresh1}
4595759b3d2Safresh1
4605759b3d2Safresh1##---------------------------------------------------------------------------
4615759b3d2Safresh1
4625759b3d2Safresh1=head1 B<initialize()>
4635759b3d2Safresh1
4645759b3d2Safresh1            $parser->initialize();
4655759b3d2Safresh1
4665759b3d2Safresh1This method performs any necessary object initialization. It takes no
4675759b3d2Safresh1arguments (other than the object instance of course, which is typically
4685759b3d2Safresh1copied to a local variable named C<$self>). If subclasses override this
4695759b3d2Safresh1method then they I<must> be sure to invoke C<$self-E<gt>SUPER::initialize()>.
4705759b3d2Safresh1
4715759b3d2Safresh1=cut
4725759b3d2Safresh1
4735759b3d2Safresh1sub initialize {
4745759b3d2Safresh1    #my $self = shift;
4755759b3d2Safresh1    #return;
4765759b3d2Safresh1}
4775759b3d2Safresh1
4785759b3d2Safresh1##---------------------------------------------------------------------------
4795759b3d2Safresh1
4805759b3d2Safresh1=head1 B<begin_pod()>
4815759b3d2Safresh1
4825759b3d2Safresh1            $parser->begin_pod();
4835759b3d2Safresh1
4845759b3d2Safresh1This method is invoked at the beginning of processing for each POD
4855759b3d2Safresh1document that is encountered in the input. Subclasses should override
4865759b3d2Safresh1this method to perform any per-document initialization.
4875759b3d2Safresh1
4885759b3d2Safresh1=cut
4895759b3d2Safresh1
4905759b3d2Safresh1sub begin_pod {
4915759b3d2Safresh1    #my $self = shift;
4925759b3d2Safresh1    #return;
4935759b3d2Safresh1}
4945759b3d2Safresh1
4955759b3d2Safresh1##---------------------------------------------------------------------------
4965759b3d2Safresh1
4975759b3d2Safresh1=head1 B<begin_input()>
4985759b3d2Safresh1
4995759b3d2Safresh1            $parser->begin_input();
5005759b3d2Safresh1
5015759b3d2Safresh1This method is invoked by B<parse_from_filehandle()> immediately I<before>
5025759b3d2Safresh1processing input from a filehandle. The base class implementation does
5035759b3d2Safresh1nothing, however, subclasses may override it to perform any per-file
5045759b3d2Safresh1initializations.
5055759b3d2Safresh1
5065759b3d2Safresh1Note that if multiple files are parsed for a single POD document
5075759b3d2Safresh1(perhaps the result of some future C<=include> directive) this method
5085759b3d2Safresh1is invoked for every file that is parsed. If you wish to perform certain
5095759b3d2Safresh1initializations once per document, then you should use B<begin_pod()>.
5105759b3d2Safresh1
5115759b3d2Safresh1=cut
5125759b3d2Safresh1
5135759b3d2Safresh1sub begin_input {
5145759b3d2Safresh1    #my $self = shift;
5155759b3d2Safresh1    #return;
5165759b3d2Safresh1}
5175759b3d2Safresh1
5185759b3d2Safresh1##---------------------------------------------------------------------------
5195759b3d2Safresh1
5205759b3d2Safresh1=head1 B<end_input()>
5215759b3d2Safresh1
5225759b3d2Safresh1            $parser->end_input();
5235759b3d2Safresh1
5245759b3d2Safresh1This method is invoked by B<parse_from_filehandle()> immediately I<after>
5255759b3d2Safresh1processing input from a filehandle. The base class implementation does
5265759b3d2Safresh1nothing, however, subclasses may override it to perform any per-file
5275759b3d2Safresh1cleanup actions.
5285759b3d2Safresh1
5295759b3d2Safresh1Please note that if multiple files are parsed for a single POD document
5305759b3d2Safresh1(perhaps the result of some kind of C<=include> directive) this method
5315759b3d2Safresh1is invoked for every file that is parsed. If you wish to perform certain
5325759b3d2Safresh1cleanup actions once per document, then you should use B<end_pod()>.
5335759b3d2Safresh1
5345759b3d2Safresh1=cut
5355759b3d2Safresh1
5365759b3d2Safresh1sub end_input {
5375759b3d2Safresh1    #my $self = shift;
5385759b3d2Safresh1    #return;
5395759b3d2Safresh1}
5405759b3d2Safresh1
5415759b3d2Safresh1##---------------------------------------------------------------------------
5425759b3d2Safresh1
5435759b3d2Safresh1=head1 B<end_pod()>
5445759b3d2Safresh1
5455759b3d2Safresh1            $parser->end_pod();
5465759b3d2Safresh1
5475759b3d2Safresh1This method is invoked at the end of processing for each POD document
5485759b3d2Safresh1that is encountered in the input. Subclasses should override this method
5495759b3d2Safresh1to perform any per-document finalization.
5505759b3d2Safresh1
5515759b3d2Safresh1=cut
5525759b3d2Safresh1
5535759b3d2Safresh1sub end_pod {
5545759b3d2Safresh1    #my $self = shift;
5555759b3d2Safresh1    #return;
5565759b3d2Safresh1}
5575759b3d2Safresh1
5585759b3d2Safresh1##---------------------------------------------------------------------------
5595759b3d2Safresh1
5605759b3d2Safresh1=head1 B<preprocess_line()>
5615759b3d2Safresh1
5625759b3d2Safresh1          $textline = $parser->preprocess_line($text, $line_num);
5635759b3d2Safresh1
5645759b3d2Safresh1This method should be overridden by subclasses that wish to perform
5655759b3d2Safresh1any kind of preprocessing for each I<line> of input (I<before> it has
5665759b3d2Safresh1been determined whether or not it is part of a POD paragraph). The
5675759b3d2Safresh1parameter C<$text> is the input line; and the parameter C<$line_num> is
5685759b3d2Safresh1the line number of the corresponding text line.
5695759b3d2Safresh1
5705759b3d2Safresh1The value returned should correspond to the new text to use in its
5715759b3d2Safresh1place.  If the empty string or an undefined value is returned then no
5725759b3d2Safresh1further processing will be performed for this line.
5735759b3d2Safresh1
5745759b3d2Safresh1Please note that the B<preprocess_line()> method is invoked I<before>
5755759b3d2Safresh1the B<preprocess_paragraph()> method. After all (possibly preprocessed)
5765759b3d2Safresh1lines in a paragraph have been assembled together and it has been
5775759b3d2Safresh1determined that the paragraph is part of the POD documentation from one
5785759b3d2Safresh1of the selected sections, then B<preprocess_paragraph()> is invoked.
5795759b3d2Safresh1
5805759b3d2Safresh1The base class implementation of this method returns the given text.
5815759b3d2Safresh1
5825759b3d2Safresh1=cut
5835759b3d2Safresh1
5845759b3d2Safresh1sub preprocess_line {
5855759b3d2Safresh1    my ($self, $text, $line_num) = @_;
5865759b3d2Safresh1    return  $text;
5875759b3d2Safresh1}
5885759b3d2Safresh1
5895759b3d2Safresh1##---------------------------------------------------------------------------
5905759b3d2Safresh1
5915759b3d2Safresh1=head1 B<preprocess_paragraph()>
5925759b3d2Safresh1
5935759b3d2Safresh1            $textblock = $parser->preprocess_paragraph($text, $line_num);
5945759b3d2Safresh1
5955759b3d2Safresh1This method should be overridden by subclasses that wish to perform any
5965759b3d2Safresh1kind of preprocessing for each block (paragraph) of POD documentation
5975759b3d2Safresh1that appears in the input stream. The parameter C<$text> is the POD
5985759b3d2Safresh1paragraph from the input file; and the parameter C<$line_num> is the
5995759b3d2Safresh1line number for the beginning of the corresponding paragraph.
6005759b3d2Safresh1
6015759b3d2Safresh1The value returned should correspond to the new text to use in its
6025759b3d2Safresh1place If the empty string is returned or an undefined value is
6035759b3d2Safresh1returned, then the given C<$text> is ignored (not processed).
6045759b3d2Safresh1
6055759b3d2Safresh1This method is invoked after gathering up all the lines in a paragraph
6065759b3d2Safresh1and after determining the cutting state of the paragraph,
6075759b3d2Safresh1but before trying to further parse or interpret them. After
6085759b3d2Safresh1B<preprocess_paragraph()> returns, the current cutting state (which
6095759b3d2Safresh1is returned by C<$self-E<gt>cutting()>) is examined. If it evaluates
6105759b3d2Safresh1to true then input text (including the given C<$text>) is cut (not
6115759b3d2Safresh1processed) until the next POD directive is encountered.
6125759b3d2Safresh1
6135759b3d2Safresh1Please note that the B<preprocess_line()> method is invoked I<before>
6145759b3d2Safresh1the B<preprocess_paragraph()> method. After all (possibly preprocessed)
6155759b3d2Safresh1lines in a paragraph have been assembled together and either it has been
6165759b3d2Safresh1determined that the paragraph is part of the POD documentation from one
6175759b3d2Safresh1of the selected sections or the C<-want_nonPODs> option is true,
6185759b3d2Safresh1then B<preprocess_paragraph()> is invoked.
6195759b3d2Safresh1
6205759b3d2Safresh1The base class implementation of this method returns the given text.
6215759b3d2Safresh1
6225759b3d2Safresh1=cut
6235759b3d2Safresh1
6245759b3d2Safresh1sub preprocess_paragraph {
6255759b3d2Safresh1    my ($self, $text, $line_num) = @_;
6265759b3d2Safresh1    return  $text;
6275759b3d2Safresh1}
6285759b3d2Safresh1
6295759b3d2Safresh1#############################################################################
6305759b3d2Safresh1
6315759b3d2Safresh1=head1 METHODS FOR PARSING AND PROCESSING
6325759b3d2Safresh1
6335759b3d2Safresh1B<Pod::Parser> provides several methods to process input text. These
6345759b3d2Safresh1methods typically won't need to be overridden (and in some cases they
6355759b3d2Safresh1can't be overridden), but subclasses may want to invoke them to exploit
6365759b3d2Safresh1their functionality.
6375759b3d2Safresh1
6385759b3d2Safresh1=cut
6395759b3d2Safresh1
6405759b3d2Safresh1##---------------------------------------------------------------------------
6415759b3d2Safresh1
6425759b3d2Safresh1=head1 B<parse_text()>
6435759b3d2Safresh1
6445759b3d2Safresh1            $ptree1 = $parser->parse_text($text, $line_num);
6455759b3d2Safresh1            $ptree2 = $parser->parse_text({%opts}, $text, $line_num);
6465759b3d2Safresh1            $ptree3 = $parser->parse_text(\%opts, $text, $line_num);
6475759b3d2Safresh1
6485759b3d2Safresh1This method is useful if you need to perform your own interpolation
6495759b3d2Safresh1of interior sequences and can't rely upon B<interpolate> to expand
6505759b3d2Safresh1them in simple bottom-up order.
6515759b3d2Safresh1
6525759b3d2Safresh1The parameter C<$text> is a string or block of text to be parsed
6535759b3d2Safresh1for interior sequences; and the parameter C<$line_num> is the
6545759b3d2Safresh1line number corresponding to the beginning of C<$text>.
6555759b3d2Safresh1
6565759b3d2Safresh1B<parse_text()> will parse the given text into a parse-tree of "nodes."
6575759b3d2Safresh1and interior-sequences.  Each "node" in the parse tree is either a
6585759b3d2Safresh1text-string, or a B<Pod::InteriorSequence>.  The result returned is a
6595759b3d2Safresh1parse-tree of type B<Pod::ParseTree>. Please see L<Pod::InputObjects>
6605759b3d2Safresh1for more information about B<Pod::InteriorSequence> and B<Pod::ParseTree>.
6615759b3d2Safresh1
6625759b3d2Safresh1If desired, an optional hash-ref may be specified as the first argument
6635759b3d2Safresh1to customize certain aspects of the parse-tree that is created and
6645759b3d2Safresh1returned. The set of recognized option keywords are:
6655759b3d2Safresh1
6665759b3d2Safresh1=over 3
6675759b3d2Safresh1
6685759b3d2Safresh1=item B<-expand_seq> =E<gt> I<code-ref>|I<method-name>
6695759b3d2Safresh1
6705759b3d2Safresh1Normally, the parse-tree returned by B<parse_text()> will contain an
6715759b3d2Safresh1unexpanded C<Pod::InteriorSequence> object for each interior-sequence
6725759b3d2Safresh1encountered. Specifying B<-expand_seq> tells B<parse_text()> to "expand"
6735759b3d2Safresh1every interior-sequence it sees by invoking the referenced function
6745759b3d2Safresh1(or named method of the parser object) and using the return value as the
6755759b3d2Safresh1expanded result.
6765759b3d2Safresh1
6775759b3d2Safresh1If a subroutine reference was given, it is invoked as:
6785759b3d2Safresh1
6795759b3d2Safresh1  &$code_ref( $parser, $sequence )
6805759b3d2Safresh1
6815759b3d2Safresh1and if a method-name was given, it is invoked as:
6825759b3d2Safresh1
6835759b3d2Safresh1  $parser->method_name( $sequence )
6845759b3d2Safresh1
6855759b3d2Safresh1where C<$parser> is a reference to the parser object, and C<$sequence>
6865759b3d2Safresh1is a reference to the interior-sequence object.
6875759b3d2Safresh1[I<NOTE>: If the B<interior_sequence()> method is specified, then it is
6885759b3d2Safresh1invoked according to the interface specified in L<"interior_sequence()">].
6895759b3d2Safresh1
6905759b3d2Safresh1=item B<-expand_text> =E<gt> I<code-ref>|I<method-name>
6915759b3d2Safresh1
6925759b3d2Safresh1Normally, the parse-tree returned by B<parse_text()> will contain a
6935759b3d2Safresh1text-string for each contiguous sequence of characters outside of an
6945759b3d2Safresh1interior-sequence. Specifying B<-expand_text> tells B<parse_text()> to
6955759b3d2Safresh1"preprocess" every such text-string it sees by invoking the referenced
6965759b3d2Safresh1function (or named method of the parser object) and using the return value
6975759b3d2Safresh1as the preprocessed (or "expanded") result. [Note that if the result is
6985759b3d2Safresh1an interior-sequence, then it will I<not> be expanded as specified by the
6995759b3d2Safresh1B<-expand_seq> option; Any such recursive expansion needs to be handled by
7005759b3d2Safresh1the specified callback routine.]
7015759b3d2Safresh1
7025759b3d2Safresh1If a subroutine reference was given, it is invoked as:
7035759b3d2Safresh1
7045759b3d2Safresh1  &$code_ref( $parser, $text, $ptree_node )
7055759b3d2Safresh1
7065759b3d2Safresh1and if a method-name was given, it is invoked as:
7075759b3d2Safresh1
7085759b3d2Safresh1  $parser->method_name( $text, $ptree_node )
7095759b3d2Safresh1
7105759b3d2Safresh1where C<$parser> is a reference to the parser object, C<$text> is the
7115759b3d2Safresh1text-string encountered, and C<$ptree_node> is a reference to the current
7125759b3d2Safresh1node in the parse-tree (usually an interior-sequence object or else the
7135759b3d2Safresh1top-level node of the parse-tree).
7145759b3d2Safresh1
7155759b3d2Safresh1=item B<-expand_ptree> =E<gt> I<code-ref>|I<method-name>
7165759b3d2Safresh1
7175759b3d2Safresh1Rather than returning a C<Pod::ParseTree>, pass the parse-tree as an
7185759b3d2Safresh1argument to the referenced subroutine (or named method of the parser
7195759b3d2Safresh1object) and return the result instead of the parse-tree object.
7205759b3d2Safresh1
7215759b3d2Safresh1If a subroutine reference was given, it is invoked as:
7225759b3d2Safresh1
7235759b3d2Safresh1  &$code_ref( $parser, $ptree )
7245759b3d2Safresh1
7255759b3d2Safresh1and if a method-name was given, it is invoked as:
7265759b3d2Safresh1
7275759b3d2Safresh1  $parser->method_name( $ptree )
7285759b3d2Safresh1
7295759b3d2Safresh1where C<$parser> is a reference to the parser object, and C<$ptree>
7305759b3d2Safresh1is a reference to the parse-tree object.
7315759b3d2Safresh1
7325759b3d2Safresh1=back
7335759b3d2Safresh1
7345759b3d2Safresh1=cut
7355759b3d2Safresh1
7365759b3d2Safresh1sub parse_text {
7375759b3d2Safresh1    my $self = shift;
7385759b3d2Safresh1    local $_ = '';
7395759b3d2Safresh1
7405759b3d2Safresh1    ## Get options and set any defaults
7415759b3d2Safresh1    my %opts = (ref $_[0]) ? %{ shift() } : ();
7425759b3d2Safresh1    my $expand_seq   = $opts{'-expand_seq'}   || undef;
7435759b3d2Safresh1    my $expand_text  = $opts{'-expand_text'}  || undef;
7445759b3d2Safresh1    my $expand_ptree = $opts{'-expand_ptree'} || undef;
7455759b3d2Safresh1
7465759b3d2Safresh1    my $text = shift;
7475759b3d2Safresh1    my $line = shift;
7485759b3d2Safresh1    my $file = $self->input_file();
7495759b3d2Safresh1    my $cmd  = "";
7505759b3d2Safresh1
7515759b3d2Safresh1    ## Convert method calls into closures, for our convenience
7525759b3d2Safresh1    my $xseq_sub   = $expand_seq;
7535759b3d2Safresh1    my $xtext_sub  = $expand_text;
7545759b3d2Safresh1    my $xptree_sub = $expand_ptree;
7555759b3d2Safresh1    if (defined $expand_seq  and  $expand_seq eq 'interior_sequence') {
7565759b3d2Safresh1        ## If 'interior_sequence' is the method to use, we have to pass
7575759b3d2Safresh1        ## more than just the sequence object, we also need to pass the
7585759b3d2Safresh1        ## sequence name and text.
7595759b3d2Safresh1        $xseq_sub = sub {
7605759b3d2Safresh1            my ($sself, $iseq) = @_;
7615759b3d2Safresh1            my $args = join('', $iseq->parse_tree->children);
7625759b3d2Safresh1            return  $sself->interior_sequence($iseq->name, $args, $iseq);
7635759b3d2Safresh1        };
7645759b3d2Safresh1    }
7655759b3d2Safresh1    ref $xseq_sub    or  $xseq_sub   = sub { shift()->$expand_seq(@_) };
7665759b3d2Safresh1    ref $xtext_sub   or  $xtext_sub  = sub { shift()->$expand_text(@_) };
7675759b3d2Safresh1    ref $xptree_sub  or  $xptree_sub = sub { shift()->$expand_ptree(@_) };
7685759b3d2Safresh1
7695759b3d2Safresh1    ## Keep track of the "current" interior sequence, and maintain a stack
7705759b3d2Safresh1    ## of "in progress" sequences.
7715759b3d2Safresh1    ##
7725759b3d2Safresh1    ## NOTE that we push our own "accumulator" at the very beginning of the
7735759b3d2Safresh1    ## stack. It's really a parse-tree, not a sequence; but it implements
7745759b3d2Safresh1    ## the methods we need so we can use it to gather-up all the sequences
7755759b3d2Safresh1    ## and strings we parse. Thus, by the end of our parsing, it should be
7765759b3d2Safresh1    ## the only thing left on our stack and all we have to do is return it!
7775759b3d2Safresh1    ##
7785759b3d2Safresh1    my $seq       = Pod::ParseTree->new();
7795759b3d2Safresh1    my @seq_stack = ($seq);
7805759b3d2Safresh1    my ($ldelim, $rdelim) = ('', '');
7815759b3d2Safresh1
7825759b3d2Safresh1    ## Iterate over all sequence starts text (NOTE: split with
7835759b3d2Safresh1    ## capturing parens keeps the delimiters)
7845759b3d2Safresh1    $_ = $text;
7855759b3d2Safresh1    my @tokens = split /([A-Z]<(?:<+(?:\r?\n|[ \t]))?)/;
7865759b3d2Safresh1    while ( @tokens ) {
7875759b3d2Safresh1        $_ = shift @tokens;
7885759b3d2Safresh1        ## Look for the beginning of a sequence
7895759b3d2Safresh1        if ( /^([A-Z])(<(?:<+(?:\r?\n|[ \t]))?)$/ ) {
7905759b3d2Safresh1            ## Push a new sequence onto the stack of those "in-progress"
7915759b3d2Safresh1            my $ldelim_orig;
7925759b3d2Safresh1            ($cmd, $ldelim_orig) = ($1, $2);
7935759b3d2Safresh1            ($ldelim = $ldelim_orig) =~ s/\s+$//;
7945759b3d2Safresh1            ($rdelim = $ldelim) =~ tr/</>/;
7955759b3d2Safresh1            $seq = Pod::InteriorSequence->new(
7965759b3d2Safresh1                       -name   => $cmd,
7975759b3d2Safresh1                       -ldelim => $ldelim_orig,  -rdelim => $rdelim,
7985759b3d2Safresh1                       -file   => $file,    -line   => $line
7995759b3d2Safresh1                   );
8005759b3d2Safresh1            (@seq_stack > 1)  and  $seq->nested($seq_stack[-1]);
8015759b3d2Safresh1            push @seq_stack, $seq;
8025759b3d2Safresh1        }
8035759b3d2Safresh1        ## Look for sequence ending
8045759b3d2Safresh1        elsif ( @seq_stack > 1 ) {
8055759b3d2Safresh1            ## Make sure we match the right kind of closing delimiter
8065759b3d2Safresh1            my ($seq_end, $post_seq) = ('', '');
8075759b3d2Safresh1            if ( ($ldelim eq '<'   and  /\A(.*?)(>)/s)
8085759b3d2Safresh1                 or  /\A(.*?)(\s+$rdelim)/s )
8095759b3d2Safresh1            {
8105759b3d2Safresh1                ## Found end-of-sequence, capture the interior and the
8115759b3d2Safresh1                ## closing the delimiter, and put the rest back on the
8125759b3d2Safresh1                ## token-list
8135759b3d2Safresh1                $post_seq = substr($_, length($1) + length($2));
8145759b3d2Safresh1                ($_, $seq_end) = ($1, $2);
8155759b3d2Safresh1                (length $post_seq)  and  unshift @tokens, $post_seq;
8165759b3d2Safresh1            }
8175759b3d2Safresh1            if (length) {
8185759b3d2Safresh1                ## In the middle of a sequence, append this text to it, and
8195759b3d2Safresh1                ## dont forget to "expand" it if that's what the caller wanted
8205759b3d2Safresh1                $seq->append($expand_text ? &$xtext_sub($self,$_,$seq) : $_);
8215759b3d2Safresh1                $_ .= $seq_end;
8225759b3d2Safresh1            }
8235759b3d2Safresh1            if (length $seq_end) {
8245759b3d2Safresh1                ## End of current sequence, record terminating delimiter
8255759b3d2Safresh1                $seq->rdelim($seq_end);
8265759b3d2Safresh1                ## Pop it off the stack of "in progress" sequences
8275759b3d2Safresh1                pop @seq_stack;
8285759b3d2Safresh1                ## Append result to its parent in current parse tree
8295759b3d2Safresh1                $seq_stack[-1]->append($expand_seq ? &$xseq_sub($self,$seq)
8305759b3d2Safresh1                                                   : $seq);
8315759b3d2Safresh1                ## Remember the current cmd-name and left-delimiter
8325759b3d2Safresh1                if(@seq_stack > 1) {
8335759b3d2Safresh1                    $cmd = $seq_stack[-1]->name;
8345759b3d2Safresh1                    $ldelim = $seq_stack[-1]->ldelim;
8355759b3d2Safresh1                    $rdelim = $seq_stack[-1]->rdelim;
8365759b3d2Safresh1                } else {
8375759b3d2Safresh1                    $cmd = $ldelim = $rdelim = '';
8385759b3d2Safresh1                }
8395759b3d2Safresh1            }
8405759b3d2Safresh1        }
8415759b3d2Safresh1        elsif (length) {
8425759b3d2Safresh1            ## In the middle of a sequence, append this text to it, and
8435759b3d2Safresh1            ## dont forget to "expand" it if that's what the caller wanted
8445759b3d2Safresh1            $seq->append($expand_text ? &$xtext_sub($self,$_,$seq) : $_);
8455759b3d2Safresh1        }
8465759b3d2Safresh1        ## Keep track of line count
8475759b3d2Safresh1        $line += /\n/;
8485759b3d2Safresh1        ## Remember the "current" sequence
8495759b3d2Safresh1        $seq = $seq_stack[-1];
8505759b3d2Safresh1    }
8515759b3d2Safresh1
8525759b3d2Safresh1    ## Handle unterminated sequences
8535759b3d2Safresh1    my $errorsub = (@seq_stack > 1) ? $self->errorsub() : undef;
8545759b3d2Safresh1    while (@seq_stack > 1) {
8555759b3d2Safresh1       ($cmd, $file, $line) = ($seq->name, $seq->file_line);
8565759b3d2Safresh1       $ldelim  = $seq->ldelim;
8575759b3d2Safresh1       ($rdelim = $ldelim) =~ tr/</>/;
8585759b3d2Safresh1       $rdelim  =~ s/^(\S+)(\s*)$/$2$1/;
8595759b3d2Safresh1       pop @seq_stack;
8605759b3d2Safresh1       my $errmsg = "*** ERROR: unterminated ${cmd}${ldelim}...${rdelim}".
8615759b3d2Safresh1                    " at line $line in file $file\n";
8625759b3d2Safresh1       (ref $errorsub) and &{$errorsub}($errmsg)
8635759b3d2Safresh1           or (defined $errorsub) and $self->$errorsub($errmsg)
8645759b3d2Safresh1               or  carp($errmsg);
8655759b3d2Safresh1       $seq_stack[-1]->append($expand_seq ? &$xseq_sub($self,$seq) : $seq);
8665759b3d2Safresh1       $seq = $seq_stack[-1];
8675759b3d2Safresh1    }
8685759b3d2Safresh1
8695759b3d2Safresh1    ## Return the resulting parse-tree
8705759b3d2Safresh1    my $ptree = (pop @seq_stack)->parse_tree;
8715759b3d2Safresh1    return  $expand_ptree ? &$xptree_sub($self, $ptree) : $ptree;
8725759b3d2Safresh1}
8735759b3d2Safresh1
8745759b3d2Safresh1##---------------------------------------------------------------------------
8755759b3d2Safresh1
8765759b3d2Safresh1=head1 B<interpolate()>
8775759b3d2Safresh1
8785759b3d2Safresh1            $textblock = $parser->interpolate($text, $line_num);
8795759b3d2Safresh1
8805759b3d2Safresh1This method translates all text (including any embedded interior sequences)
8815759b3d2Safresh1in the given text string C<$text> and returns the interpolated result. The
8825759b3d2Safresh1parameter C<$line_num> is the line number corresponding to the beginning
8835759b3d2Safresh1of C<$text>.
8845759b3d2Safresh1
8855759b3d2Safresh1B<interpolate()> merely invokes a private method to recursively expand
8865759b3d2Safresh1nested interior sequences in bottom-up order (innermost sequences are
8875759b3d2Safresh1expanded first). If there is a need to expand nested sequences in
8885759b3d2Safresh1some alternate order, use B<parse_text> instead.
8895759b3d2Safresh1
8905759b3d2Safresh1=cut
8915759b3d2Safresh1
8925759b3d2Safresh1sub interpolate {
8935759b3d2Safresh1    my($self, $text, $line_num) = @_;
8945759b3d2Safresh1    my %parse_opts = ( -expand_seq => 'interior_sequence' );
8955759b3d2Safresh1    my $ptree = $self->parse_text( \%parse_opts, $text, $line_num );
8965759b3d2Safresh1    return  join '', $ptree->children();
8975759b3d2Safresh1}
8985759b3d2Safresh1
8995759b3d2Safresh1##---------------------------------------------------------------------------
9005759b3d2Safresh1
9015759b3d2Safresh1=begin __PRIVATE__
9025759b3d2Safresh1
9035759b3d2Safresh1=head1 B<parse_paragraph()>
9045759b3d2Safresh1
9055759b3d2Safresh1            $parser->parse_paragraph($text, $line_num);
9065759b3d2Safresh1
9075759b3d2Safresh1This method takes the text of a POD paragraph to be processed, along
9085759b3d2Safresh1with its corresponding line number, and invokes the appropriate method
9095759b3d2Safresh1(one of B<command()>, B<verbatim()>, or B<textblock()>).
9105759b3d2Safresh1
9115759b3d2Safresh1For performance reasons, this method is invoked directly without any
9125759b3d2Safresh1dynamic lookup; Hence subclasses may I<not> override it!
9135759b3d2Safresh1
9145759b3d2Safresh1=end __PRIVATE__
9155759b3d2Safresh1
9165759b3d2Safresh1=cut
9175759b3d2Safresh1
9185759b3d2Safresh1sub parse_paragraph {
9195759b3d2Safresh1    my ($self, $text, $line_num) = @_;
9205759b3d2Safresh1    local *myData = $self;  ## alias to avoid deref-ing overhead
9215759b3d2Safresh1    local *myOpts = ($myData{_PARSEOPTS} ||= {});  ## get parse-options
9225759b3d2Safresh1    local $_;
9235759b3d2Safresh1
9245759b3d2Safresh1    ## See if we want to preprocess nonPOD paragraphs as well as POD ones.
9255759b3d2Safresh1    my $wantNonPods = $myOpts{'-want_nonPODs'};
9265759b3d2Safresh1
9275759b3d2Safresh1    ## Update cutting status
9285759b3d2Safresh1    $myData{_CUTTING} = 0 if $text =~ /^={1,2}\S/;
9295759b3d2Safresh1
9305759b3d2Safresh1    ## Perform any desired preprocessing if we wanted it this early
9315759b3d2Safresh1    $wantNonPods  and  $text = $self->preprocess_paragraph($text, $line_num);
9325759b3d2Safresh1
9335759b3d2Safresh1    ## Ignore up until next POD directive if we are cutting
9345759b3d2Safresh1    return if $myData{_CUTTING};
9355759b3d2Safresh1
9365759b3d2Safresh1    ## Now we know this is block of text in a POD section!
9375759b3d2Safresh1
9385759b3d2Safresh1    ##-----------------------------------------------------------------
9395759b3d2Safresh1    ## This is a hook (hack ;-) for Pod::Select to do its thing without
9405759b3d2Safresh1    ## having to override methods, but also without Pod::Parser assuming
9415759b3d2Safresh1    ## $self is an instance of Pod::Select (if the _SELECTED_SECTIONS
9425759b3d2Safresh1    ## field exists then we assume there is an is_selected() method for
9435759b3d2Safresh1    ## us to invoke (calling $self->can('is_selected') could verify this
9445759b3d2Safresh1    ## but that is more overhead than I want to incur)
9455759b3d2Safresh1    ##-----------------------------------------------------------------
9465759b3d2Safresh1
9475759b3d2Safresh1    ## Ignore this block if it isnt in one of the selected sections
9485759b3d2Safresh1    if (exists $myData{_SELECTED_SECTIONS}) {
9495759b3d2Safresh1        $self->is_selected($text)  or  return ($myData{_CUTTING} = 1);
9505759b3d2Safresh1    }
9515759b3d2Safresh1
9525759b3d2Safresh1    ## If we havent already, perform any desired preprocessing and
9535759b3d2Safresh1    ## then re-check the "cutting" state
9545759b3d2Safresh1    unless ($wantNonPods) {
9555759b3d2Safresh1       $text = $self->preprocess_paragraph($text, $line_num);
9565759b3d2Safresh1       return 1  unless ((defined $text) and (length $text));
9575759b3d2Safresh1       return 1  if ($myData{_CUTTING});
9585759b3d2Safresh1    }
9595759b3d2Safresh1
9605759b3d2Safresh1    ## Look for one of the three types of paragraphs
9615759b3d2Safresh1    my ($pfx, $cmd, $arg, $sep) = ('', '', '', '');
9625759b3d2Safresh1    my $pod_para = undef;
9635759b3d2Safresh1    if ($text =~ /^(={1,2})(?=\S)/) {
9645759b3d2Safresh1        ## Looks like a command paragraph. Capture the command prefix used
9655759b3d2Safresh1        ## ("=" or "=="), as well as the command-name, its paragraph text,
9665759b3d2Safresh1        ## and whatever sequence of characters was used to separate them
9675759b3d2Safresh1        $pfx = $1;
9685759b3d2Safresh1        $_ = substr($text, length $pfx);
9695759b3d2Safresh1        ($cmd, $sep, $text) = split /(\s+)/, $_, 2;
9705759b3d2Safresh1        $sep = '' unless defined $sep;
9715759b3d2Safresh1        $text = '' unless defined $text;
9725759b3d2Safresh1        ## If this is a "cut" directive then we dont need to do anything
9735759b3d2Safresh1        ## except return to "cutting" mode.
9745759b3d2Safresh1        if ($cmd eq 'cut') {
9755759b3d2Safresh1           $myData{_CUTTING} = 1;
9765759b3d2Safresh1           return  unless $myOpts{'-process_cut_cmd'};
9775759b3d2Safresh1        }
9785759b3d2Safresh1    }
9795759b3d2Safresh1    ## Save the attributes indicating how the command was specified.
980*256a93a4Safresh1    $pod_para = Pod::Paragraph->new(
9815759b3d2Safresh1          -name      => $cmd,
9825759b3d2Safresh1          -text      => $text,
9835759b3d2Safresh1          -prefix    => $pfx,
9845759b3d2Safresh1          -separator => $sep,
9855759b3d2Safresh1          -file      => $myData{_INFILE},
9865759b3d2Safresh1          -line      => $line_num
9875759b3d2Safresh1    );
9885759b3d2Safresh1    # ## Invoke appropriate callbacks
9895759b3d2Safresh1    # if (exists $myData{_CALLBACKS}) {
9905759b3d2Safresh1    #    ## Look through the callback list, invoke callbacks,
9915759b3d2Safresh1    #    ## then see if we need to do the default actions
9925759b3d2Safresh1    #    ## (invoke_callbacks will return true if we do).
9935759b3d2Safresh1    #    return  1  unless $self->invoke_callbacks($cmd, $text, $line_num, $pod_para);
9945759b3d2Safresh1    # }
9955759b3d2Safresh1
9965759b3d2Safresh1    # If the last paragraph ended in whitespace, and we're not between verbatim blocks, carp
9975759b3d2Safresh1    if ($myData{_WHITESPACE} and $myOpts{'-warnings'}
9985759b3d2Safresh1            and not ($text =~ /^\s+/ and ($myData{_PREVIOUS}||"") eq "verbatim")) {
9995759b3d2Safresh1        my $errorsub = $self->errorsub();
10005759b3d2Safresh1        my $line = $line_num - 1;
10015759b3d2Safresh1        my $errmsg = "*** WARNING: line containing nothing but whitespace".
10025759b3d2Safresh1                     " in paragraph at line $line in file $myData{_INFILE}\n";
10035759b3d2Safresh1        (ref $errorsub) and &{$errorsub}($errmsg)
10045759b3d2Safresh1            or (defined $errorsub) and $self->$errorsub($errmsg)
10055759b3d2Safresh1                or  carp($errmsg);
10065759b3d2Safresh1    }
10075759b3d2Safresh1
10085759b3d2Safresh1    if (length $cmd) {
10095759b3d2Safresh1        ## A command paragraph
10105759b3d2Safresh1        $self->command($cmd, $text, $line_num, $pod_para);
10115759b3d2Safresh1        $myData{_PREVIOUS} = $cmd;
10125759b3d2Safresh1    }
10135759b3d2Safresh1    elsif ($text =~ /^\s+/) {
10145759b3d2Safresh1        ## Indented text - must be a verbatim paragraph
10155759b3d2Safresh1        $self->verbatim($text, $line_num, $pod_para);
10165759b3d2Safresh1        $myData{_PREVIOUS} = "verbatim";
10175759b3d2Safresh1    }
10185759b3d2Safresh1    else {
10195759b3d2Safresh1        ## Looks like an ordinary block of text
10205759b3d2Safresh1        $self->textblock($text, $line_num, $pod_para);
10215759b3d2Safresh1        $myData{_PREVIOUS} = "textblock";
10225759b3d2Safresh1    }
10235759b3d2Safresh1
10245759b3d2Safresh1    # Update the whitespace for the next time around
10255759b3d2Safresh1    #$myData{_WHITESPACE} = $text =~ /^[^\S\r\n]+\Z/m ? 1 : 0;
10265759b3d2Safresh1    $myData{_WHITESPACE} = $text =~ /^[^\S\r\n]+\r*\Z/m ? 1 : 0;
10275759b3d2Safresh1
10285759b3d2Safresh1    return  1;
10295759b3d2Safresh1}
10305759b3d2Safresh1
10315759b3d2Safresh1##---------------------------------------------------------------------------
10325759b3d2Safresh1
10335759b3d2Safresh1=head1 B<parse_from_filehandle()>
10345759b3d2Safresh1
10355759b3d2Safresh1            $parser->parse_from_filehandle($in_fh,$out_fh);
10365759b3d2Safresh1
10375759b3d2Safresh1This method takes an input filehandle (which is assumed to already be
10385759b3d2Safresh1opened for reading) and reads the entire input stream looking for blocks
10395759b3d2Safresh1(paragraphs) of POD documentation to be processed. If no first argument
10405759b3d2Safresh1is given the default input filehandle C<STDIN> is used.
10415759b3d2Safresh1
10425759b3d2Safresh1The C<$in_fh> parameter may be any object that provides a B<getline()>
10435759b3d2Safresh1method to retrieve a single line of input text (hence, an appropriate
10445759b3d2Safresh1wrapper object could be used to parse PODs from a single string or an
10455759b3d2Safresh1array of strings).
10465759b3d2Safresh1
10475759b3d2Safresh1Using C<$in_fh-E<gt>getline()>, input is read line-by-line and assembled
10485759b3d2Safresh1into paragraphs or "blocks" (which are separated by lines containing
10495759b3d2Safresh1nothing but whitespace). For each block of POD documentation
10505759b3d2Safresh1encountered it will invoke a method to parse the given paragraph.
10515759b3d2Safresh1
10525759b3d2Safresh1If a second argument is given then it should correspond to a filehandle where
10535759b3d2Safresh1output should be sent (otherwise the default output filehandle is
10545759b3d2Safresh1C<STDOUT> if no output filehandle is currently in use).
10555759b3d2Safresh1
10565759b3d2Safresh1B<NOTE:> For performance reasons, this method caches the input stream at
10575759b3d2Safresh1the top of the stack in a local variable. Any attempts by clients to
10585759b3d2Safresh1change the stack contents during processing when in the midst executing
10595759b3d2Safresh1of this method I<will not affect> the input stream used by the current
10605759b3d2Safresh1invocation of this method.
10615759b3d2Safresh1
10625759b3d2Safresh1This method does I<not> usually need to be overridden by subclasses.
10635759b3d2Safresh1
10645759b3d2Safresh1=cut
10655759b3d2Safresh1
10665759b3d2Safresh1sub parse_from_filehandle {
10675759b3d2Safresh1    my $self = shift;
10685759b3d2Safresh1    my %opts = (ref $_[0] eq 'HASH') ? %{ shift() } : ();
10695759b3d2Safresh1    my ($in_fh, $out_fh) = @_;
10705759b3d2Safresh1    $in_fh = \*STDIN  unless ($in_fh);
10715759b3d2Safresh1    local *myData = $self;  ## alias to avoid deref-ing overhead
10725759b3d2Safresh1    local *myOpts = ($myData{_PARSEOPTS} ||= {});  ## get parse-options
10735759b3d2Safresh1    local $_;
10745759b3d2Safresh1
10755759b3d2Safresh1    ## Put this stream at the top of the stack and do beginning-of-input
10765759b3d2Safresh1    ## processing. NOTE that $in_fh might be reset during this process.
10775759b3d2Safresh1    my $topstream = $self->_push_input_stream($in_fh, $out_fh);
10785759b3d2Safresh1    (exists $opts{-cutting})  and  $self->cutting( $opts{-cutting} );
10795759b3d2Safresh1
10805759b3d2Safresh1    ## Initialize line/paragraph
10815759b3d2Safresh1    my ($textline, $paragraph) = ('', '');
10825759b3d2Safresh1    my ($nlines, $plines) = (0, 0);
10835759b3d2Safresh1
10845759b3d2Safresh1    ## Use <$fh> instead of $fh->getline where possible (for speed)
10855759b3d2Safresh1    $_ = ref $in_fh;
10865759b3d2Safresh1    my $tied_fh = (/^(?:GLOB|FileHandle|IO::\w+)$/  or  tied $in_fh);
10875759b3d2Safresh1
10885759b3d2Safresh1    ## Read paragraphs line-by-line
10895759b3d2Safresh1    while (defined ($textline = $tied_fh ? <$in_fh> : $in_fh->getline)) {
10905759b3d2Safresh1        $textline = $self->preprocess_line($textline, ++$nlines);
10915759b3d2Safresh1        next  unless ((defined $textline)  &&  (length $textline));
10925759b3d2Safresh1
10935759b3d2Safresh1        if ((! length $paragraph) && ($textline =~ /^==/)) {
10945759b3d2Safresh1            ## '==' denotes a one-line command paragraph
10955759b3d2Safresh1            $paragraph = $textline;
10965759b3d2Safresh1            $plines    = 1;
10975759b3d2Safresh1            $textline  = '';
10985759b3d2Safresh1        } else {
10995759b3d2Safresh1            ## Append this line to the current paragraph
11005759b3d2Safresh1            $paragraph .= $textline;
11015759b3d2Safresh1            ++$plines;
11025759b3d2Safresh1        }
11035759b3d2Safresh1
11045759b3d2Safresh1        ## See if this line is blank and ends the current paragraph.
11055759b3d2Safresh1        ## If it isnt, then keep iterating until it is.
11065759b3d2Safresh1        next unless (($textline =~ /^[^\S\r\n]*[\r\n]*$/)
11075759b3d2Safresh1                                     && (length $paragraph));
11085759b3d2Safresh1
11095759b3d2Safresh1        ## Now process the paragraph
11105759b3d2Safresh1        parse_paragraph($self, $paragraph, ($nlines - $plines) + 1);
11115759b3d2Safresh1        $paragraph = '';
11125759b3d2Safresh1        $plines = 0;
11135759b3d2Safresh1    }
11145759b3d2Safresh1    ## Dont forget about the last paragraph in the file
11155759b3d2Safresh1    if (length $paragraph) {
11165759b3d2Safresh1       parse_paragraph($self, $paragraph, ($nlines - $plines) + 1)
11175759b3d2Safresh1    }
11185759b3d2Safresh1
11195759b3d2Safresh1    ## Now pop the input stream off the top of the input stack.
11205759b3d2Safresh1    $self->_pop_input_stream();
11215759b3d2Safresh1}
11225759b3d2Safresh1
11235759b3d2Safresh1##---------------------------------------------------------------------------
11245759b3d2Safresh1
11255759b3d2Safresh1=head1 B<parse_from_file()>
11265759b3d2Safresh1
11275759b3d2Safresh1            $parser->parse_from_file($filename,$outfile);
11285759b3d2Safresh1
11295759b3d2Safresh1This method takes a filename and does the following:
11305759b3d2Safresh1
11315759b3d2Safresh1=over 2
11325759b3d2Safresh1
11335759b3d2Safresh1=item *
11345759b3d2Safresh1
11355759b3d2Safresh1opens the input and output files for reading
11365759b3d2Safresh1(creating the appropriate filehandles)
11375759b3d2Safresh1
11385759b3d2Safresh1=item *
11395759b3d2Safresh1
11405759b3d2Safresh1invokes the B<parse_from_filehandle()> method passing it the
11415759b3d2Safresh1corresponding input and output filehandles.
11425759b3d2Safresh1
11435759b3d2Safresh1=item *
11445759b3d2Safresh1
11455759b3d2Safresh1closes the input and output files.
11465759b3d2Safresh1
11475759b3d2Safresh1=back
11485759b3d2Safresh1
11495759b3d2Safresh1If the special input filename "-" or "<&STDIN" is given then the STDIN
11505759b3d2Safresh1filehandle is used for input (and no open or close is performed). If no
11515759b3d2Safresh1input filename is specified then "-" is implied. Filehandle references,
11525759b3d2Safresh1or objects that support the regular IO operations (like C<E<lt>$fhE<gt>>
11535759b3d2Safresh1or C<$fh-<Egt>getline>) are also accepted; the handles must already be
11545759b3d2Safresh1opened.
11555759b3d2Safresh1
11565759b3d2Safresh1If a second argument is given then it should be the name of the desired
11575759b3d2Safresh1output file. If the special output filename "-" or ">&STDOUT" is given
11585759b3d2Safresh1then the STDOUT filehandle is used for output (and no open or close is
11595759b3d2Safresh1performed). If the special output filename ">&STDERR" is given then the
11605759b3d2Safresh1STDERR filehandle is used for output (and no open or close is
11615759b3d2Safresh1performed). If no output filehandle is currently in use and no output
11625759b3d2Safresh1filename is specified, then "-" is implied.
11635759b3d2Safresh1Alternatively, filehandle references or objects that support the regular
11645759b3d2Safresh1IO operations (like C<print>, e.g. L<IO::String>) are also accepted;
11655759b3d2Safresh1the object must already be opened.
11665759b3d2Safresh1
11675759b3d2Safresh1This method does I<not> usually need to be overridden by subclasses.
11685759b3d2Safresh1
11695759b3d2Safresh1=cut
11705759b3d2Safresh1
11715759b3d2Safresh1sub parse_from_file {
11725759b3d2Safresh1    my $self = shift;
11735759b3d2Safresh1    my %opts = (ref $_[0] eq 'HASH') ? %{ shift() } : ();
11745759b3d2Safresh1    my ($infile, $outfile) = @_;
11755759b3d2Safresh1    my ($in_fh,  $out_fh);
11765759b3d2Safresh1    if ($] < 5.006) {
11775759b3d2Safresh1      ($in_fh,  $out_fh) = (gensym(), gensym());
11785759b3d2Safresh1    }
11795759b3d2Safresh1    my ($close_input, $close_output) = (0, 0);
11805759b3d2Safresh1    local *myData = $self;
11815759b3d2Safresh1    local *_;
11825759b3d2Safresh1
11835759b3d2Safresh1    ## Is $infile a filename or a (possibly implied) filehandle
11845759b3d2Safresh1    if (defined $infile && ref $infile) {
11855759b3d2Safresh1        if (ref($infile) =~ /^(SCALAR|ARRAY|HASH|CODE|REF)$/) {
11865759b3d2Safresh1            croak "Input from $1 reference not supported!\n";
11875759b3d2Safresh1        }
11885759b3d2Safresh1        ## Must be a filehandle-ref (or else assume its a ref to an object
11895759b3d2Safresh1        ## that supports the common IO read operations).
11905759b3d2Safresh1        $myData{_INFILE} = ${$infile};
11915759b3d2Safresh1        $in_fh = $infile;
11925759b3d2Safresh1    }
11935759b3d2Safresh1    elsif (!defined($infile) || !length($infile) || ($infile eq '-')
11945759b3d2Safresh1        || ($infile =~ /^<&(?:STDIN|0)$/i))
11955759b3d2Safresh1    {
11965759b3d2Safresh1        ## Not a filename, just a string implying STDIN
11975759b3d2Safresh1        $infile ||= '-';
11985759b3d2Safresh1        $myData{_INFILE} = '<standard input>';
11995759b3d2Safresh1        $in_fh = \*STDIN;
12005759b3d2Safresh1    }
12015759b3d2Safresh1    else {
12025759b3d2Safresh1        ## We have a filename, open it for reading
12035759b3d2Safresh1        $myData{_INFILE} = $infile;
12045759b3d2Safresh1        open($in_fh, "< $infile")  or
12055759b3d2Safresh1             croak "Can't open $infile for reading: $!\n";
12065759b3d2Safresh1        $close_input = 1;
12075759b3d2Safresh1    }
12085759b3d2Safresh1
12095759b3d2Safresh1    ## NOTE: we need to be *very* careful when "defaulting" the output
12105759b3d2Safresh1    ## file. We only want to use a default if this is the beginning of
12115759b3d2Safresh1    ## the entire document (but *not* if this is an included file). We
12125759b3d2Safresh1    ## determine this by seeing if the input stream stack has been set-up
12135759b3d2Safresh1    ## already
12145759b3d2Safresh1
12155759b3d2Safresh1    ## Is $outfile a filename, a (possibly implied) filehandle, maybe a ref?
12165759b3d2Safresh1    if (ref $outfile) {
12175759b3d2Safresh1        ## we need to check for ref() first, as other checks involve reading
12185759b3d2Safresh1        if (ref($outfile) =~ /^(ARRAY|HASH|CODE)$/) {
12195759b3d2Safresh1            croak "Output to $1 reference not supported!\n";
12205759b3d2Safresh1        }
12215759b3d2Safresh1        elsif (ref($outfile) eq 'SCALAR') {
12225759b3d2Safresh1#           # NOTE: IO::String isn't a part of the perl distribution,
12235759b3d2Safresh1#           #       so probably we shouldn't support this case...
12245759b3d2Safresh1#           require IO::String;
12255759b3d2Safresh1#           $myData{_OUTFILE} = "$outfile";
12265759b3d2Safresh1#           $out_fh = IO::String->new($outfile);
12275759b3d2Safresh1            croak "Output to SCALAR reference not supported!\n";
12285759b3d2Safresh1        }
12295759b3d2Safresh1        else {
12305759b3d2Safresh1            ## Must be a filehandle-ref (or else assume its a ref to an
12315759b3d2Safresh1            ## object that supports the common IO write operations).
12325759b3d2Safresh1            $myData{_OUTFILE} = ${$outfile};
12335759b3d2Safresh1            $out_fh = $outfile;
12345759b3d2Safresh1        }
12355759b3d2Safresh1    }
12365759b3d2Safresh1    elsif (!defined($outfile) || !length($outfile) || ($outfile eq '-')
12375759b3d2Safresh1        || ($outfile =~ /^>&?(?:STDOUT|1)$/i))
12385759b3d2Safresh1    {
12395759b3d2Safresh1        if (defined $myData{_TOP_STREAM}) {
12405759b3d2Safresh1            $out_fh = $myData{_OUTPUT};
12415759b3d2Safresh1        }
12425759b3d2Safresh1        else {
12435759b3d2Safresh1            ## Not a filename, just a string implying STDOUT
12445759b3d2Safresh1            $outfile ||= '-';
12455759b3d2Safresh1            $myData{_OUTFILE} = '<standard output>';
12465759b3d2Safresh1            $out_fh  = \*STDOUT;
12475759b3d2Safresh1        }
12485759b3d2Safresh1    }
12495759b3d2Safresh1    elsif ($outfile =~ /^>&(STDERR|2)$/i) {
12505759b3d2Safresh1        ## Not a filename, just a string implying STDERR
12515759b3d2Safresh1        $myData{_OUTFILE} = '<standard error>';
12525759b3d2Safresh1        $out_fh  = \*STDERR;
12535759b3d2Safresh1    }
12545759b3d2Safresh1    else {
12555759b3d2Safresh1        ## We have a filename, open it for writing
12565759b3d2Safresh1        $myData{_OUTFILE} = $outfile;
12575759b3d2Safresh1        (-d $outfile) and croak "$outfile is a directory, not POD input!\n";
12585759b3d2Safresh1        open($out_fh, "> $outfile")  or
12595759b3d2Safresh1             croak "Can't open $outfile for writing: $!\n";
12605759b3d2Safresh1        $close_output = 1;
12615759b3d2Safresh1    }
12625759b3d2Safresh1
12635759b3d2Safresh1    ## Whew! That was a lot of work to set up reasonably/robust behavior
12645759b3d2Safresh1    ## in the case of a non-filename for reading and writing. Now we just
12655759b3d2Safresh1    ## have to parse the input and close the handles when we're finished.
12665759b3d2Safresh1    $self->parse_from_filehandle(\%opts, $in_fh, $out_fh);
12675759b3d2Safresh1
12685759b3d2Safresh1    $close_input  and
12695759b3d2Safresh1        close($in_fh) || croak "Can't close $infile after reading: $!\n";
12705759b3d2Safresh1    $close_output  and
12715759b3d2Safresh1        close($out_fh) || croak "Can't close $outfile after writing: $!\n";
12725759b3d2Safresh1}
12735759b3d2Safresh1
12745759b3d2Safresh1#############################################################################
12755759b3d2Safresh1
12765759b3d2Safresh1=head1 ACCESSOR METHODS
12775759b3d2Safresh1
12785759b3d2Safresh1Clients of B<Pod::Parser> should use the following methods to access
12795759b3d2Safresh1instance data fields:
12805759b3d2Safresh1
12815759b3d2Safresh1=cut
12825759b3d2Safresh1
12835759b3d2Safresh1##---------------------------------------------------------------------------
12845759b3d2Safresh1
12855759b3d2Safresh1=head1 B<errorsub()>
12865759b3d2Safresh1
12875759b3d2Safresh1            $parser->errorsub("method_name");
12885759b3d2Safresh1            $parser->errorsub(\&warn_user);
12895759b3d2Safresh1            $parser->errorsub(sub { print STDERR, @_ });
12905759b3d2Safresh1
12915759b3d2Safresh1Specifies the method or subroutine to use when printing error messages
12925759b3d2Safresh1about POD syntax. The supplied method/subroutine I<must> return TRUE upon
12935759b3d2Safresh1successful printing of the message. If C<undef> is given, then the B<carp>
12945759b3d2Safresh1builtin is used to issue error messages (this is the default behavior).
12955759b3d2Safresh1
12965759b3d2Safresh1            my $errorsub = $parser->errorsub()
12975759b3d2Safresh1            my $errmsg = "This is an error message!\n"
12985759b3d2Safresh1            (ref $errorsub) and &{$errorsub}($errmsg)
12995759b3d2Safresh1                or (defined $errorsub) and $parser->$errorsub($errmsg)
13005759b3d2Safresh1                    or  carp($errmsg);
13015759b3d2Safresh1
13025759b3d2Safresh1Returns a method name, or else a reference to the user-supplied subroutine
13035759b3d2Safresh1used to print error messages. Returns C<undef> if the B<carp> builtin
13045759b3d2Safresh1is used to issue error messages (this is the default behavior).
13055759b3d2Safresh1
13065759b3d2Safresh1=cut
13075759b3d2Safresh1
13085759b3d2Safresh1sub errorsub {
13095759b3d2Safresh1   return (@_ > 1) ? ($_[0]->{_ERRORSUB} = $_[1]) : $_[0]->{_ERRORSUB};
13105759b3d2Safresh1}
13115759b3d2Safresh1
13125759b3d2Safresh1##---------------------------------------------------------------------------
13135759b3d2Safresh1
13145759b3d2Safresh1=head1 B<cutting()>
13155759b3d2Safresh1
13165759b3d2Safresh1            $boolean = $parser->cutting();
13175759b3d2Safresh1
13185759b3d2Safresh1Returns the current C<cutting> state: a boolean-valued scalar which
13195759b3d2Safresh1evaluates to true if text from the input file is currently being "cut"
13205759b3d2Safresh1(meaning it is I<not> considered part of the POD document).
13215759b3d2Safresh1
13225759b3d2Safresh1            $parser->cutting($boolean);
13235759b3d2Safresh1
13245759b3d2Safresh1Sets the current C<cutting> state to the given value and returns the
13255759b3d2Safresh1result.
13265759b3d2Safresh1
13275759b3d2Safresh1=cut
13285759b3d2Safresh1
13295759b3d2Safresh1sub cutting {
13305759b3d2Safresh1   return (@_ > 1) ? ($_[0]->{_CUTTING} = $_[1]) : $_[0]->{_CUTTING};
13315759b3d2Safresh1}
13325759b3d2Safresh1
13335759b3d2Safresh1##---------------------------------------------------------------------------
13345759b3d2Safresh1
13355759b3d2Safresh1##---------------------------------------------------------------------------
13365759b3d2Safresh1
13375759b3d2Safresh1=head1 B<parseopts()>
13385759b3d2Safresh1
13395759b3d2Safresh1When invoked with no additional arguments, B<parseopts> returns a hashtable
13405759b3d2Safresh1of all the current parsing options.
13415759b3d2Safresh1
13425759b3d2Safresh1            ## See if we are parsing non-POD sections as well as POD ones
13435759b3d2Safresh1            my %opts = $parser->parseopts();
13445759b3d2Safresh1            $opts{'-want_nonPODs}' and print "-want_nonPODs\n";
13455759b3d2Safresh1
13465759b3d2Safresh1When invoked using a single string, B<parseopts> treats the string as the
13475759b3d2Safresh1name of a parse-option and returns its corresponding value if it exists
13485759b3d2Safresh1(returns C<undef> if it doesn't).
13495759b3d2Safresh1
13505759b3d2Safresh1            ## Did we ask to see '=cut' paragraphs?
13515759b3d2Safresh1            my $want_cut = $parser->parseopts('-process_cut_cmd');
13525759b3d2Safresh1            $want_cut and print "-process_cut_cmd\n";
13535759b3d2Safresh1
13545759b3d2Safresh1When invoked with multiple arguments, B<parseopts> treats them as
13555759b3d2Safresh1key/value pairs and the specified parse-option names are set to the
13565759b3d2Safresh1given values. Any unspecified parse-options are unaffected.
13575759b3d2Safresh1
13585759b3d2Safresh1            ## Set them back to the default
13595759b3d2Safresh1            $parser->parseopts(-warnings => 0);
13605759b3d2Safresh1
13615759b3d2Safresh1When passed a single hash-ref, B<parseopts> uses that hash to completely
13625759b3d2Safresh1reset the existing parse-options, all previous parse-option values
13635759b3d2Safresh1are lost.
13645759b3d2Safresh1
13655759b3d2Safresh1            ## Reset all options to default
13665759b3d2Safresh1            $parser->parseopts( { } );
13675759b3d2Safresh1
13685759b3d2Safresh1See L<"PARSING OPTIONS"> for more information on the name and meaning of each
13695759b3d2Safresh1parse-option currently recognized.
13705759b3d2Safresh1
13715759b3d2Safresh1=cut
13725759b3d2Safresh1
13735759b3d2Safresh1sub parseopts {
13745759b3d2Safresh1   local *myData = shift;
13755759b3d2Safresh1   local *myOpts = ($myData{_PARSEOPTS} ||= {});
13765759b3d2Safresh1   return %myOpts  if (@_ == 0);
13775759b3d2Safresh1   if (@_ == 1) {
13785759b3d2Safresh1      local $_ = shift;
13795759b3d2Safresh1      return  ref($_)  ?  $myData{_PARSEOPTS} = $_  :  $myOpts{$_};
13805759b3d2Safresh1   }
13815759b3d2Safresh1   my @newOpts = (%myOpts, @_);
13825759b3d2Safresh1   $myData{_PARSEOPTS} = { @newOpts };
13835759b3d2Safresh1}
13845759b3d2Safresh1
13855759b3d2Safresh1##---------------------------------------------------------------------------
13865759b3d2Safresh1
13875759b3d2Safresh1=head1 B<output_file()>
13885759b3d2Safresh1
13895759b3d2Safresh1            $fname = $parser->output_file();
13905759b3d2Safresh1
13915759b3d2Safresh1Returns the name of the output file being written.
13925759b3d2Safresh1
13935759b3d2Safresh1=cut
13945759b3d2Safresh1
13955759b3d2Safresh1sub output_file {
13965759b3d2Safresh1   return $_[0]->{_OUTFILE};
13975759b3d2Safresh1}
13985759b3d2Safresh1
13995759b3d2Safresh1##---------------------------------------------------------------------------
14005759b3d2Safresh1
14015759b3d2Safresh1=head1 B<output_handle()>
14025759b3d2Safresh1
14035759b3d2Safresh1            $fhandle = $parser->output_handle();
14045759b3d2Safresh1
14055759b3d2Safresh1Returns the output filehandle object.
14065759b3d2Safresh1
14075759b3d2Safresh1=cut
14085759b3d2Safresh1
14095759b3d2Safresh1sub output_handle {
14105759b3d2Safresh1   return $_[0]->{_OUTPUT};
14115759b3d2Safresh1}
14125759b3d2Safresh1
14135759b3d2Safresh1##---------------------------------------------------------------------------
14145759b3d2Safresh1
14155759b3d2Safresh1=head1 B<input_file()>
14165759b3d2Safresh1
14175759b3d2Safresh1            $fname = $parser->input_file();
14185759b3d2Safresh1
14195759b3d2Safresh1Returns the name of the input file being read.
14205759b3d2Safresh1
14215759b3d2Safresh1=cut
14225759b3d2Safresh1
14235759b3d2Safresh1sub input_file {
14245759b3d2Safresh1   return $_[0]->{_INFILE};
14255759b3d2Safresh1}
14265759b3d2Safresh1
14275759b3d2Safresh1##---------------------------------------------------------------------------
14285759b3d2Safresh1
14295759b3d2Safresh1=head1 B<input_handle()>
14305759b3d2Safresh1
14315759b3d2Safresh1            $fhandle = $parser->input_handle();
14325759b3d2Safresh1
14335759b3d2Safresh1Returns the current input filehandle object.
14345759b3d2Safresh1
14355759b3d2Safresh1=cut
14365759b3d2Safresh1
14375759b3d2Safresh1sub input_handle {
14385759b3d2Safresh1   return $_[0]->{_INPUT};
14395759b3d2Safresh1}
14405759b3d2Safresh1
14415759b3d2Safresh1##---------------------------------------------------------------------------
14425759b3d2Safresh1
14435759b3d2Safresh1=begin __PRIVATE__
14445759b3d2Safresh1
14455759b3d2Safresh1=head1 B<input_streams()>
14465759b3d2Safresh1
14475759b3d2Safresh1            $listref = $parser->input_streams();
14485759b3d2Safresh1
14495759b3d2Safresh1Returns a reference to an array which corresponds to the stack of all
14505759b3d2Safresh1the input streams that are currently in the middle of being parsed.
14515759b3d2Safresh1
14525759b3d2Safresh1While parsing an input stream, it is possible to invoke
14535759b3d2Safresh1B<parse_from_file()> or B<parse_from_filehandle()> to parse a new input
14545759b3d2Safresh1stream and then return to parsing the previous input stream. Each input
14555759b3d2Safresh1stream to be parsed is pushed onto the end of this input stack
14565759b3d2Safresh1before any of its input is read. The input stream that is currently
14575759b3d2Safresh1being parsed is always at the end (or top) of the input stack. When an
14585759b3d2Safresh1input stream has been exhausted, it is popped off the end of the
14595759b3d2Safresh1input stack.
14605759b3d2Safresh1
14615759b3d2Safresh1Each element on this input stack is a reference to C<Pod::InputSource>
14625759b3d2Safresh1object. Please see L<Pod::InputObjects> for more details.
14635759b3d2Safresh1
14645759b3d2Safresh1This method might be invoked when printing diagnostic messages, for example,
14655759b3d2Safresh1to obtain the name and line number of the all input files that are currently
14665759b3d2Safresh1being processed.
14675759b3d2Safresh1
14685759b3d2Safresh1=end __PRIVATE__
14695759b3d2Safresh1
14705759b3d2Safresh1=cut
14715759b3d2Safresh1
14725759b3d2Safresh1sub input_streams {
14735759b3d2Safresh1   return $_[0]->{_INPUT_STREAMS};
14745759b3d2Safresh1}
14755759b3d2Safresh1
14765759b3d2Safresh1##---------------------------------------------------------------------------
14775759b3d2Safresh1
14785759b3d2Safresh1=begin __PRIVATE__
14795759b3d2Safresh1
14805759b3d2Safresh1=head1 B<top_stream()>
14815759b3d2Safresh1
14825759b3d2Safresh1            $hashref = $parser->top_stream();
14835759b3d2Safresh1
14845759b3d2Safresh1Returns a reference to the hash-table that represents the element
14855759b3d2Safresh1that is currently at the top (end) of the input stream stack
14865759b3d2Safresh1(see L<"input_streams()">). The return value will be the C<undef>
14875759b3d2Safresh1if the input stack is empty.
14885759b3d2Safresh1
14895759b3d2Safresh1This method might be used when printing diagnostic messages, for example,
14905759b3d2Safresh1to obtain the name and line number of the current input file.
14915759b3d2Safresh1
14925759b3d2Safresh1=end __PRIVATE__
14935759b3d2Safresh1
14945759b3d2Safresh1=cut
14955759b3d2Safresh1
14965759b3d2Safresh1sub top_stream {
14975759b3d2Safresh1   return $_[0]->{_TOP_STREAM} || undef;
14985759b3d2Safresh1}
14995759b3d2Safresh1
15005759b3d2Safresh1#############################################################################
15015759b3d2Safresh1
15025759b3d2Safresh1=head1 PRIVATE METHODS AND DATA
15035759b3d2Safresh1
15045759b3d2Safresh1B<Pod::Parser> makes use of several internal methods and data fields
15055759b3d2Safresh1which clients should not need to see or use. For the sake of avoiding
15065759b3d2Safresh1name collisions for client data and methods, these methods and fields
15075759b3d2Safresh1are briefly discussed here. Determined hackers may obtain further
15085759b3d2Safresh1information about them by reading the B<Pod::Parser> source code.
15095759b3d2Safresh1
15105759b3d2Safresh1Private data fields are stored in the hash-object whose reference is
15115759b3d2Safresh1returned by the B<new()> constructor for this class. The names of all
15125759b3d2Safresh1private methods and data-fields used by B<Pod::Parser> begin with a
15135759b3d2Safresh1prefix of "_" and match the regular expression C</^_\w+$/>.
15145759b3d2Safresh1
15155759b3d2Safresh1=cut
15165759b3d2Safresh1
15175759b3d2Safresh1##---------------------------------------------------------------------------
15185759b3d2Safresh1
15195759b3d2Safresh1=begin _PRIVATE_
15205759b3d2Safresh1
15215759b3d2Safresh1=head1 B<_push_input_stream()>
15225759b3d2Safresh1
15235759b3d2Safresh1            $hashref = $parser->_push_input_stream($in_fh,$out_fh);
15245759b3d2Safresh1
15255759b3d2Safresh1This method will push the given input stream on the input stack and
15265759b3d2Safresh1perform any necessary beginning-of-document or beginning-of-file
15275759b3d2Safresh1processing. The argument C<$in_fh> is the input stream filehandle to
15285759b3d2Safresh1push, and C<$out_fh> is the corresponding output filehandle to use (if
15295759b3d2Safresh1it is not given or is undefined, then the current output stream is used,
15305759b3d2Safresh1which defaults to standard output if it doesnt exist yet).
15315759b3d2Safresh1
15325759b3d2Safresh1The value returned will be reference to the hash-table that represents
15335759b3d2Safresh1the new top of the input stream stack. I<Please Note> that it is
15345759b3d2Safresh1possible for this method to use default values for the input and output
15355759b3d2Safresh1file handles. If this happens, you will need to look at the C<INPUT>
15365759b3d2Safresh1and C<OUTPUT> instance data members to determine their new values.
15375759b3d2Safresh1
15385759b3d2Safresh1=end _PRIVATE_
15395759b3d2Safresh1
15405759b3d2Safresh1=cut
15415759b3d2Safresh1
15425759b3d2Safresh1sub _push_input_stream {
15435759b3d2Safresh1    my ($self, $in_fh, $out_fh) = @_;
15445759b3d2Safresh1    local *myData = $self;
15455759b3d2Safresh1
15465759b3d2Safresh1    ## Initialize stuff for the entire document if this is *not*
15475759b3d2Safresh1    ## an included file.
15485759b3d2Safresh1    ##
15495759b3d2Safresh1    ## NOTE: we need to be *very* careful when "defaulting" the output
15505759b3d2Safresh1    ## filehandle. We only want to use a default value if this is the
15515759b3d2Safresh1    ## beginning of the entire document (but *not* if this is an included
15525759b3d2Safresh1    ## file).
15535759b3d2Safresh1    unless (defined  $myData{_TOP_STREAM}) {
15545759b3d2Safresh1        $out_fh  = \*STDOUT  unless (defined $out_fh);
15555759b3d2Safresh1        $myData{_CUTTING}       = 1;   ## current "cutting" state
15565759b3d2Safresh1        $myData{_INPUT_STREAMS} = [];  ## stack of all input streams
15575759b3d2Safresh1    }
15585759b3d2Safresh1
15595759b3d2Safresh1    ## Initialize input indicators
15605759b3d2Safresh1    $myData{_OUTFILE} = '(unknown)'  unless (defined  $myData{_OUTFILE});
15615759b3d2Safresh1    $myData{_OUTPUT}  = $out_fh      if (defined  $out_fh);
15625759b3d2Safresh1    $in_fh            = \*STDIN      unless (defined  $in_fh);
15635759b3d2Safresh1    $myData{_INFILE}  = '(unknown)'  unless (defined  $myData{_INFILE});
15645759b3d2Safresh1    $myData{_INPUT}   = $in_fh;
15655759b3d2Safresh1    my $input_top     = $myData{_TOP_STREAM}
1566*256a93a4Safresh1                      = Pod::InputSource->new(
15675759b3d2Safresh1                            -name        => $myData{_INFILE},
15685759b3d2Safresh1                            -handle      => $in_fh,
15695759b3d2Safresh1                            -was_cutting => $myData{_CUTTING}
15705759b3d2Safresh1                        );
15715759b3d2Safresh1    local *input_stack = $myData{_INPUT_STREAMS};
15725759b3d2Safresh1    push(@input_stack, $input_top);
15735759b3d2Safresh1
15745759b3d2Safresh1    ## Perform beginning-of-document and/or beginning-of-input processing
15755759b3d2Safresh1    $self->begin_pod()  if (@input_stack == 1);
15765759b3d2Safresh1    $self->begin_input();
15775759b3d2Safresh1
15785759b3d2Safresh1    return  $input_top;
15795759b3d2Safresh1}
15805759b3d2Safresh1
15815759b3d2Safresh1##---------------------------------------------------------------------------
15825759b3d2Safresh1
15835759b3d2Safresh1=begin _PRIVATE_
15845759b3d2Safresh1
15855759b3d2Safresh1=head1 B<_pop_input_stream()>
15865759b3d2Safresh1
15875759b3d2Safresh1            $hashref = $parser->_pop_input_stream();
15885759b3d2Safresh1
15895759b3d2Safresh1This takes no arguments. It will perform any necessary end-of-file or
15905759b3d2Safresh1end-of-document processing and then pop the current input stream from
15915759b3d2Safresh1the top of the input stack.
15925759b3d2Safresh1
15935759b3d2Safresh1The value returned will be reference to the hash-table that represents
15945759b3d2Safresh1the new top of the input stream stack.
15955759b3d2Safresh1
15965759b3d2Safresh1=end _PRIVATE_
15975759b3d2Safresh1
15985759b3d2Safresh1=cut
15995759b3d2Safresh1
16005759b3d2Safresh1sub _pop_input_stream {
16015759b3d2Safresh1    my ($self) = @_;
16025759b3d2Safresh1    local *myData = $self;
16035759b3d2Safresh1    local *input_stack = $myData{_INPUT_STREAMS};
16045759b3d2Safresh1
16055759b3d2Safresh1    ## Perform end-of-input and/or end-of-document processing
16065759b3d2Safresh1    $self->end_input()  if (@input_stack > 0);
16075759b3d2Safresh1    $self->end_pod()    if (@input_stack == 1);
16085759b3d2Safresh1
16095759b3d2Safresh1    ## Restore cutting state to whatever it was before we started
16105759b3d2Safresh1    ## parsing this file.
16115759b3d2Safresh1    my $old_top = pop(@input_stack);
16125759b3d2Safresh1    $myData{_CUTTING} = $old_top->was_cutting();
16135759b3d2Safresh1
16145759b3d2Safresh1    ## Dont forget to reset the input indicators
16155759b3d2Safresh1    my $input_top = undef;
16165759b3d2Safresh1    if (@input_stack > 0) {
16175759b3d2Safresh1       $input_top = $myData{_TOP_STREAM} = $input_stack[-1];
16185759b3d2Safresh1       $myData{_INFILE}  = $input_top->name();
16195759b3d2Safresh1       $myData{_INPUT}   = $input_top->handle();
16205759b3d2Safresh1    } else {
16215759b3d2Safresh1       delete $myData{_TOP_STREAM};
16225759b3d2Safresh1       delete $myData{_INPUT_STREAMS};
16235759b3d2Safresh1    }
16245759b3d2Safresh1
16255759b3d2Safresh1    return  $input_top;
16265759b3d2Safresh1}
16275759b3d2Safresh1
16285759b3d2Safresh1#############################################################################
16295759b3d2Safresh1
16305759b3d2Safresh1=head1 TREE-BASED PARSING
16315759b3d2Safresh1
16325759b3d2Safresh1If straightforward stream-based parsing wont meet your needs (as is
16335759b3d2Safresh1likely the case for tasks such as translating PODs into structured
16345759b3d2Safresh1markup languages like HTML and XML) then you may need to take the
16355759b3d2Safresh1tree-based approach. Rather than doing everything in one pass and
16365759b3d2Safresh1calling the B<interpolate()> method to expand sequences into text, it
16375759b3d2Safresh1may be desirable to instead create a parse-tree using the B<parse_text()>
16385759b3d2Safresh1method to return a tree-like structure which may contain an ordered
16395759b3d2Safresh1list of children (each of which may be a text-string, or a similar
16405759b3d2Safresh1tree-like structure).
16415759b3d2Safresh1
16425759b3d2Safresh1Pay special attention to L<"METHODS FOR PARSING AND PROCESSING"> and
16435759b3d2Safresh1to the objects described in L<Pod::InputObjects>. The former describes
16445759b3d2Safresh1the gory details and parameters for how to customize and extend the
16455759b3d2Safresh1parsing behavior of B<Pod::Parser>. B<Pod::InputObjects> provides
16465759b3d2Safresh1several objects that may all be used interchangeably as parse-trees. The
16475759b3d2Safresh1most obvious one is the B<Pod::ParseTree> object. It defines the basic
16485759b3d2Safresh1interface and functionality that all things trying to be a POD parse-tree
16495759b3d2Safresh1should do. A B<Pod::ParseTree> is defined such that each "node" may be a
16505759b3d2Safresh1text-string, or a reference to another parse-tree.  Each B<Pod::Paragraph>
16515759b3d2Safresh1object and each B<Pod::InteriorSequence> object also supports the basic
16525759b3d2Safresh1parse-tree interface.
16535759b3d2Safresh1
16545759b3d2Safresh1The B<parse_text()> method takes a given paragraph of text, and
16555759b3d2Safresh1returns a parse-tree that contains one or more children, each of which
16565759b3d2Safresh1may be a text-string, or an InteriorSequence object. There are also
16575759b3d2Safresh1callback-options that may be passed to B<parse_text()> to customize
16585759b3d2Safresh1the way it expands or transforms interior-sequences, as well as the
16595759b3d2Safresh1returned result. These callbacks can be used to create a parse-tree
16605759b3d2Safresh1with custom-made objects (which may or may not support the parse-tree
16615759b3d2Safresh1interface, depending on how you choose to do it).
16625759b3d2Safresh1
16635759b3d2Safresh1If you wish to turn an entire POD document into a parse-tree, that process
16645759b3d2Safresh1is fairly straightforward. The B<parse_text()> method is the key to doing
16655759b3d2Safresh1this successfully. Every paragraph-callback (i.e. the polymorphic methods
16665759b3d2Safresh1for B<command()>, B<verbatim()>, and B<textblock()> paragraphs) takes
16675759b3d2Safresh1a B<Pod::Paragraph> object as an argument. Each paragraph object has a
16685759b3d2Safresh1B<parse_tree()> method that can be used to get or set a corresponding
16695759b3d2Safresh1parse-tree. So for each of those paragraph-callback methods, simply call
16705759b3d2Safresh1B<parse_text()> with the options you desire, and then use the returned
16715759b3d2Safresh1parse-tree to assign to the given paragraph object.
16725759b3d2Safresh1
16735759b3d2Safresh1That gives you a parse-tree for each paragraph - so now all you need is
16745759b3d2Safresh1an ordered list of paragraphs. You can maintain that yourself as a data
16755759b3d2Safresh1element in the object/hash. The most straightforward way would be simply
16765759b3d2Safresh1to use an array-ref, with the desired set of custom "options" for each
16775759b3d2Safresh1invocation of B<parse_text>. Let's assume the desired option-set is
16785759b3d2Safresh1given by the hash C<%options>. Then we might do something like the
16795759b3d2Safresh1following:
16805759b3d2Safresh1
16815759b3d2Safresh1    package MyPodParserTree;
16825759b3d2Safresh1
16835759b3d2Safresh1    @ISA = qw( Pod::Parser );
16845759b3d2Safresh1
16855759b3d2Safresh1    ...
16865759b3d2Safresh1
16875759b3d2Safresh1    sub begin_pod {
16885759b3d2Safresh1        my $self = shift;
16895759b3d2Safresh1        $self->{'-paragraphs'} = [];  ## initialize paragraph list
16905759b3d2Safresh1    }
16915759b3d2Safresh1
16925759b3d2Safresh1    sub command {
16935759b3d2Safresh1        my ($parser, $command, $paragraph, $line_num, $pod_para) = @_;
16945759b3d2Safresh1        my $ptree = $parser->parse_text({%options}, $paragraph, ...);
16955759b3d2Safresh1        $pod_para->parse_tree( $ptree );
16965759b3d2Safresh1        push @{ $self->{'-paragraphs'} }, $pod_para;
16975759b3d2Safresh1    }
16985759b3d2Safresh1
16995759b3d2Safresh1    sub verbatim {
17005759b3d2Safresh1        my ($parser, $paragraph, $line_num, $pod_para) = @_;
17015759b3d2Safresh1        push @{ $self->{'-paragraphs'} }, $pod_para;
17025759b3d2Safresh1    }
17035759b3d2Safresh1
17045759b3d2Safresh1    sub textblock {
17055759b3d2Safresh1        my ($parser, $paragraph, $line_num, $pod_para) = @_;
17065759b3d2Safresh1        my $ptree = $parser->parse_text({%options}, $paragraph, ...);
17075759b3d2Safresh1        $pod_para->parse_tree( $ptree );
17085759b3d2Safresh1        push @{ $self->{'-paragraphs'} }, $pod_para;
17095759b3d2Safresh1    }
17105759b3d2Safresh1
17115759b3d2Safresh1    ...
17125759b3d2Safresh1
17135759b3d2Safresh1    package main;
17145759b3d2Safresh1    ...
1715*256a93a4Safresh1    my $parser = MyPodParserTree->new(...);
17165759b3d2Safresh1    $parser->parse_from_file(...);
17175759b3d2Safresh1    my $paragraphs_ref = $parser->{'-paragraphs'};
17185759b3d2Safresh1
17195759b3d2Safresh1Of course, in this module-author's humble opinion, I'd be more inclined to
17205759b3d2Safresh1use the existing B<Pod::ParseTree> object than a simple array. That way
17215759b3d2Safresh1everything in it, paragraphs and sequences, all respond to the same core
17225759b3d2Safresh1interface for all parse-tree nodes. The result would look something like:
17235759b3d2Safresh1
17245759b3d2Safresh1    package MyPodParserTree2;
17255759b3d2Safresh1
17265759b3d2Safresh1    ...
17275759b3d2Safresh1
17285759b3d2Safresh1    sub begin_pod {
17295759b3d2Safresh1        my $self = shift;
1730*256a93a4Safresh1        $self->{'-ptree'} = Pod::ParseTree->new();  ## initialize parse-tree
17315759b3d2Safresh1    }
17325759b3d2Safresh1
17335759b3d2Safresh1    sub parse_tree {
17345759b3d2Safresh1        ## convenience method to get/set the parse-tree for the entire POD
17355759b3d2Safresh1        (@_ > 1)  and  $_[0]->{'-ptree'} = $_[1];
17365759b3d2Safresh1        return $_[0]->{'-ptree'};
17375759b3d2Safresh1    }
17385759b3d2Safresh1
17395759b3d2Safresh1    sub command {
17405759b3d2Safresh1        my ($parser, $command, $paragraph, $line_num, $pod_para) = @_;
17415759b3d2Safresh1        my $ptree = $parser->parse_text({<<options>>}, $paragraph, ...);
17425759b3d2Safresh1        $pod_para->parse_tree( $ptree );
17435759b3d2Safresh1        $parser->parse_tree()->append( $pod_para );
17445759b3d2Safresh1    }
17455759b3d2Safresh1
17465759b3d2Safresh1    sub verbatim {
17475759b3d2Safresh1        my ($parser, $paragraph, $line_num, $pod_para) = @_;
17485759b3d2Safresh1        $parser->parse_tree()->append( $pod_para );
17495759b3d2Safresh1    }
17505759b3d2Safresh1
17515759b3d2Safresh1    sub textblock {
17525759b3d2Safresh1        my ($parser, $paragraph, $line_num, $pod_para) = @_;
17535759b3d2Safresh1        my $ptree = $parser->parse_text({<<options>>}, $paragraph, ...);
17545759b3d2Safresh1        $pod_para->parse_tree( $ptree );
17555759b3d2Safresh1        $parser->parse_tree()->append( $pod_para );
17565759b3d2Safresh1    }
17575759b3d2Safresh1
17585759b3d2Safresh1    ...
17595759b3d2Safresh1
17605759b3d2Safresh1    package main;
17615759b3d2Safresh1    ...
1762*256a93a4Safresh1    my $parser = MyPodParserTree2->new(...);
17635759b3d2Safresh1    $parser->parse_from_file(...);
17645759b3d2Safresh1    my $ptree = $parser->parse_tree;
17655759b3d2Safresh1    ...
17665759b3d2Safresh1
17675759b3d2Safresh1Now you have the entire POD document as one great big parse-tree. You
17685759b3d2Safresh1can even use the B<-expand_seq> option to B<parse_text> to insert
17695759b3d2Safresh1whole different kinds of objects. Just don't expect B<Pod::Parser>
17705759b3d2Safresh1to know what to do with them after that. That will need to be in your
17715759b3d2Safresh1code. Or, alternatively, you can insert any object you like so long as
17725759b3d2Safresh1it conforms to the B<Pod::ParseTree> interface.
17735759b3d2Safresh1
17745759b3d2Safresh1One could use this to create subclasses of B<Pod::Paragraphs> and
17755759b3d2Safresh1B<Pod::InteriorSequences> for specific commands (or to create your own
17765759b3d2Safresh1custom node-types in the parse-tree) and add some kind of B<emit()>
17775759b3d2Safresh1method to each custom node/subclass object in the tree. Then all you'd
17785759b3d2Safresh1need to do is recursively walk the tree in the desired order, processing
17795759b3d2Safresh1the children (most likely from left to right) by formatting them if
17805759b3d2Safresh1they are text-strings, or by calling their B<emit()> method if they
17815759b3d2Safresh1are objects/references.
17825759b3d2Safresh1
17835759b3d2Safresh1=head1 CAVEATS
17845759b3d2Safresh1
17855759b3d2Safresh1Please note that POD has the notion of "paragraphs": this is something
17865759b3d2Safresh1starting I<after> a blank (read: empty) line, with the single exception
17875759b3d2Safresh1of the file start, which is also starting a paragraph. That means that
17885759b3d2Safresh1especially a command (e.g. C<=head1>) I<must> be preceded with a blank
17895759b3d2Safresh1line; C<__END__> is I<not> a blank line.
17905759b3d2Safresh1
17915759b3d2Safresh1=head1 SEE ALSO
17925759b3d2Safresh1
17935759b3d2Safresh1L<Pod::InputObjects>, L<Pod::Select>
17945759b3d2Safresh1
17955759b3d2Safresh1B<Pod::InputObjects> defines POD input objects corresponding to
17965759b3d2Safresh1command paragraphs, parse-trees, and interior-sequences.
17975759b3d2Safresh1
17985759b3d2Safresh1B<Pod::Select> is a subclass of B<Pod::Parser> which provides the ability
17995759b3d2Safresh1to selectively include and/or exclude sections of a POD document from being
18005759b3d2Safresh1translated based upon the current heading, subheading, subsubheading, etc.
18015759b3d2Safresh1
18025759b3d2Safresh1=for __PRIVATE__
18035759b3d2Safresh1B<Pod::Callbacks> is a subclass of B<Pod::Parser> which gives its users
18045759b3d2Safresh1the ability the employ I<callback functions> instead of, or in addition
18055759b3d2Safresh1to, overriding methods of the base class.
18065759b3d2Safresh1
18075759b3d2Safresh1=for __PRIVATE__
18085759b3d2Safresh1B<Pod::Select> and B<Pod::Callbacks> do not override any
18095759b3d2Safresh1methods nor do they define any new methods with the same name. Because
18105759b3d2Safresh1of this, they may I<both> be used (in combination) as a base class of
18115759b3d2Safresh1the same subclass in order to combine their functionality without
18125759b3d2Safresh1causing any namespace clashes due to multiple inheritance.
18135759b3d2Safresh1
18145759b3d2Safresh1=head1 AUTHOR
18155759b3d2Safresh1
18165759b3d2Safresh1Please report bugs using L<http://rt.cpan.org>.
18175759b3d2Safresh1
18185759b3d2Safresh1Brad Appleton E<lt>bradapp@enteract.comE<gt>
18195759b3d2Safresh1
18205759b3d2Safresh1Based on code for B<Pod::Text> written by
18215759b3d2Safresh1Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>
18225759b3d2Safresh1
18235759b3d2Safresh1=head1 LICENSE
18245759b3d2Safresh1
18255759b3d2Safresh1Pod-Parser is free software; you can redistribute it and/or modify it
18265759b3d2Safresh1under the terms of the Artistic License distributed with Perl version
18275759b3d2Safresh15.000 or (at your option) any later version. Please refer to the
18285759b3d2Safresh1Artistic License that came with your Perl distribution for more
18295759b3d2Safresh1details. If your version of Perl was not distributed under the
18305759b3d2Safresh1terms of the Artistic License, than you may distribute PodParser
18315759b3d2Safresh1under the same terms as Perl itself.
18325759b3d2Safresh1
18335759b3d2Safresh1=cut
18345759b3d2Safresh1
18355759b3d2Safresh11;
18365759b3d2Safresh1# vim: ts=4 sw=4 et
1837