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 = \&top;
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