1 #############################################################################
2 # Pod/InputObjects.pm -- package which defines objects for input streams
3 # and paragraphs and commands when parsing POD docs.
5 # Copyright (C) 1996-2000 by Bradford Appleton. All rights reserved.
6 # This file is part of "PodParser". PodParser is free software;
7 # you can redistribute it and/or modify it under the same terms
9 #############################################################################
11 package Pod::InputObjects;
14 use vars qw($VERSION);
15 $VERSION = '1.31'; ## Current version of this package
16 require 5.005; ## requires this Perl version or later
18 #############################################################################
22 Pod::InputObjects - objects representing POD input paragraphs, commands, etc.
26 use Pod::InputObjects;
38 This module defines some basic input objects used by B<Pod::Parser> when
39 reading and parsing POD text from an input source. The following objects
46 =item package B<Pod::InputSource>
48 An object corresponding to a source of POD input text. It is mostly a
49 wrapper around a filehandle or C<IO::Handle>-type object (or anything
50 that implements the C<getline()> method) which keeps track of some
51 additional information relevant to the parsing of PODs.
55 =item package B<Pod::Paragraph>
57 An object corresponding to a paragraph of POD input text. It may be a
58 plain paragraph, a verbatim paragraph, or a command paragraph (see
61 =item package B<Pod::InteriorSequence>
63 An object corresponding to an interior sequence command from the POD
64 input text (see L<perlpod>).
66 =item package B<Pod::ParseTree>
68 An object corresponding to a tree of parsed POD text. Each "node" in
69 a parse-tree (or I<ptree>) is either a text-string or a reference to
70 a B<Pod::InteriorSequence> object. The nodes appear in the parse-tree
71 in the order in which they were parsed from left-to-right.
75 Each of these input objects are described in further detail in the
76 sections which follow.
80 #############################################################################
82 package Pod::InputSource;
84 ##---------------------------------------------------------------------------
88 =head1 B<Pod::InputSource>
90 This object corresponds to an input source or stream of POD
91 documentation. When parsing PODs, it is necessary to associate and store
92 certain context information with each input source. All of this
93 information is kept together with the stream itself in one of these
94 C<Pod::InputSource> objects. Each such object is merely a wrapper around
95 an C<IO::Handle> object of some kind (or at least something that
96 implements the C<getline()> method). They have the following
103 ##---------------------------------------------------------------------------
109 my $pod_input1 = Pod::InputSource->new(-handle => $filehandle);
110 my $pod_input2 = new Pod::InputSource(-handle => $filehandle,
112 my $pod_input3 = new Pod::InputSource(-handle => \*STDIN);
113 my $pod_input4 = Pod::InputSource->new(-handle => \*STDIN,
116 This is a class method that constructs a C<Pod::InputSource> object and
117 returns a reference to the new input source object. It takes one or more
118 keyword arguments in the form of a hash. The keyword C<-handle> is
119 required and designates the corresponding input handle. The keyword
120 C<-name> is optional and specifies the name associated with the input
121 handle (typically a file name).
128 ## Determine if we were called via an object-ref or a classname
130 my $class = ref($this) || $this;
132 ## Any remaining arguments are treated as initial values for the
133 ## hash that is used to represent this object. Note that we default
134 ## certain values by specifying them *before* the arguments passed.
135 ## If they are in the argument list, they will override the defaults.
136 my $self = { -name => '(unknown)',
141 ## Bless ourselves into the desired class and perform any initialization
146 ##---------------------------------------------------------------------------
152 my $filename = $pod_input->name();
153 $pod_input->name($new_filename_to_use);
155 This method gets/sets the name of the input source (usually a filename).
156 If no argument is given, it returns a string containing the name of
157 the input source; otherwise it sets the name of the input source to the
158 contents of the given argument.
165 (@_ > 1) and $_[0]->{'-name'} = $_[1];
166 return $_[0]->{'-name'};
169 ## allow 'filename' as an alias for 'name'
172 ##---------------------------------------------------------------------------
178 my $handle = $pod_input->handle();
180 Returns a reference to the handle object from which input is read (the
181 one used to contructed this input source object).
188 return $_[0]->{'-handle'};
191 ##---------------------------------------------------------------------------
195 =head2 B<was_cutting()>
197 print "Yes.\n" if ($pod_input->was_cutting());
199 The value of the C<cutting> state (that the B<cutting()> method would
200 have returned) immediately before any input was read from this input
201 stream. After all input from this stream has been read, the C<cutting>
202 state is restored to this value.
209 (@_ > 1) and $_[0]->{-was_cutting} = $_[1];
210 return $_[0]->{-was_cutting};
213 ##---------------------------------------------------------------------------
215 #############################################################################
217 package Pod::Paragraph;
219 ##---------------------------------------------------------------------------
221 =head1 B<Pod::Paragraph>
223 An object representing a paragraph of POD input text.
224 It has the following methods/attributes:
228 ##---------------------------------------------------------------------------
230 =head2 Pod::Paragraph-E<gt>B<new()>
232 my $pod_para1 = Pod::Paragraph->new(-text => $text);
233 my $pod_para2 = Pod::Paragraph->new(-name => $cmd,
235 my $pod_para3 = new Pod::Paragraph(-text => $text);
236 my $pod_para4 = new Pod::Paragraph(-name => $cmd,
238 my $pod_para5 = Pod::Paragraph->new(-name => $cmd,
241 -line => $line_number);
243 This is a class method that constructs a C<Pod::Paragraph> object and
244 returns a reference to the new paragraph object. It may be given one or
245 two keyword arguments. The C<-text> keyword indicates the corresponding
246 text of the POD paragraph. The C<-name> keyword indicates the name of
247 the corresponding POD command, such as C<head1> or C<item> (it should
248 I<not> contain the C<=> prefix); this is needed only if the POD
249 paragraph corresponds to a command paragraph. The C<-file> and C<-line>
250 keywords indicate the filename and line number corresponding to the
251 beginning of the paragraph
256 ## Determine if we were called via an object-ref or a classname
258 my $class = ref($this) || $this;
260 ## Any remaining arguments are treated as initial values for the
261 ## hash that is used to represent this object. Note that we default
262 ## certain values by specifying them *before* the arguments passed.
263 ## If they are in the argument list, they will override the defaults.
266 -text => (@_ == 1) ? shift : undef,
267 -file => '<unknown-file>',
275 ## Bless ourselves into the desired class and perform any initialization
280 ##---------------------------------------------------------------------------
282 =head2 $pod_para-E<gt>B<cmd_name()>
284 my $para_cmd = $pod_para->cmd_name();
286 If this paragraph is a command paragraph, then this method will return
287 the name of the command (I<without> any leading C<=> prefix).
292 (@_ > 1) and $_[0]->{'-name'} = $_[1];
293 return $_[0]->{'-name'};
296 ## let name() be an alias for cmd_name()
299 ##---------------------------------------------------------------------------
301 =head2 $pod_para-E<gt>B<text()>
303 my $para_text = $pod_para->text();
305 This method will return the corresponding text of the paragraph.
310 (@_ > 1) and $_[0]->{'-text'} = $_[1];
311 return $_[0]->{'-text'};
314 ##---------------------------------------------------------------------------
316 =head2 $pod_para-E<gt>B<raw_text()>
318 my $raw_pod_para = $pod_para->raw_text();
320 This method will return the I<raw> text of the POD paragraph, exactly
321 as it appeared in the input.
326 return $_[0]->{'-text'} unless (defined $_[0]->{'-name'});
327 return $_[0]->{'-prefix'} . $_[0]->{'-name'} .
328 $_[0]->{'-separator'} . $_[0]->{'-text'};
331 ##---------------------------------------------------------------------------
333 =head2 $pod_para-E<gt>B<cmd_prefix()>
335 my $prefix = $pod_para->cmd_prefix();
337 If this paragraph is a command paragraph, then this method will return
338 the prefix used to denote the command (which should be the string "="
344 return $_[0]->{'-prefix'};
347 ##---------------------------------------------------------------------------
349 =head2 $pod_para-E<gt>B<cmd_separator()>
351 my $separator = $pod_para->cmd_separator();
353 If this paragraph is a command paragraph, then this method will return
354 the text used to separate the command name from the rest of the
360 return $_[0]->{'-separator'};
363 ##---------------------------------------------------------------------------
365 =head2 $pod_para-E<gt>B<parse_tree()>
367 my $ptree = $pod_parser->parse_text( $pod_para->text() );
368 $pod_para->parse_tree( $ptree );
369 $ptree = $pod_para->parse_tree();
371 This method will get/set the corresponding parse-tree of the paragraph's text.
376 (@_ > 1) and $_[0]->{'-ptree'} = $_[1];
377 return $_[0]->{'-ptree'};
380 ## let ptree() be an alias for parse_tree()
381 *ptree = \&parse_tree;
383 ##---------------------------------------------------------------------------
385 =head2 $pod_para-E<gt>B<file_line()>
387 my ($filename, $line_number) = $pod_para->file_line();
388 my $position = $pod_para->file_line();
390 Returns the current filename and line number for the paragraph
391 object. If called in a list context, it returns a list of two
392 elements: first the filename, then the line number. If called in
393 a scalar context, it returns a string containing the filename, followed
394 by a colon (':'), followed by the line number.
399 my @loc = ($_[0]->{'-file'} || '<unknown-file>',
400 $_[0]->{'-line'} || 0);
401 return (wantarray) ? @loc : join(':', @loc);
404 ##---------------------------------------------------------------------------
406 #############################################################################
408 package Pod::InteriorSequence;
410 ##---------------------------------------------------------------------------
412 =head1 B<Pod::InteriorSequence>
414 An object representing a POD interior sequence command.
415 It has the following methods/attributes:
419 ##---------------------------------------------------------------------------
421 =head2 Pod::InteriorSequence-E<gt>B<new()>
423 my $pod_seq1 = Pod::InteriorSequence->new(-name => $cmd
424 -ldelim => $delimiter);
425 my $pod_seq2 = new Pod::InteriorSequence(-name => $cmd,
426 -ldelim => $delimiter);
427 my $pod_seq3 = new Pod::InteriorSequence(-name => $cmd,
428 -ldelim => $delimiter,
430 -line => $line_number);
432 my $pod_seq4 = new Pod::InteriorSequence(-name => $cmd, $ptree);
433 my $pod_seq5 = new Pod::InteriorSequence($cmd, $ptree);
435 This is a class method that constructs a C<Pod::InteriorSequence> object
436 and returns a reference to the new interior sequence object. It should
437 be given two keyword arguments. The C<-ldelim> keyword indicates the
438 corresponding left-delimiter of the interior sequence (e.g. 'E<lt>').
439 The C<-name> keyword indicates the name of the corresponding interior
440 sequence command, such as C<I> or C<B> or C<C>. The C<-file> and
441 C<-line> keywords indicate the filename and line number corresponding
442 to the beginning of the interior sequence. If the C<$ptree> argument is
443 given, it must be the last argument, and it must be either string, or
444 else an array-ref suitable for passing to B<Pod::ParseTree::new> (or
445 it may be a reference to a Pod::ParseTree object).
450 ## Determine if we were called via an object-ref or a classname
452 my $class = ref($this) || $this;
454 ## See if first argument has no keyword
455 if (((@_ <= 2) or (@_ % 2)) and $_[0] !~ /^-\w/) {
456 ## Yup - need an implicit '-name' before first parameter
460 ## See if odd number of args
462 ## Yup - need an implicit '-ptree' before the last parameter
463 splice @_, $#_, 0, '-ptree';
466 ## Any remaining arguments are treated as initial values for the
467 ## hash that is used to represent this object. Note that we default
468 ## certain values by specifying them *before* the arguments passed.
469 ## If they are in the argument list, they will override the defaults.
471 -name => (@_ == 1) ? $_[0] : undef,
472 -file => '<unknown-file>',
479 ## Initialize contents if they havent been already
480 my $ptree = $self->{'-ptree'} || new Pod::ParseTree();
481 if ( ref $ptree =~ /^(ARRAY)?$/ ) {
482 ## We have an array-ref, or a normal scalar. Pass it as an
483 ## an argument to the ptree-constructor
484 $ptree = new Pod::ParseTree($1 ? [$ptree] : $ptree);
486 $self->{'-ptree'} = $ptree;
488 ## Bless ourselves into the desired class and perform any initialization
493 ##---------------------------------------------------------------------------
495 =head2 $pod_seq-E<gt>B<cmd_name()>
497 my $seq_cmd = $pod_seq->cmd_name();
499 The name of the interior sequence command.
504 (@_ > 1) and $_[0]->{'-name'} = $_[1];
505 return $_[0]->{'-name'};
508 ## let name() be an alias for cmd_name()
511 ##---------------------------------------------------------------------------
513 ## Private subroutine to set the parent pointer of all the given
514 ## children that are interior-sequences to be $self
516 sub _set_child2parent_links {
517 my ($self, @children) = @_;
518 ## Make sure any sequences know who their parent is
520 next unless (length and ref and ref ne 'SCALAR');
521 if (UNIVERSAL::isa($_, 'Pod::InteriorSequence') or
522 UNIVERSAL::can($_, 'nested'))
529 ## Private subroutine to unset child->parent links
531 sub _unset_child2parent_links {
533 $self->{'-parent_sequence'} = undef;
534 my $ptree = $self->{'-ptree'};
536 next unless (length and ref and ref ne 'SCALAR');
537 $_->_unset_child2parent_links()
538 if UNIVERSAL::isa($_, 'Pod::InteriorSequence');
542 ##---------------------------------------------------------------------------
544 =head2 $pod_seq-E<gt>B<prepend()>
546 $pod_seq->prepend($text);
547 $pod_seq1->prepend($pod_seq2);
549 Prepends the given string or parse-tree or sequence object to the parse-tree
550 of this interior sequence.
556 $self->{'-ptree'}->prepend(@_);
557 _set_child2parent_links($self, @_);
561 ##---------------------------------------------------------------------------
563 =head2 $pod_seq-E<gt>B<append()>
565 $pod_seq->append($text);
566 $pod_seq1->append($pod_seq2);
568 Appends the given string or parse-tree or sequence object to the parse-tree
569 of this interior sequence.
575 $self->{'-ptree'}->append(@_);
576 _set_child2parent_links($self, @_);
580 ##---------------------------------------------------------------------------
582 =head2 $pod_seq-E<gt>B<nested()>
584 $outer_seq = $pod_seq->nested || print "not nested";
586 If this interior sequence is nested inside of another interior
587 sequence, then the outer/parent sequence that contains it is
588 returned. Otherwise C<undef> is returned.
594 (@_ == 1) and $self->{'-parent_sequence'} = shift;
595 return $self->{'-parent_sequence'} || undef;
598 ##---------------------------------------------------------------------------
600 =head2 $pod_seq-E<gt>B<raw_text()>
602 my $seq_raw_text = $pod_seq->raw_text();
604 This method will return the I<raw> text of the POD interior sequence,
605 exactly as it appeared in the input.
611 my $text = $self->{'-name'} . $self->{'-ldelim'};
612 for ( $self->{'-ptree'}->children ) {
613 $text .= (ref $_) ? $_->raw_text : $_;
615 $text .= $self->{'-rdelim'};
619 ##---------------------------------------------------------------------------
621 =head2 $pod_seq-E<gt>B<left_delimiter()>
623 my $ldelim = $pod_seq->left_delimiter();
625 The leftmost delimiter beginning the argument text to the interior
626 sequence (should be "<").
631 (@_ > 1) and $_[0]->{'-ldelim'} = $_[1];
632 return $_[0]->{'-ldelim'};
635 ## let ldelim() be an alias for left_delimiter()
636 *ldelim = \&left_delimiter;
638 ##---------------------------------------------------------------------------
640 =head2 $pod_seq-E<gt>B<right_delimiter()>
642 The rightmost delimiter beginning the argument text to the interior
643 sequence (should be ">").
647 sub right_delimiter {
648 (@_ > 1) and $_[0]->{'-rdelim'} = $_[1];
649 return $_[0]->{'-rdelim'};
652 ## let rdelim() be an alias for right_delimiter()
653 *rdelim = \&right_delimiter;
655 ##---------------------------------------------------------------------------
657 =head2 $pod_seq-E<gt>B<parse_tree()>
659 my $ptree = $pod_parser->parse_text($paragraph_text);
660 $pod_seq->parse_tree( $ptree );
661 $ptree = $pod_seq->parse_tree();
663 This method will get/set the corresponding parse-tree of the interior
669 (@_ > 1) and $_[0]->{'-ptree'} = $_[1];
670 return $_[0]->{'-ptree'};
673 ## let ptree() be an alias for parse_tree()
674 *ptree = \&parse_tree;
676 ##---------------------------------------------------------------------------
678 =head2 $pod_seq-E<gt>B<file_line()>
680 my ($filename, $line_number) = $pod_seq->file_line();
681 my $position = $pod_seq->file_line();
683 Returns the current filename and line number for the interior sequence
684 object. If called in a list context, it returns a list of two
685 elements: first the filename, then the line number. If called in
686 a scalar context, it returns a string containing the filename, followed
687 by a colon (':'), followed by the line number.
692 my @loc = ($_[0]->{'-file'} || '<unknown-file>',
693 $_[0]->{'-line'} || 0);
694 return (wantarray) ? @loc : join(':', @loc);
697 ##---------------------------------------------------------------------------
699 =head2 Pod::InteriorSequence::B<DESTROY()>
701 This method performs any necessary cleanup for the interior-sequence.
702 If you override this method then it is B<imperative> that you invoke
703 the parent method from within your own method, otherwise
704 I<interior-sequence storage will not be reclaimed upon destruction!>
709 ## We need to get rid of all child->parent pointers throughout the
710 ## tree so their reference counts will go to zero and they can be
712 _unset_child2parent_links(@_);
715 ##---------------------------------------------------------------------------
717 #############################################################################
719 package Pod::ParseTree;
721 ##---------------------------------------------------------------------------
723 =head1 B<Pod::ParseTree>
725 This object corresponds to a tree of parsed POD text. As POD text is
726 scanned from left to right, it is parsed into an ordered list of
727 text-strings and B<Pod::InteriorSequence> objects (in order of
728 appearance). A B<Pod::ParseTree> object corresponds to this list of
729 strings and sequences. Each interior sequence in the parse-tree may
730 itself contain a parse-tree (since interior sequences may be nested).
734 ##---------------------------------------------------------------------------
736 =head2 Pod::ParseTree-E<gt>B<new()>
738 my $ptree1 = Pod::ParseTree->new;
739 my $ptree2 = new Pod::ParseTree;
740 my $ptree4 = Pod::ParseTree->new($array_ref);
741 my $ptree3 = new Pod::ParseTree($array_ref);
743 This is a class method that constructs a C<Pod::Parse_tree> object and
744 returns a reference to the new parse-tree. If a single-argument is given,
745 it must be a reference to an array, and is used to initialize the root
746 (top) of the parse tree.
751 ## Determine if we were called via an object-ref or a classname
753 my $class = ref($this) || $this;
755 my $self = (@_ == 1 and ref $_[0]) ? $_[0] : [];
757 ## Bless ourselves into the desired class and perform any initialization
762 ##---------------------------------------------------------------------------
764 =head2 $ptree-E<gt>B<top()>
766 my $top_node = $ptree->top();
767 $ptree->top( $top_node );
768 $ptree->top( @children );
770 This method gets/sets the top node of the parse-tree. If no arguments are
771 given, it returns the topmost node in the tree (the root), which is also
772 a B<Pod::ParseTree>. If it is given a single argument that is a reference,
773 then the reference is assumed to a parse-tree and becomes the new top node.
774 Otherwise, if arguments are given, they are treated as the new list of
775 children for the top node.
782 @{ $self } = (@_ == 1 and ref $_[0]) ? ${ @_ } : @_;
787 ## let parse_tree() & ptree() be aliases for the 'top' method
788 *parse_tree = *ptree = \⊤
790 ##---------------------------------------------------------------------------
792 =head2 $ptree-E<gt>B<children()>
794 This method gets/sets the children of the top node in the parse-tree.
795 If no arguments are given, it returns the list (array) of children
796 (each of which should be either a string or a B<Pod::InteriorSequence>.
797 Otherwise, if arguments are given, they are treated as the new list of
798 children for the top node.
805 @{ $self } = (@_ == 1 and ref $_[0]) ? ${ @_ } : @_;
810 ##---------------------------------------------------------------------------
812 =head2 $ptree-E<gt>B<prepend()>
814 This method prepends the given text or parse-tree to the current parse-tree.
815 If the first item on the parse-tree is text and the argument is also text,
816 then the text is prepended to the first item (not added as a separate string).
817 Otherwise the argument is added as a new string or parse-tree I<before>
822 use vars qw(@ptree); ## an alias used for performance reasons
826 local *ptree = $self;
829 if (@ptree && !(ref $ptree[0]) && !(ref $_)) {
830 $ptree[0] = $_ . $ptree[0];
838 ##---------------------------------------------------------------------------
840 =head2 $ptree-E<gt>B<append()>
842 This method appends the given text or parse-tree to the current parse-tree.
843 If the last item on the parse-tree is text and the argument is also text,
844 then the text is appended to the last item (not added as a separate string).
845 Otherwise the argument is added as a new string or parse-tree I<after>
852 local *ptree = $self;
853 my $can_append = @ptree && !(ref $ptree[-1]);
861 elsif ($can_append) {
870 =head2 $ptree-E<gt>B<raw_text()>
872 my $ptree_raw_text = $ptree->raw_text();
874 This method will return the I<raw> text of the POD parse-tree
875 exactly as it appeared in the input.
883 $text .= (ref $_) ? $_->raw_text : $_;
888 ##---------------------------------------------------------------------------
890 ## Private routines to set/unset child->parent links
892 sub _unset_child2parent_links {
894 local *ptree = $self;
896 next unless (defined and length and ref and ref ne 'SCALAR');
897 $_->_unset_child2parent_links()
898 if UNIVERSAL::isa($_, 'Pod::InteriorSequence');
902 sub _set_child2parent_links {
903 ## nothing to do, Pod::ParseTrees cant have parent pointers
906 =head2 Pod::ParseTree::B<DESTROY()>
908 This method performs any necessary cleanup for the parse-tree.
909 If you override this method then it is B<imperative>
910 that you invoke the parent method from within your own method,
911 otherwise I<parse-tree storage will not be reclaimed upon destruction!>
916 ## We need to get rid of all child->parent pointers throughout the
917 ## tree so their reference counts will go to zero and they can be
919 _unset_child2parent_links(@_);
922 #############################################################################
926 See L<Pod::Parser>, L<Pod::Select>
930 Please report bugs using L<http://rt.cpan.org>.
932 Brad Appleton E<lt>bradapp@enteract.comE<gt>