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