15759b3d2Safresh1############################################################################# 25759b3d2Safresh1# Pod/InputObjects.pm -- package which defines objects for input streams 35759b3d2Safresh1# and paragraphs and commands when parsing POD docs. 45759b3d2Safresh1# 55759b3d2Safresh1# Copyright (C) 1996-2000 by Bradford Appleton. All rights reserved. 65759b3d2Safresh1# This file is part of "PodParser". PodParser is free software; 75759b3d2Safresh1# you can redistribute it and/or modify it under the same terms 85759b3d2Safresh1# as Perl itself. 95759b3d2Safresh1############################################################################# 105759b3d2Safresh1 115759b3d2Safresh1package Pod::InputObjects; 125759b3d2Safresh1use strict; 13*256a93a4Safresh1use warnings; 145759b3d2Safresh1 155759b3d2Safresh1use vars qw($VERSION); 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::InputObjects - objects representing POD input paragraphs, commands, etc. 245759b3d2Safresh1 255759b3d2Safresh1=head1 SYNOPSIS 265759b3d2Safresh1 275759b3d2Safresh1 use Pod::InputObjects; 285759b3d2Safresh1 295759b3d2Safresh1=head1 REQUIRES 305759b3d2Safresh1 315759b3d2Safresh1perl5.004, Carp 325759b3d2Safresh1 335759b3d2Safresh1=head1 EXPORTS 345759b3d2Safresh1 355759b3d2Safresh1Nothing. 365759b3d2Safresh1 375759b3d2Safresh1=head1 DESCRIPTION 385759b3d2Safresh1 395759b3d2Safresh1This module defines some basic input objects used by B<Pod::Parser> when 405759b3d2Safresh1reading and parsing POD text from an input source. The following objects 415759b3d2Safresh1are defined: 425759b3d2Safresh1 435759b3d2Safresh1=begin __PRIVATE__ 445759b3d2Safresh1 455759b3d2Safresh1=over 4 465759b3d2Safresh1 475759b3d2Safresh1=item package B<Pod::InputSource> 485759b3d2Safresh1 495759b3d2Safresh1An object corresponding to a source of POD input text. It is mostly a 505759b3d2Safresh1wrapper around a filehandle or C<IO::Handle>-type object (or anything 515759b3d2Safresh1that implements the C<getline()> method) which keeps track of some 525759b3d2Safresh1additional information relevant to the parsing of PODs. 535759b3d2Safresh1 545759b3d2Safresh1=back 555759b3d2Safresh1 565759b3d2Safresh1=end __PRIVATE__ 575759b3d2Safresh1 585759b3d2Safresh1=over 4 595759b3d2Safresh1 605759b3d2Safresh1=item package B<Pod::Paragraph> 615759b3d2Safresh1 625759b3d2Safresh1An object corresponding to a paragraph of POD input text. It may be a 635759b3d2Safresh1plain paragraph, a verbatim paragraph, or a command paragraph (see 645759b3d2Safresh1L<perlpod>). 655759b3d2Safresh1 665759b3d2Safresh1=item package B<Pod::InteriorSequence> 675759b3d2Safresh1 685759b3d2Safresh1An object corresponding to an interior sequence command from the POD 695759b3d2Safresh1input text (see L<perlpod>). 705759b3d2Safresh1 715759b3d2Safresh1=item package B<Pod::ParseTree> 725759b3d2Safresh1 735759b3d2Safresh1An object corresponding to a tree of parsed POD text. Each "node" in 745759b3d2Safresh1a parse-tree (or I<ptree>) is either a text-string or a reference to 755759b3d2Safresh1a B<Pod::InteriorSequence> object. The nodes appear in the parse-tree 765759b3d2Safresh1in the order in which they were parsed from left-to-right. 775759b3d2Safresh1 785759b3d2Safresh1=back 795759b3d2Safresh1 805759b3d2Safresh1Each of these input objects are described in further detail in the 815759b3d2Safresh1sections which follow. 825759b3d2Safresh1 835759b3d2Safresh1=cut 845759b3d2Safresh1 855759b3d2Safresh1############################################################################# 865759b3d2Safresh1 875759b3d2Safresh1package Pod::InputSource; 885759b3d2Safresh1 895759b3d2Safresh1##--------------------------------------------------------------------------- 905759b3d2Safresh1 915759b3d2Safresh1=begin __PRIVATE__ 925759b3d2Safresh1 935759b3d2Safresh1=head1 B<Pod::InputSource> 945759b3d2Safresh1 955759b3d2Safresh1This object corresponds to an input source or stream of POD 965759b3d2Safresh1documentation. When parsing PODs, it is necessary to associate and store 975759b3d2Safresh1certain context information with each input source. All of this 985759b3d2Safresh1information is kept together with the stream itself in one of these 995759b3d2Safresh1C<Pod::InputSource> objects. Each such object is merely a wrapper around 1005759b3d2Safresh1an C<IO::Handle> object of some kind (or at least something that 1015759b3d2Safresh1implements the C<getline()> method). They have the following 1025759b3d2Safresh1methods/attributes: 1035759b3d2Safresh1 1045759b3d2Safresh1=end __PRIVATE__ 1055759b3d2Safresh1 1065759b3d2Safresh1=cut 1075759b3d2Safresh1 1085759b3d2Safresh1##--------------------------------------------------------------------------- 1095759b3d2Safresh1 1105759b3d2Safresh1=begin __PRIVATE__ 1115759b3d2Safresh1 1125759b3d2Safresh1=head2 B<new()> 1135759b3d2Safresh1 1145759b3d2Safresh1 my $pod_input1 = Pod::InputSource->new(-handle => $filehandle); 115*256a93a4Safresh1 my $pod_input2 = Pod::InputSource->new(-handle => $filehandle, 1165759b3d2Safresh1 -name => $name); 117*256a93a4Safresh1 my $pod_input3 = Pod::InputSource->new(-handle => \*STDIN); 1185759b3d2Safresh1 my $pod_input4 = Pod::InputSource->new(-handle => \*STDIN, 1195759b3d2Safresh1 -name => "(STDIN)"); 1205759b3d2Safresh1 1215759b3d2Safresh1This is a class method that constructs a C<Pod::InputSource> object and 1225759b3d2Safresh1returns a reference to the new input source object. It takes one or more 1235759b3d2Safresh1keyword arguments in the form of a hash. The keyword C<-handle> is 1245759b3d2Safresh1required and designates the corresponding input handle. The keyword 1255759b3d2Safresh1C<-name> is optional and specifies the name associated with the input 1265759b3d2Safresh1handle (typically a file name). 1275759b3d2Safresh1 1285759b3d2Safresh1=end __PRIVATE__ 1295759b3d2Safresh1 1305759b3d2Safresh1=cut 1315759b3d2Safresh1 1325759b3d2Safresh1sub new { 1335759b3d2Safresh1 ## Determine if we were called via an object-ref or a classname 1345759b3d2Safresh1 my $this = shift; 1355759b3d2Safresh1 my $class = ref($this) || $this; 1365759b3d2Safresh1 1375759b3d2Safresh1 ## Any remaining arguments are treated as initial values for the 1385759b3d2Safresh1 ## hash that is used to represent this object. Note that we default 1395759b3d2Safresh1 ## certain values by specifying them *before* the arguments passed. 1405759b3d2Safresh1 ## If they are in the argument list, they will override the defaults. 1415759b3d2Safresh1 my $self = { -name => '(unknown)', 1425759b3d2Safresh1 -handle => undef, 1435759b3d2Safresh1 -was_cutting => 0, 1445759b3d2Safresh1 @_ }; 1455759b3d2Safresh1 1465759b3d2Safresh1 ## Bless ourselves into the desired class and perform any initialization 1475759b3d2Safresh1 bless $self, $class; 1485759b3d2Safresh1 return $self; 1495759b3d2Safresh1} 1505759b3d2Safresh1 1515759b3d2Safresh1##--------------------------------------------------------------------------- 1525759b3d2Safresh1 1535759b3d2Safresh1=begin __PRIVATE__ 1545759b3d2Safresh1 1555759b3d2Safresh1=head2 B<name()> 1565759b3d2Safresh1 1575759b3d2Safresh1 my $filename = $pod_input->name(); 1585759b3d2Safresh1 $pod_input->name($new_filename_to_use); 1595759b3d2Safresh1 1605759b3d2Safresh1This method gets/sets the name of the input source (usually a filename). 1615759b3d2Safresh1If no argument is given, it returns a string containing the name of 1625759b3d2Safresh1the input source; otherwise it sets the name of the input source to the 1635759b3d2Safresh1contents of the given argument. 1645759b3d2Safresh1 1655759b3d2Safresh1=end __PRIVATE__ 1665759b3d2Safresh1 1675759b3d2Safresh1=cut 1685759b3d2Safresh1 1695759b3d2Safresh1sub name { 1705759b3d2Safresh1 (@_ > 1) and $_[0]->{'-name'} = $_[1]; 1715759b3d2Safresh1 return $_[0]->{'-name'}; 1725759b3d2Safresh1} 1735759b3d2Safresh1 1745759b3d2Safresh1## allow 'filename' as an alias for 'name' 1755759b3d2Safresh1*filename = \&name; 1765759b3d2Safresh1 1775759b3d2Safresh1##--------------------------------------------------------------------------- 1785759b3d2Safresh1 1795759b3d2Safresh1=begin __PRIVATE__ 1805759b3d2Safresh1 1815759b3d2Safresh1=head2 B<handle()> 1825759b3d2Safresh1 1835759b3d2Safresh1 my $handle = $pod_input->handle(); 1845759b3d2Safresh1 1855759b3d2Safresh1Returns a reference to the handle object from which input is read (the 1865759b3d2Safresh1one used to contructed this input source object). 1875759b3d2Safresh1 1885759b3d2Safresh1=end __PRIVATE__ 1895759b3d2Safresh1 1905759b3d2Safresh1=cut 1915759b3d2Safresh1 1925759b3d2Safresh1sub handle { 1935759b3d2Safresh1 return $_[0]->{'-handle'}; 1945759b3d2Safresh1} 1955759b3d2Safresh1 1965759b3d2Safresh1##--------------------------------------------------------------------------- 1975759b3d2Safresh1 1985759b3d2Safresh1=begin __PRIVATE__ 1995759b3d2Safresh1 2005759b3d2Safresh1=head2 B<was_cutting()> 2015759b3d2Safresh1 2025759b3d2Safresh1 print "Yes.\n" if ($pod_input->was_cutting()); 2035759b3d2Safresh1 2045759b3d2Safresh1The value of the C<cutting> state (that the B<cutting()> method would 2055759b3d2Safresh1have returned) immediately before any input was read from this input 2065759b3d2Safresh1stream. After all input from this stream has been read, the C<cutting> 2075759b3d2Safresh1state is restored to this value. 2085759b3d2Safresh1 2095759b3d2Safresh1=end __PRIVATE__ 2105759b3d2Safresh1 2115759b3d2Safresh1=cut 2125759b3d2Safresh1 2135759b3d2Safresh1sub was_cutting { 2145759b3d2Safresh1 (@_ > 1) and $_[0]->{-was_cutting} = $_[1]; 2155759b3d2Safresh1 return $_[0]->{-was_cutting}; 2165759b3d2Safresh1} 2175759b3d2Safresh1 2185759b3d2Safresh1##--------------------------------------------------------------------------- 2195759b3d2Safresh1 2205759b3d2Safresh1############################################################################# 2215759b3d2Safresh1 2225759b3d2Safresh1package Pod::Paragraph; 2235759b3d2Safresh1 2245759b3d2Safresh1##--------------------------------------------------------------------------- 2255759b3d2Safresh1 2265759b3d2Safresh1=head1 B<Pod::Paragraph> 2275759b3d2Safresh1 2285759b3d2Safresh1An object representing a paragraph of POD input text. 2295759b3d2Safresh1It has the following methods/attributes: 2305759b3d2Safresh1 2315759b3d2Safresh1=cut 2325759b3d2Safresh1 2335759b3d2Safresh1##--------------------------------------------------------------------------- 2345759b3d2Safresh1 2355759b3d2Safresh1=head2 Pod::Paragraph-E<gt>B<new()> 2365759b3d2Safresh1 2375759b3d2Safresh1 my $pod_para1 = Pod::Paragraph->new(-text => $text); 2385759b3d2Safresh1 my $pod_para2 = Pod::Paragraph->new(-name => $cmd, 2395759b3d2Safresh1 -text => $text); 240*256a93a4Safresh1 my $pod_para3 = Pod::Paragraph->new(-text => $text); 241*256a93a4Safresh1 my $pod_para4 = Pod::Paragraph->new(-name => $cmd, 2425759b3d2Safresh1 -text => $text); 2435759b3d2Safresh1 my $pod_para5 = Pod::Paragraph->new(-name => $cmd, 2445759b3d2Safresh1 -text => $text, 2455759b3d2Safresh1 -file => $filename, 2465759b3d2Safresh1 -line => $line_number); 2475759b3d2Safresh1 2485759b3d2Safresh1This is a class method that constructs a C<Pod::Paragraph> object and 2495759b3d2Safresh1returns a reference to the new paragraph object. It may be given one or 2505759b3d2Safresh1two keyword arguments. The C<-text> keyword indicates the corresponding 2515759b3d2Safresh1text of the POD paragraph. The C<-name> keyword indicates the name of 2525759b3d2Safresh1the corresponding POD command, such as C<head1> or C<item> (it should 2535759b3d2Safresh1I<not> contain the C<=> prefix); this is needed only if the POD 2545759b3d2Safresh1paragraph corresponds to a command paragraph. The C<-file> and C<-line> 2555759b3d2Safresh1keywords indicate the filename and line number corresponding to the 2565759b3d2Safresh1beginning of the paragraph 2575759b3d2Safresh1 2585759b3d2Safresh1=cut 2595759b3d2Safresh1 2605759b3d2Safresh1sub new { 2615759b3d2Safresh1 ## Determine if we were called via an object-ref or a classname 2625759b3d2Safresh1 my $this = shift; 2635759b3d2Safresh1 my $class = ref($this) || $this; 2645759b3d2Safresh1 2655759b3d2Safresh1 ## Any remaining arguments are treated as initial values for the 2665759b3d2Safresh1 ## hash that is used to represent this object. Note that we default 2675759b3d2Safresh1 ## certain values by specifying them *before* the arguments passed. 2685759b3d2Safresh1 ## If they are in the argument list, they will override the defaults. 2695759b3d2Safresh1 my $self = { 2705759b3d2Safresh1 -name => undef, 2715759b3d2Safresh1 -text => (@_ == 1) ? shift : undef, 2725759b3d2Safresh1 -file => '<unknown-file>', 2735759b3d2Safresh1 -line => 0, 2745759b3d2Safresh1 -prefix => '=', 2755759b3d2Safresh1 -separator => ' ', 2765759b3d2Safresh1 -ptree => [], 2775759b3d2Safresh1 @_ 2785759b3d2Safresh1 }; 2795759b3d2Safresh1 2805759b3d2Safresh1 ## Bless ourselves into the desired class and perform any initialization 2815759b3d2Safresh1 bless $self, $class; 2825759b3d2Safresh1 return $self; 2835759b3d2Safresh1} 2845759b3d2Safresh1 2855759b3d2Safresh1##--------------------------------------------------------------------------- 2865759b3d2Safresh1 2875759b3d2Safresh1=head2 $pod_para-E<gt>B<cmd_name()> 2885759b3d2Safresh1 2895759b3d2Safresh1 my $para_cmd = $pod_para->cmd_name(); 2905759b3d2Safresh1 2915759b3d2Safresh1If this paragraph is a command paragraph, then this method will return 2925759b3d2Safresh1the name of the command (I<without> any leading C<=> prefix). 2935759b3d2Safresh1 2945759b3d2Safresh1=cut 2955759b3d2Safresh1 2965759b3d2Safresh1sub cmd_name { 2975759b3d2Safresh1 (@_ > 1) and $_[0]->{'-name'} = $_[1]; 2985759b3d2Safresh1 return $_[0]->{'-name'}; 2995759b3d2Safresh1} 3005759b3d2Safresh1 3015759b3d2Safresh1## let name() be an alias for cmd_name() 3025759b3d2Safresh1*name = \&cmd_name; 3035759b3d2Safresh1 3045759b3d2Safresh1##--------------------------------------------------------------------------- 3055759b3d2Safresh1 3065759b3d2Safresh1=head2 $pod_para-E<gt>B<text()> 3075759b3d2Safresh1 3085759b3d2Safresh1 my $para_text = $pod_para->text(); 3095759b3d2Safresh1 3105759b3d2Safresh1This method will return the corresponding text of the paragraph. 3115759b3d2Safresh1 3125759b3d2Safresh1=cut 3135759b3d2Safresh1 3145759b3d2Safresh1sub text { 3155759b3d2Safresh1 (@_ > 1) and $_[0]->{'-text'} = $_[1]; 3165759b3d2Safresh1 return $_[0]->{'-text'}; 3175759b3d2Safresh1} 3185759b3d2Safresh1 3195759b3d2Safresh1##--------------------------------------------------------------------------- 3205759b3d2Safresh1 3215759b3d2Safresh1=head2 $pod_para-E<gt>B<raw_text()> 3225759b3d2Safresh1 3235759b3d2Safresh1 my $raw_pod_para = $pod_para->raw_text(); 3245759b3d2Safresh1 3255759b3d2Safresh1This method will return the I<raw> text of the POD paragraph, exactly 3265759b3d2Safresh1as it appeared in the input. 3275759b3d2Safresh1 3285759b3d2Safresh1=cut 3295759b3d2Safresh1 3305759b3d2Safresh1sub raw_text { 3315759b3d2Safresh1 return $_[0]->{'-text'} unless (defined $_[0]->{'-name'}); 3325759b3d2Safresh1 return $_[0]->{'-prefix'} . $_[0]->{'-name'} . 3335759b3d2Safresh1 $_[0]->{'-separator'} . $_[0]->{'-text'}; 3345759b3d2Safresh1} 3355759b3d2Safresh1 3365759b3d2Safresh1##--------------------------------------------------------------------------- 3375759b3d2Safresh1 3385759b3d2Safresh1=head2 $pod_para-E<gt>B<cmd_prefix()> 3395759b3d2Safresh1 3405759b3d2Safresh1 my $prefix = $pod_para->cmd_prefix(); 3415759b3d2Safresh1 3425759b3d2Safresh1If this paragraph is a command paragraph, then this method will return 3435759b3d2Safresh1the prefix used to denote the command (which should be the string "=" 3445759b3d2Safresh1or "=="). 3455759b3d2Safresh1 3465759b3d2Safresh1=cut 3475759b3d2Safresh1 3485759b3d2Safresh1sub cmd_prefix { 3495759b3d2Safresh1 return $_[0]->{'-prefix'}; 3505759b3d2Safresh1} 3515759b3d2Safresh1 3525759b3d2Safresh1##--------------------------------------------------------------------------- 3535759b3d2Safresh1 3545759b3d2Safresh1=head2 $pod_para-E<gt>B<cmd_separator()> 3555759b3d2Safresh1 3565759b3d2Safresh1 my $separator = $pod_para->cmd_separator(); 3575759b3d2Safresh1 3585759b3d2Safresh1If this paragraph is a command paragraph, then this method will return 3595759b3d2Safresh1the text used to separate the command name from the rest of the 3605759b3d2Safresh1paragraph (if any). 3615759b3d2Safresh1 3625759b3d2Safresh1=cut 3635759b3d2Safresh1 3645759b3d2Safresh1sub cmd_separator { 3655759b3d2Safresh1 return $_[0]->{'-separator'}; 3665759b3d2Safresh1} 3675759b3d2Safresh1 3685759b3d2Safresh1##--------------------------------------------------------------------------- 3695759b3d2Safresh1 3705759b3d2Safresh1=head2 $pod_para-E<gt>B<parse_tree()> 3715759b3d2Safresh1 3725759b3d2Safresh1 my $ptree = $pod_parser->parse_text( $pod_para->text() ); 3735759b3d2Safresh1 $pod_para->parse_tree( $ptree ); 3745759b3d2Safresh1 $ptree = $pod_para->parse_tree(); 3755759b3d2Safresh1 3765759b3d2Safresh1This method will get/set the corresponding parse-tree of the paragraph's text. 3775759b3d2Safresh1 3785759b3d2Safresh1=cut 3795759b3d2Safresh1 3805759b3d2Safresh1sub parse_tree { 3815759b3d2Safresh1 (@_ > 1) and $_[0]->{'-ptree'} = $_[1]; 3825759b3d2Safresh1 return $_[0]->{'-ptree'}; 3835759b3d2Safresh1} 3845759b3d2Safresh1 3855759b3d2Safresh1## let ptree() be an alias for parse_tree() 3865759b3d2Safresh1*ptree = \&parse_tree; 3875759b3d2Safresh1 3885759b3d2Safresh1##--------------------------------------------------------------------------- 3895759b3d2Safresh1 3905759b3d2Safresh1=head2 $pod_para-E<gt>B<file_line()> 3915759b3d2Safresh1 3925759b3d2Safresh1 my ($filename, $line_number) = $pod_para->file_line(); 3935759b3d2Safresh1 my $position = $pod_para->file_line(); 3945759b3d2Safresh1 3955759b3d2Safresh1Returns the current filename and line number for the paragraph 3965759b3d2Safresh1object. If called in a list context, it returns a list of two 3975759b3d2Safresh1elements: first the filename, then the line number. If called in 3985759b3d2Safresh1a scalar context, it returns a string containing the filename, followed 3995759b3d2Safresh1by a colon (':'), followed by the line number. 4005759b3d2Safresh1 4015759b3d2Safresh1=cut 4025759b3d2Safresh1 4035759b3d2Safresh1sub file_line { 4045759b3d2Safresh1 my @loc = ($_[0]->{'-file'} || '<unknown-file>', 4055759b3d2Safresh1 $_[0]->{'-line'} || 0); 4065759b3d2Safresh1 return (wantarray) ? @loc : join(':', @loc); 4075759b3d2Safresh1} 4085759b3d2Safresh1 4095759b3d2Safresh1##--------------------------------------------------------------------------- 4105759b3d2Safresh1 4115759b3d2Safresh1############################################################################# 4125759b3d2Safresh1 4135759b3d2Safresh1package Pod::InteriorSequence; 4145759b3d2Safresh1 4155759b3d2Safresh1##--------------------------------------------------------------------------- 4165759b3d2Safresh1 4175759b3d2Safresh1=head1 B<Pod::InteriorSequence> 4185759b3d2Safresh1 4195759b3d2Safresh1An object representing a POD interior sequence command. 4205759b3d2Safresh1It has the following methods/attributes: 4215759b3d2Safresh1 4225759b3d2Safresh1=cut 4235759b3d2Safresh1 4245759b3d2Safresh1##--------------------------------------------------------------------------- 4255759b3d2Safresh1 4265759b3d2Safresh1=head2 Pod::InteriorSequence-E<gt>B<new()> 4275759b3d2Safresh1 4285759b3d2Safresh1 my $pod_seq1 = Pod::InteriorSequence->new(-name => $cmd 4295759b3d2Safresh1 -ldelim => $delimiter); 430*256a93a4Safresh1 my $pod_seq2 = Pod::InteriorSequence->new(-name => $cmd, 4315759b3d2Safresh1 -ldelim => $delimiter); 432*256a93a4Safresh1 my $pod_seq3 = Pod::InteriorSequence->new(-name => $cmd, 4335759b3d2Safresh1 -ldelim => $delimiter, 4345759b3d2Safresh1 -file => $filename, 4355759b3d2Safresh1 -line => $line_number); 4365759b3d2Safresh1 437*256a93a4Safresh1 my $pod_seq4 = Pod::InteriorSequence->new(-name => $cmd, $ptree); 438*256a93a4Safresh1 my $pod_seq5 = Pod::InteriorSequence->new($cmd, $ptree); 4395759b3d2Safresh1 4405759b3d2Safresh1This is a class method that constructs a C<Pod::InteriorSequence> object 4415759b3d2Safresh1and returns a reference to the new interior sequence object. It should 4425759b3d2Safresh1be given two keyword arguments. The C<-ldelim> keyword indicates the 4435759b3d2Safresh1corresponding left-delimiter of the interior sequence (e.g. 'E<lt>'). 4445759b3d2Safresh1The C<-name> keyword indicates the name of the corresponding interior 4455759b3d2Safresh1sequence command, such as C<I> or C<B> or C<C>. The C<-file> and 4465759b3d2Safresh1C<-line> keywords indicate the filename and line number corresponding 4475759b3d2Safresh1to the beginning of the interior sequence. If the C<$ptree> argument is 4485759b3d2Safresh1given, it must be the last argument, and it must be either string, or 4495759b3d2Safresh1else an array-ref suitable for passing to B<Pod::ParseTree::new> (or 4505759b3d2Safresh1it may be a reference to a Pod::ParseTree object). 4515759b3d2Safresh1 4525759b3d2Safresh1=cut 4535759b3d2Safresh1 4545759b3d2Safresh1sub new { 4555759b3d2Safresh1 ## Determine if we were called via an object-ref or a classname 4565759b3d2Safresh1 my $this = shift; 4575759b3d2Safresh1 my $class = ref($this) || $this; 4585759b3d2Safresh1 4595759b3d2Safresh1 ## See if first argument has no keyword 4605759b3d2Safresh1 if (((@_ <= 2) or (@_ % 2)) and $_[0] !~ /^-\w/) { 4615759b3d2Safresh1 ## Yup - need an implicit '-name' before first parameter 4625759b3d2Safresh1 unshift @_, '-name'; 4635759b3d2Safresh1 } 4645759b3d2Safresh1 4655759b3d2Safresh1 ## See if odd number of args 4665759b3d2Safresh1 if ((@_ % 2) != 0) { 4675759b3d2Safresh1 ## Yup - need an implicit '-ptree' before the last parameter 4685759b3d2Safresh1 splice @_, $#_, 0, '-ptree'; 4695759b3d2Safresh1 } 4705759b3d2Safresh1 4715759b3d2Safresh1 ## Any remaining arguments are treated as initial values for the 4725759b3d2Safresh1 ## hash that is used to represent this object. Note that we default 4735759b3d2Safresh1 ## certain values by specifying them *before* the arguments passed. 4745759b3d2Safresh1 ## If they are in the argument list, they will override the defaults. 4755759b3d2Safresh1 my $self = { 4765759b3d2Safresh1 -name => (@_ == 1) ? $_[0] : undef, 4775759b3d2Safresh1 -file => '<unknown-file>', 4785759b3d2Safresh1 -line => 0, 4795759b3d2Safresh1 -ldelim => '<', 4805759b3d2Safresh1 -rdelim => '>', 4815759b3d2Safresh1 @_ 4825759b3d2Safresh1 }; 4835759b3d2Safresh1 4845759b3d2Safresh1 ## Initialize contents if they havent been already 485*256a93a4Safresh1 my $ptree = $self->{'-ptree'} || Pod::ParseTree->new(); 4865759b3d2Safresh1 if ( ref $ptree =~ /^(ARRAY)?$/ ) { 4875759b3d2Safresh1 ## We have an array-ref, or a normal scalar. Pass it as an 4885759b3d2Safresh1 ## an argument to the ptree-constructor 489*256a93a4Safresh1 $ptree = Pod::ParseTree->new($1 ? [$ptree] : $ptree); 4905759b3d2Safresh1 } 4915759b3d2Safresh1 $self->{'-ptree'} = $ptree; 4925759b3d2Safresh1 4935759b3d2Safresh1 ## Bless ourselves into the desired class and perform any initialization 4945759b3d2Safresh1 bless $self, $class; 4955759b3d2Safresh1 return $self; 4965759b3d2Safresh1} 4975759b3d2Safresh1 4985759b3d2Safresh1##--------------------------------------------------------------------------- 4995759b3d2Safresh1 5005759b3d2Safresh1=head2 $pod_seq-E<gt>B<cmd_name()> 5015759b3d2Safresh1 5025759b3d2Safresh1 my $seq_cmd = $pod_seq->cmd_name(); 5035759b3d2Safresh1 5045759b3d2Safresh1The name of the interior sequence command. 5055759b3d2Safresh1 5065759b3d2Safresh1=cut 5075759b3d2Safresh1 5085759b3d2Safresh1sub cmd_name { 5095759b3d2Safresh1 (@_ > 1) and $_[0]->{'-name'} = $_[1]; 5105759b3d2Safresh1 return $_[0]->{'-name'}; 5115759b3d2Safresh1} 5125759b3d2Safresh1 5135759b3d2Safresh1## let name() be an alias for cmd_name() 5145759b3d2Safresh1*name = \&cmd_name; 5155759b3d2Safresh1 5165759b3d2Safresh1##--------------------------------------------------------------------------- 5175759b3d2Safresh1 5185759b3d2Safresh1## Private subroutine to set the parent pointer of all the given 5195759b3d2Safresh1## children that are interior-sequences to be $self 5205759b3d2Safresh1 5215759b3d2Safresh1sub _set_child2parent_links { 5225759b3d2Safresh1 my ($self, @children) = @_; 5235759b3d2Safresh1 ## Make sure any sequences know who their parent is 5245759b3d2Safresh1 for (@children) { 5255759b3d2Safresh1 next unless (length and ref and ref ne 'SCALAR'); 5265759b3d2Safresh1 if (UNIVERSAL::isa($_, 'Pod::InteriorSequence') or 5275759b3d2Safresh1 UNIVERSAL::can($_, 'nested')) 5285759b3d2Safresh1 { 5295759b3d2Safresh1 $_->nested($self); 5305759b3d2Safresh1 } 5315759b3d2Safresh1 } 5325759b3d2Safresh1} 5335759b3d2Safresh1 5345759b3d2Safresh1## Private subroutine to unset child->parent links 5355759b3d2Safresh1 5365759b3d2Safresh1sub _unset_child2parent_links { 5375759b3d2Safresh1 my $self = shift; 5385759b3d2Safresh1 $self->{'-parent_sequence'} = undef; 5395759b3d2Safresh1 my $ptree = $self->{'-ptree'}; 5405759b3d2Safresh1 for (@$ptree) { 5415759b3d2Safresh1 next unless (length and ref and ref ne 'SCALAR'); 5425759b3d2Safresh1 $_->_unset_child2parent_links() 5435759b3d2Safresh1 if UNIVERSAL::isa($_, 'Pod::InteriorSequence'); 5445759b3d2Safresh1 } 5455759b3d2Safresh1} 5465759b3d2Safresh1 5475759b3d2Safresh1##--------------------------------------------------------------------------- 5485759b3d2Safresh1 5495759b3d2Safresh1=head2 $pod_seq-E<gt>B<prepend()> 5505759b3d2Safresh1 5515759b3d2Safresh1 $pod_seq->prepend($text); 5525759b3d2Safresh1 $pod_seq1->prepend($pod_seq2); 5535759b3d2Safresh1 5545759b3d2Safresh1Prepends the given string or parse-tree or sequence object to the parse-tree 5555759b3d2Safresh1of this interior sequence. 5565759b3d2Safresh1 5575759b3d2Safresh1=cut 5585759b3d2Safresh1 5595759b3d2Safresh1sub prepend { 5605759b3d2Safresh1 my $self = shift; 5615759b3d2Safresh1 $self->{'-ptree'}->prepend(@_); 5625759b3d2Safresh1 _set_child2parent_links($self, @_); 5635759b3d2Safresh1 return $self; 5645759b3d2Safresh1} 5655759b3d2Safresh1 5665759b3d2Safresh1##--------------------------------------------------------------------------- 5675759b3d2Safresh1 5685759b3d2Safresh1=head2 $pod_seq-E<gt>B<append()> 5695759b3d2Safresh1 5705759b3d2Safresh1 $pod_seq->append($text); 5715759b3d2Safresh1 $pod_seq1->append($pod_seq2); 5725759b3d2Safresh1 5735759b3d2Safresh1Appends the given string or parse-tree or sequence object to the parse-tree 5745759b3d2Safresh1of this interior sequence. 5755759b3d2Safresh1 5765759b3d2Safresh1=cut 5775759b3d2Safresh1 5785759b3d2Safresh1sub append { 5795759b3d2Safresh1 my $self = shift; 5805759b3d2Safresh1 $self->{'-ptree'}->append(@_); 5815759b3d2Safresh1 _set_child2parent_links($self, @_); 5825759b3d2Safresh1 return $self; 5835759b3d2Safresh1} 5845759b3d2Safresh1 5855759b3d2Safresh1##--------------------------------------------------------------------------- 5865759b3d2Safresh1 5875759b3d2Safresh1=head2 $pod_seq-E<gt>B<nested()> 5885759b3d2Safresh1 5895759b3d2Safresh1 $outer_seq = $pod_seq->nested || print "not nested"; 5905759b3d2Safresh1 5915759b3d2Safresh1If this interior sequence is nested inside of another interior 5925759b3d2Safresh1sequence, then the outer/parent sequence that contains it is 5935759b3d2Safresh1returned. Otherwise C<undef> is returned. 5945759b3d2Safresh1 5955759b3d2Safresh1=cut 5965759b3d2Safresh1 5975759b3d2Safresh1sub nested { 5985759b3d2Safresh1 my $self = shift; 5995759b3d2Safresh1 (@_ == 1) and $self->{'-parent_sequence'} = shift; 6005759b3d2Safresh1 return $self->{'-parent_sequence'} || undef; 6015759b3d2Safresh1} 6025759b3d2Safresh1 6035759b3d2Safresh1##--------------------------------------------------------------------------- 6045759b3d2Safresh1 6055759b3d2Safresh1=head2 $pod_seq-E<gt>B<raw_text()> 6065759b3d2Safresh1 6075759b3d2Safresh1 my $seq_raw_text = $pod_seq->raw_text(); 6085759b3d2Safresh1 6095759b3d2Safresh1This method will return the I<raw> text of the POD interior sequence, 6105759b3d2Safresh1exactly as it appeared in the input. 6115759b3d2Safresh1 6125759b3d2Safresh1=cut 6135759b3d2Safresh1 6145759b3d2Safresh1sub raw_text { 6155759b3d2Safresh1 my $self = shift; 6165759b3d2Safresh1 my $text = $self->{'-name'} . $self->{'-ldelim'}; 6175759b3d2Safresh1 for ( $self->{'-ptree'}->children ) { 6185759b3d2Safresh1 $text .= (ref $_) ? $_->raw_text : $_; 6195759b3d2Safresh1 } 6205759b3d2Safresh1 $text .= $self->{'-rdelim'}; 6215759b3d2Safresh1 return $text; 6225759b3d2Safresh1} 6235759b3d2Safresh1 6245759b3d2Safresh1##--------------------------------------------------------------------------- 6255759b3d2Safresh1 6265759b3d2Safresh1=head2 $pod_seq-E<gt>B<left_delimiter()> 6275759b3d2Safresh1 6285759b3d2Safresh1 my $ldelim = $pod_seq->left_delimiter(); 6295759b3d2Safresh1 6305759b3d2Safresh1The leftmost delimiter beginning the argument text to the interior 6315759b3d2Safresh1sequence (should be "<"). 6325759b3d2Safresh1 6335759b3d2Safresh1=cut 6345759b3d2Safresh1 6355759b3d2Safresh1sub left_delimiter { 6365759b3d2Safresh1 (@_ > 1) and $_[0]->{'-ldelim'} = $_[1]; 6375759b3d2Safresh1 return $_[0]->{'-ldelim'}; 6385759b3d2Safresh1} 6395759b3d2Safresh1 6405759b3d2Safresh1## let ldelim() be an alias for left_delimiter() 6415759b3d2Safresh1*ldelim = \&left_delimiter; 6425759b3d2Safresh1 6435759b3d2Safresh1##--------------------------------------------------------------------------- 6445759b3d2Safresh1 6455759b3d2Safresh1=head2 $pod_seq-E<gt>B<right_delimiter()> 6465759b3d2Safresh1 6475759b3d2Safresh1The rightmost delimiter beginning the argument text to the interior 6485759b3d2Safresh1sequence (should be ">"). 6495759b3d2Safresh1 6505759b3d2Safresh1=cut 6515759b3d2Safresh1 6525759b3d2Safresh1sub right_delimiter { 6535759b3d2Safresh1 (@_ > 1) and $_[0]->{'-rdelim'} = $_[1]; 6545759b3d2Safresh1 return $_[0]->{'-rdelim'}; 6555759b3d2Safresh1} 6565759b3d2Safresh1 6575759b3d2Safresh1## let rdelim() be an alias for right_delimiter() 6585759b3d2Safresh1*rdelim = \&right_delimiter; 6595759b3d2Safresh1 6605759b3d2Safresh1##--------------------------------------------------------------------------- 6615759b3d2Safresh1 6625759b3d2Safresh1=head2 $pod_seq-E<gt>B<parse_tree()> 6635759b3d2Safresh1 6645759b3d2Safresh1 my $ptree = $pod_parser->parse_text($paragraph_text); 6655759b3d2Safresh1 $pod_seq->parse_tree( $ptree ); 6665759b3d2Safresh1 $ptree = $pod_seq->parse_tree(); 6675759b3d2Safresh1 6685759b3d2Safresh1This method will get/set the corresponding parse-tree of the interior 6695759b3d2Safresh1sequence's text. 6705759b3d2Safresh1 6715759b3d2Safresh1=cut 6725759b3d2Safresh1 6735759b3d2Safresh1sub parse_tree { 6745759b3d2Safresh1 (@_ > 1) and $_[0]->{'-ptree'} = $_[1]; 6755759b3d2Safresh1 return $_[0]->{'-ptree'}; 6765759b3d2Safresh1} 6775759b3d2Safresh1 6785759b3d2Safresh1## let ptree() be an alias for parse_tree() 6795759b3d2Safresh1*ptree = \&parse_tree; 6805759b3d2Safresh1 6815759b3d2Safresh1##--------------------------------------------------------------------------- 6825759b3d2Safresh1 6835759b3d2Safresh1=head2 $pod_seq-E<gt>B<file_line()> 6845759b3d2Safresh1 6855759b3d2Safresh1 my ($filename, $line_number) = $pod_seq->file_line(); 6865759b3d2Safresh1 my $position = $pod_seq->file_line(); 6875759b3d2Safresh1 6885759b3d2Safresh1Returns the current filename and line number for the interior sequence 6895759b3d2Safresh1object. If called in a list context, it returns a list of two 6905759b3d2Safresh1elements: first the filename, then the line number. If called in 6915759b3d2Safresh1a scalar context, it returns a string containing the filename, followed 6925759b3d2Safresh1by a colon (':'), followed by the line number. 6935759b3d2Safresh1 6945759b3d2Safresh1=cut 6955759b3d2Safresh1 6965759b3d2Safresh1sub file_line { 6975759b3d2Safresh1 my @loc = ($_[0]->{'-file'} || '<unknown-file>', 6985759b3d2Safresh1 $_[0]->{'-line'} || 0); 6995759b3d2Safresh1 return (wantarray) ? @loc : join(':', @loc); 7005759b3d2Safresh1} 7015759b3d2Safresh1 7025759b3d2Safresh1##--------------------------------------------------------------------------- 7035759b3d2Safresh1 7045759b3d2Safresh1=head2 Pod::InteriorSequence::B<DESTROY()> 7055759b3d2Safresh1 7065759b3d2Safresh1This method performs any necessary cleanup for the interior-sequence. 7075759b3d2Safresh1If you override this method then it is B<imperative> that you invoke 7085759b3d2Safresh1the parent method from within your own method, otherwise 7095759b3d2Safresh1I<interior-sequence storage will not be reclaimed upon destruction!> 7105759b3d2Safresh1 7115759b3d2Safresh1=cut 7125759b3d2Safresh1 7135759b3d2Safresh1sub DESTROY { 7145759b3d2Safresh1 ## We need to get rid of all child->parent pointers throughout the 7155759b3d2Safresh1 ## tree so their reference counts will go to zero and they can be 7165759b3d2Safresh1 ## garbage-collected 7175759b3d2Safresh1 _unset_child2parent_links(@_); 7185759b3d2Safresh1} 7195759b3d2Safresh1 7205759b3d2Safresh1##--------------------------------------------------------------------------- 7215759b3d2Safresh1 7225759b3d2Safresh1############################################################################# 7235759b3d2Safresh1 7245759b3d2Safresh1package Pod::ParseTree; 7255759b3d2Safresh1 7265759b3d2Safresh1##--------------------------------------------------------------------------- 7275759b3d2Safresh1 7285759b3d2Safresh1=head1 B<Pod::ParseTree> 7295759b3d2Safresh1 7305759b3d2Safresh1This object corresponds to a tree of parsed POD text. As POD text is 7315759b3d2Safresh1scanned from left to right, it is parsed into an ordered list of 7325759b3d2Safresh1text-strings and B<Pod::InteriorSequence> objects (in order of 7335759b3d2Safresh1appearance). A B<Pod::ParseTree> object corresponds to this list of 7345759b3d2Safresh1strings and sequences. Each interior sequence in the parse-tree may 7355759b3d2Safresh1itself contain a parse-tree (since interior sequences may be nested). 7365759b3d2Safresh1 7375759b3d2Safresh1=cut 7385759b3d2Safresh1 7395759b3d2Safresh1##--------------------------------------------------------------------------- 7405759b3d2Safresh1 7415759b3d2Safresh1=head2 Pod::ParseTree-E<gt>B<new()> 7425759b3d2Safresh1 7435759b3d2Safresh1 my $ptree1 = Pod::ParseTree->new; 744*256a93a4Safresh1 my $ptree2 = Pod::ParseTree->new($array_ref); 7455759b3d2Safresh1 7465759b3d2Safresh1This is a class method that constructs a C<Pod::Parse_tree> object and 7475759b3d2Safresh1returns a reference to the new parse-tree. If a single-argument is given, 7485759b3d2Safresh1it must be a reference to an array, and is used to initialize the root 7495759b3d2Safresh1(top) of the parse tree. 7505759b3d2Safresh1 7515759b3d2Safresh1=cut 7525759b3d2Safresh1 7535759b3d2Safresh1sub new { 7545759b3d2Safresh1 ## Determine if we were called via an object-ref or a classname 7555759b3d2Safresh1 my $this = shift; 7565759b3d2Safresh1 my $class = ref($this) || $this; 7575759b3d2Safresh1 7585759b3d2Safresh1 my $self = (@_ == 1 and ref $_[0]) ? $_[0] : []; 7595759b3d2Safresh1 7605759b3d2Safresh1 ## Bless ourselves into the desired class and perform any initialization 7615759b3d2Safresh1 bless $self, $class; 7625759b3d2Safresh1 return $self; 7635759b3d2Safresh1} 7645759b3d2Safresh1 7655759b3d2Safresh1##--------------------------------------------------------------------------- 7665759b3d2Safresh1 7675759b3d2Safresh1=head2 $ptree-E<gt>B<top()> 7685759b3d2Safresh1 7695759b3d2Safresh1 my $top_node = $ptree->top(); 7705759b3d2Safresh1 $ptree->top( $top_node ); 7715759b3d2Safresh1 $ptree->top( @children ); 7725759b3d2Safresh1 7735759b3d2Safresh1This method gets/sets the top node of the parse-tree. If no arguments are 7745759b3d2Safresh1given, it returns the topmost node in the tree (the root), which is also 7755759b3d2Safresh1a B<Pod::ParseTree>. If it is given a single argument that is a reference, 7765759b3d2Safresh1then the reference is assumed to a parse-tree and becomes the new top node. 7775759b3d2Safresh1Otherwise, if arguments are given, they are treated as the new list of 7785759b3d2Safresh1children for the top node. 7795759b3d2Safresh1 7805759b3d2Safresh1=cut 7815759b3d2Safresh1 7825759b3d2Safresh1sub top { 7835759b3d2Safresh1 my $self = shift; 7845759b3d2Safresh1 if (@_ > 0) { 7855759b3d2Safresh1 @{ $self } = (@_ == 1 and ref $_[0]) ? ${ @_ } : @_; 7865759b3d2Safresh1 } 7875759b3d2Safresh1 return $self; 7885759b3d2Safresh1} 7895759b3d2Safresh1 7905759b3d2Safresh1## let parse_tree() & ptree() be aliases for the 'top' method 7915759b3d2Safresh1*parse_tree = *ptree = \⊤ 7925759b3d2Safresh1 7935759b3d2Safresh1##--------------------------------------------------------------------------- 7945759b3d2Safresh1 7955759b3d2Safresh1=head2 $ptree-E<gt>B<children()> 7965759b3d2Safresh1 7975759b3d2Safresh1This method gets/sets the children of the top node in the parse-tree. 7985759b3d2Safresh1If no arguments are given, it returns the list (array) of children 7995759b3d2Safresh1(each of which should be either a string or a B<Pod::InteriorSequence>. 8005759b3d2Safresh1Otherwise, if arguments are given, they are treated as the new list of 8015759b3d2Safresh1children for the top node. 8025759b3d2Safresh1 8035759b3d2Safresh1=cut 8045759b3d2Safresh1 8055759b3d2Safresh1sub children { 8065759b3d2Safresh1 my $self = shift; 8075759b3d2Safresh1 if (@_ > 0) { 8085759b3d2Safresh1 @{ $self } = (@_ == 1 and ref $_[0]) ? ${ @_ } : @_; 8095759b3d2Safresh1 } 8105759b3d2Safresh1 return @{ $self }; 8115759b3d2Safresh1} 8125759b3d2Safresh1 8135759b3d2Safresh1##--------------------------------------------------------------------------- 8145759b3d2Safresh1 8155759b3d2Safresh1=head2 $ptree-E<gt>B<prepend()> 8165759b3d2Safresh1 8175759b3d2Safresh1This method prepends the given text or parse-tree to the current parse-tree. 8185759b3d2Safresh1If the first item on the parse-tree is text and the argument is also text, 8195759b3d2Safresh1then the text is prepended to the first item (not added as a separate string). 8205759b3d2Safresh1Otherwise the argument is added as a new string or parse-tree I<before> 8215759b3d2Safresh1the current one. 8225759b3d2Safresh1 8235759b3d2Safresh1=cut 8245759b3d2Safresh1 8255759b3d2Safresh1use vars qw(@ptree); ## an alias used for performance reasons 8265759b3d2Safresh1 8275759b3d2Safresh1sub prepend { 8285759b3d2Safresh1 my $self = shift; 8295759b3d2Safresh1 local *ptree = $self; 8305759b3d2Safresh1 for (@_) { 8315759b3d2Safresh1 next unless length; 8325759b3d2Safresh1 if (@ptree && !(ref $ptree[0]) && !(ref $_)) { 8335759b3d2Safresh1 $ptree[0] = $_ . $ptree[0]; 8345759b3d2Safresh1 } 8355759b3d2Safresh1 else { 8365759b3d2Safresh1 unshift @ptree, $_; 8375759b3d2Safresh1 } 8385759b3d2Safresh1 } 8395759b3d2Safresh1} 8405759b3d2Safresh1 8415759b3d2Safresh1##--------------------------------------------------------------------------- 8425759b3d2Safresh1 8435759b3d2Safresh1=head2 $ptree-E<gt>B<append()> 8445759b3d2Safresh1 8455759b3d2Safresh1This method appends the given text or parse-tree to the current parse-tree. 8465759b3d2Safresh1If the last item on the parse-tree is text and the argument is also text, 8475759b3d2Safresh1then the text is appended to the last item (not added as a separate string). 8485759b3d2Safresh1Otherwise the argument is added as a new string or parse-tree I<after> 8495759b3d2Safresh1the current one. 8505759b3d2Safresh1 8515759b3d2Safresh1=cut 8525759b3d2Safresh1 8535759b3d2Safresh1sub append { 8545759b3d2Safresh1 my $self = shift; 8555759b3d2Safresh1 local *ptree = $self; 8565759b3d2Safresh1 my $can_append = @ptree && !(ref $ptree[-1]); 8575759b3d2Safresh1 for (@_) { 8585759b3d2Safresh1 if (ref) { 8595759b3d2Safresh1 push @ptree, $_; 8605759b3d2Safresh1 } 8615759b3d2Safresh1 elsif(!length) { 8625759b3d2Safresh1 next; 8635759b3d2Safresh1 } 8645759b3d2Safresh1 elsif ($can_append) { 8655759b3d2Safresh1 $ptree[-1] .= $_; 8665759b3d2Safresh1 } 8675759b3d2Safresh1 else { 8685759b3d2Safresh1 push @ptree, $_; 8695759b3d2Safresh1 } 8705759b3d2Safresh1 } 8715759b3d2Safresh1} 8725759b3d2Safresh1 8735759b3d2Safresh1=head2 $ptree-E<gt>B<raw_text()> 8745759b3d2Safresh1 8755759b3d2Safresh1 my $ptree_raw_text = $ptree->raw_text(); 8765759b3d2Safresh1 8775759b3d2Safresh1This method will return the I<raw> text of the POD parse-tree 8785759b3d2Safresh1exactly as it appeared in the input. 8795759b3d2Safresh1 8805759b3d2Safresh1=cut 8815759b3d2Safresh1 8825759b3d2Safresh1sub raw_text { 8835759b3d2Safresh1 my $self = shift; 8845759b3d2Safresh1 my $text = ''; 8855759b3d2Safresh1 for ( @$self ) { 8865759b3d2Safresh1 $text .= (ref $_) ? $_->raw_text : $_; 8875759b3d2Safresh1 } 8885759b3d2Safresh1 return $text; 8895759b3d2Safresh1} 8905759b3d2Safresh1 8915759b3d2Safresh1##--------------------------------------------------------------------------- 8925759b3d2Safresh1 8935759b3d2Safresh1## Private routines to set/unset child->parent links 8945759b3d2Safresh1 8955759b3d2Safresh1sub _unset_child2parent_links { 8965759b3d2Safresh1 my $self = shift; 8975759b3d2Safresh1 local *ptree = $self; 8985759b3d2Safresh1 for (@ptree) { 8995759b3d2Safresh1 next unless (defined and length and ref and ref ne 'SCALAR'); 9005759b3d2Safresh1 $_->_unset_child2parent_links() 9015759b3d2Safresh1 if UNIVERSAL::isa($_, 'Pod::InteriorSequence'); 9025759b3d2Safresh1 } 9035759b3d2Safresh1} 9045759b3d2Safresh1 9055759b3d2Safresh1sub _set_child2parent_links { 9065759b3d2Safresh1 ## nothing to do, Pod::ParseTrees cant have parent pointers 9075759b3d2Safresh1} 9085759b3d2Safresh1 9095759b3d2Safresh1=head2 Pod::ParseTree::B<DESTROY()> 9105759b3d2Safresh1 9115759b3d2Safresh1This method performs any necessary cleanup for the parse-tree. 9125759b3d2Safresh1If you override this method then it is B<imperative> 9135759b3d2Safresh1that you invoke the parent method from within your own method, 9145759b3d2Safresh1otherwise I<parse-tree storage will not be reclaimed upon destruction!> 9155759b3d2Safresh1 9165759b3d2Safresh1=cut 9175759b3d2Safresh1 9185759b3d2Safresh1sub DESTROY { 9195759b3d2Safresh1 ## We need to get rid of all child->parent pointers throughout the 9205759b3d2Safresh1 ## tree so their reference counts will go to zero and they can be 9215759b3d2Safresh1 ## garbage-collected 9225759b3d2Safresh1 _unset_child2parent_links(@_); 9235759b3d2Safresh1} 9245759b3d2Safresh1 9255759b3d2Safresh1############################################################################# 9265759b3d2Safresh1 9275759b3d2Safresh1=head1 SEE ALSO 9285759b3d2Safresh1 9295759b3d2Safresh1B<Pod::InputObjects> is part of the L<Pod::Parser> distribution. 9305759b3d2Safresh1 9315759b3d2Safresh1See L<Pod::Parser>, L<Pod::Select> 9325759b3d2Safresh1 9335759b3d2Safresh1=head1 AUTHOR 9345759b3d2Safresh1 9355759b3d2Safresh1Please report bugs using L<http://rt.cpan.org>. 9365759b3d2Safresh1 9375759b3d2Safresh1Brad Appleton E<lt>bradapp@enteract.comE<gt> 9385759b3d2Safresh1 9395759b3d2Safresh1=cut 9405759b3d2Safresh1 9415759b3d2Safresh11; 942