| 1 | ############################################################################# |
| 2 | # Pod/InputObjects.pm -- package which defines objects for input streams |
| 3 | # and paragraphs and commands when parsing POD docs. |
| 4 | # |
| 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 |
| 8 | # as Perl itself. |
| 9 | ############################################################################# |
| 10 | |
| 11 | package Pod::InputObjects; |
| 12 | |
| 13 | use vars qw($VERSION); |
| 14 | $VERSION = 1.30; ## Current version of this package |
| 15 | require 5.005; ## requires this Perl version or later |
| 16 | |
| 17 | ############################################################################# |
| 18 | |
| 19 | =head1 NAME |
| 20 | |
| 21 | Pod::InputObjects - objects representing POD input paragraphs, commands, etc. |
| 22 | |
| 23 | =head1 SYNOPSIS |
| 24 | |
| 25 | use Pod::InputObjects; |
| 26 | |
| 27 | =head1 REQUIRES |
| 28 | |
| 29 | perl5.004, Carp |
| 30 | |
| 31 | =head1 EXPORTS |
| 32 | |
| 33 | Nothing. |
| 34 | |
| 35 | =head1 DESCRIPTION |
| 36 | |
| 37 | This module defines some basic input objects used by B<Pod::Parser> when |
| 38 | reading and parsing POD text from an input source. The following objects |
| 39 | are defined: |
| 40 | |
| 41 | =over 4 |
| 42 | |
| 43 | =begin __PRIVATE__ |
| 44 | |
| 45 | =item package B<Pod::InputSource> |
| 46 | |
| 47 | An object corresponding to a source of POD input text. It is mostly a |
| 48 | wrapper around a filehandle or C<IO::Handle>-type object (or anything |
| 49 | that implements the C<getline()> method) which keeps track of some |
| 50 | additional information relevant to the parsing of PODs. |
| 51 | |
| 52 | =end __PRIVATE__ |
| 53 | |
| 54 | =item package B<Pod::Paragraph> |
| 55 | |
| 56 | An object corresponding to a paragraph of POD input text. It may be a |
| 57 | plain paragraph, a verbatim paragraph, or a command paragraph (see |
| 58 | L<perlpod>). |
| 59 | |
| 60 | =item package B<Pod::InteriorSequence> |
| 61 | |
| 62 | An object corresponding to an interior sequence command from the POD |
| 63 | input text (see L<perlpod>). |
| 64 | |
| 65 | =item package B<Pod::ParseTree> |
| 66 | |
| 67 | An object corresponding to a tree of parsed POD text. Each "node" in |
| 68 | a parse-tree (or I<ptree>) is either a text-string or a reference to |
| 69 | a B<Pod::InteriorSequence> object. The nodes appear in the parse-tree |
| 70 | in the order in which they were parsed from left-to-right. |
| 71 | |
| 72 | =back |
| 73 | |
| 74 | Each of these input objects are described in further detail in the |
| 75 | sections which follow. |
| 76 | |
| 77 | =cut |
| 78 | |
| 79 | ############################################################################# |
| 80 | |
| 81 | use strict; |
| 82 | #use diagnostics; |
| 83 | #use Carp; |
| 84 | |
| 85 | ############################################################################# |
| 86 | |
| 87 | package Pod::InputSource; |
| 88 | |
| 89 | ##--------------------------------------------------------------------------- |
| 90 | |
| 91 | =begin __PRIVATE__ |
| 92 | |
| 93 | =head1 B<Pod::InputSource> |
| 94 | |
| 95 | This object corresponds to an input source or stream of POD |
| 96 | documentation. When parsing PODs, it is necessary to associate and store |
| 97 | certain context information with each input source. All of this |
| 98 | information is kept together with the stream itself in one of these |
| 99 | C<Pod::InputSource> objects. Each such object is merely a wrapper around |
| 100 | an C<IO::Handle> object of some kind (or at least something that |
| 101 | implements the C<getline()> method). They have the following |
| 102 | methods/attributes: |
| 103 | |
| 104 | =end __PRIVATE__ |
| 105 | |
| 106 | =cut |
| 107 | |
| 108 | ##--------------------------------------------------------------------------- |
| 109 | |
| 110 | =begin __PRIVATE__ |
| 111 | |
| 112 | =head2 B<new()> |
| 113 | |
| 114 | my $pod_input1 = Pod::InputSource->new(-handle => $filehandle); |
| 115 | my $pod_input2 = new Pod::InputSource(-handle => $filehandle, |
| 116 | -name => $name); |
| 117 | my $pod_input3 = new Pod::InputSource(-handle => \*STDIN); |
| 118 | my $pod_input4 = Pod::InputSource->new(-handle => \*STDIN, |
| 119 | -name => "(STDIN)"); |
| 120 | |
| 121 | This is a class method that constructs a C<Pod::InputSource> object and |
| 122 | returns a reference to the new input source object. It takes one or more |
| 123 | keyword arguments in the form of a hash. The keyword C<-handle> is |
| 124 | required and designates the corresponding input handle. The keyword |
| 125 | C<-name> is optional and specifies the name associated with the input |
| 126 | handle (typically a file name). |
| 127 | |
| 128 | =end __PRIVATE__ |
| 129 | |
| 130 | =cut |
| 131 | |
| 132 | sub new { |
| 133 | ## Determine if we were called via an object-ref or a classname |
| 134 | my $this = shift; |
| 135 | my $class = ref($this) || $this; |
| 136 | |
| 137 | ## Any remaining arguments are treated as initial values for the |
| 138 | ## hash that is used to represent this object. Note that we default |
| 139 | ## certain values by specifying them *before* the arguments passed. |
| 140 | ## If they are in the argument list, they will override the defaults. |
| 141 | my $self = { -name => '(unknown)', |
| 142 | -handle => undef, |
| 143 | -was_cutting => 0, |
| 144 | @_ }; |
| 145 | |
| 146 | ## Bless ourselves into the desired class and perform any initialization |
| 147 | bless $self, $class; |
| 148 | return $self; |
| 149 | } |
| 150 | |
| 151 | ##--------------------------------------------------------------------------- |
| 152 | |
| 153 | =begin __PRIVATE__ |
| 154 | |
| 155 | =head2 B<name()> |
| 156 | |
| 157 | my $filename = $pod_input->name(); |
| 158 | $pod_input->name($new_filename_to_use); |
| 159 | |
| 160 | This method gets/sets the name of the input source (usually a filename). |
| 161 | If no argument is given, it returns a string containing the name of |
| 162 | the input source; otherwise it sets the name of the input source to the |
| 163 | contents of the given argument. |
| 164 | |
| 165 | =end __PRIVATE__ |
| 166 | |
| 167 | =cut |
| 168 | |
| 169 | sub name { |
| 170 | (@_ > 1) and $_[0]->{'-name'} = $_[1]; |
| 171 | return $_[0]->{'-name'}; |
| 172 | } |
| 173 | |
| 174 | ## allow 'filename' as an alias for 'name' |
| 175 | *filename = \&name; |
| 176 | |
| 177 | ##--------------------------------------------------------------------------- |
| 178 | |
| 179 | =begin __PRIVATE__ |
| 180 | |
| 181 | =head2 B<handle()> |
| 182 | |
| 183 | my $handle = $pod_input->handle(); |
| 184 | |
| 185 | Returns a reference to the handle object from which input is read (the |
| 186 | one used to contructed this input source object). |
| 187 | |
| 188 | =end __PRIVATE__ |
| 189 | |
| 190 | =cut |
| 191 | |
| 192 | sub handle { |
| 193 | return $_[0]->{'-handle'}; |
| 194 | } |
| 195 | |
| 196 | ##--------------------------------------------------------------------------- |
| 197 | |
| 198 | =begin __PRIVATE__ |
| 199 | |
| 200 | =head2 B<was_cutting()> |
| 201 | |
| 202 | print "Yes.\n" if ($pod_input->was_cutting()); |
| 203 | |
| 204 | The value of the C<cutting> state (that the B<cutting()> method would |
| 205 | have returned) immediately before any input was read from this input |
| 206 | stream. After all input from this stream has been read, the C<cutting> |
| 207 | state is restored to this value. |
| 208 | |
| 209 | =end __PRIVATE__ |
| 210 | |
| 211 | =cut |
| 212 | |
| 213 | sub was_cutting { |
| 214 | (@_ > 1) and $_[0]->{-was_cutting} = $_[1]; |
| 215 | return $_[0]->{-was_cutting}; |
| 216 | } |
| 217 | |
| 218 | ##--------------------------------------------------------------------------- |
| 219 | |
| 220 | ############################################################################# |
| 221 | |
| 222 | package Pod::Paragraph; |
| 223 | |
| 224 | ##--------------------------------------------------------------------------- |
| 225 | |
| 226 | =head1 B<Pod::Paragraph> |
| 227 | |
| 228 | An object representing a paragraph of POD input text. |
| 229 | It has the following methods/attributes: |
| 230 | |
| 231 | =cut |
| 232 | |
| 233 | ##--------------------------------------------------------------------------- |
| 234 | |
| 235 | =head2 Pod::Paragraph-E<gt>B<new()> |
| 236 | |
| 237 | my $pod_para1 = Pod::Paragraph->new(-text => $text); |
| 238 | my $pod_para2 = Pod::Paragraph->new(-name => $cmd, |
| 239 | -text => $text); |
| 240 | my $pod_para3 = new Pod::Paragraph(-text => $text); |
| 241 | my $pod_para4 = new Pod::Paragraph(-name => $cmd, |
| 242 | -text => $text); |
| 243 | my $pod_para5 = Pod::Paragraph->new(-name => $cmd, |
| 244 | -text => $text, |
| 245 | -file => $filename, |
| 246 | -line => $line_number); |
| 247 | |
| 248 | This is a class method that constructs a C<Pod::Paragraph> object and |
| 249 | returns a reference to the new paragraph object. It may be given one or |
| 250 | two keyword arguments. The C<-text> keyword indicates the corresponding |
| 251 | text of the POD paragraph. The C<-name> keyword indicates the name of |
| 252 | the corresponding POD command, such as C<head1> or C<item> (it should |
| 253 | I<not> contain the C<=> prefix); this is needed only if the POD |
| 254 | paragraph corresponds to a command paragraph. The C<-file> and C<-line> |
| 255 | keywords indicate the filename and line number corresponding to the |
| 256 | beginning of the paragraph |
| 257 | |
| 258 | =cut |
| 259 | |
| 260 | sub new { |
| 261 | ## Determine if we were called via an object-ref or a classname |
| 262 | my $this = shift; |
| 263 | my $class = ref($this) || $this; |
| 264 | |
| 265 | ## Any remaining arguments are treated as initial values for the |
| 266 | ## hash that is used to represent this object. Note that we default |
| 267 | ## certain values by specifying them *before* the arguments passed. |
| 268 | ## If they are in the argument list, they will override the defaults. |
| 269 | my $self = { |
| 270 | -name => undef, |
| 271 | -text => (@_ == 1) ? shift : undef, |
| 272 | -file => '<unknown-file>', |
| 273 | -line => 0, |
| 274 | -prefix => '=', |
| 275 | -separator => ' ', |
| 276 | -ptree => [], |
| 277 | @_ |
| 278 | }; |
| 279 | |
| 280 | ## Bless ourselves into the desired class and perform any initialization |
| 281 | bless $self, $class; |
| 282 | return $self; |
| 283 | } |
| 284 | |
| 285 | ##--------------------------------------------------------------------------- |
| 286 | |
| 287 | =head2 $pod_para-E<gt>B<cmd_name()> |
| 288 | |
| 289 | my $para_cmd = $pod_para->cmd_name(); |
| 290 | |
| 291 | If this paragraph is a command paragraph, then this method will return |
| 292 | the name of the command (I<without> any leading C<=> prefix). |
| 293 | |
| 294 | =cut |
| 295 | |
| 296 | sub cmd_name { |
| 297 | (@_ > 1) and $_[0]->{'-name'} = $_[1]; |
| 298 | return $_[0]->{'-name'}; |
| 299 | } |
| 300 | |
| 301 | ## let name() be an alias for cmd_name() |
| 302 | *name = \&cmd_name; |
| 303 | |
| 304 | ##--------------------------------------------------------------------------- |
| 305 | |
| 306 | =head2 $pod_para-E<gt>B<text()> |
| 307 | |
| 308 | my $para_text = $pod_para->text(); |
| 309 | |
| 310 | This method will return the corresponding text of the paragraph. |
| 311 | |
| 312 | =cut |
| 313 | |
| 314 | sub text { |
| 315 | (@_ > 1) and $_[0]->{'-text'} = $_[1]; |
| 316 | return $_[0]->{'-text'}; |
| 317 | } |
| 318 | |
| 319 | ##--------------------------------------------------------------------------- |
| 320 | |
| 321 | =head2 $pod_para-E<gt>B<raw_text()> |
| 322 | |
| 323 | my $raw_pod_para = $pod_para->raw_text(); |
| 324 | |
| 325 | This method will return the I<raw> text of the POD paragraph, exactly |
| 326 | as it appeared in the input. |
| 327 | |
| 328 | =cut |
| 329 | |
| 330 | sub raw_text { |
| 331 | return $_[0]->{'-text'} unless (defined $_[0]->{'-name'}); |
| 332 | return $_[0]->{'-prefix'} . $_[0]->{'-name'} . |
| 333 | $_[0]->{'-separator'} . $_[0]->{'-text'}; |
| 334 | } |
| 335 | |
| 336 | ##--------------------------------------------------------------------------- |
| 337 | |
| 338 | =head2 $pod_para-E<gt>B<cmd_prefix()> |
| 339 | |
| 340 | my $prefix = $pod_para->cmd_prefix(); |
| 341 | |
| 342 | If this paragraph is a command paragraph, then this method will return |
| 343 | the prefix used to denote the command (which should be the string "=" |
| 344 | or "=="). |
| 345 | |
| 346 | =cut |
| 347 | |
| 348 | sub cmd_prefix { |
| 349 | return $_[0]->{'-prefix'}; |
| 350 | } |
| 351 | |
| 352 | ##--------------------------------------------------------------------------- |
| 353 | |
| 354 | =head2 $pod_para-E<gt>B<cmd_separator()> |
| 355 | |
| 356 | my $separator = $pod_para->cmd_separator(); |
| 357 | |
| 358 | If this paragraph is a command paragraph, then this method will return |
| 359 | the text used to separate the command name from the rest of the |
| 360 | paragraph (if any). |
| 361 | |
| 362 | =cut |
| 363 | |
| 364 | sub cmd_separator { |
| 365 | return $_[0]->{'-separator'}; |
| 366 | } |
| 367 | |
| 368 | ##--------------------------------------------------------------------------- |
| 369 | |
| 370 | =head2 $pod_para-E<gt>B<parse_tree()> |
| 371 | |
| 372 | my $ptree = $pod_parser->parse_text( $pod_para->text() ); |
| 373 | $pod_para->parse_tree( $ptree ); |
| 374 | $ptree = $pod_para->parse_tree(); |
| 375 | |
| 376 | This method will get/set the corresponding parse-tree of the paragraph's text. |
| 377 | |
| 378 | =cut |
| 379 | |
| 380 | sub parse_tree { |
| 381 | (@_ > 1) and $_[0]->{'-ptree'} = $_[1]; |
| 382 | return $_[0]->{'-ptree'}; |
| 383 | } |
| 384 | |
| 385 | ## let ptree() be an alias for parse_tree() |
| 386 | *ptree = \&parse_tree; |
| 387 | |
| 388 | ##--------------------------------------------------------------------------- |
| 389 | |
| 390 | =head2 $pod_para-E<gt>B<file_line()> |
| 391 | |
| 392 | my ($filename, $line_number) = $pod_para->file_line(); |
| 393 | my $position = $pod_para->file_line(); |
| 394 | |
| 395 | Returns the current filename and line number for the paragraph |
| 396 | object. If called in a list context, it returns a list of two |
| 397 | elements: first the filename, then the line number. If called in |
| 398 | a scalar context, it returns a string containing the filename, followed |
| 399 | by a colon (':'), followed by the line number. |
| 400 | |
| 401 | =cut |
| 402 | |
| 403 | sub file_line { |
| 404 | my @loc = ($_[0]->{'-file'} || '<unknown-file>', |
| 405 | $_[0]->{'-line'} || 0); |
| 406 | return (wantarray) ? @loc : join(':', @loc); |
| 407 | } |
| 408 | |
| 409 | ##--------------------------------------------------------------------------- |
| 410 | |
| 411 | ############################################################################# |
| 412 | |
| 413 | package Pod::InteriorSequence; |
| 414 | |
| 415 | ##--------------------------------------------------------------------------- |
| 416 | |
| 417 | =head1 B<Pod::InteriorSequence> |
| 418 | |
| 419 | An object representing a POD interior sequence command. |
| 420 | It has the following methods/attributes: |
| 421 | |
| 422 | =cut |
| 423 | |
| 424 | ##--------------------------------------------------------------------------- |
| 425 | |
| 426 | =head2 Pod::InteriorSequence-E<gt>B<new()> |
| 427 | |
| 428 | my $pod_seq1 = Pod::InteriorSequence->new(-name => $cmd |
| 429 | -ldelim => $delimiter); |
| 430 | my $pod_seq2 = new Pod::InteriorSequence(-name => $cmd, |
| 431 | -ldelim => $delimiter); |
| 432 | my $pod_seq3 = new Pod::InteriorSequence(-name => $cmd, |
| 433 | -ldelim => $delimiter, |
| 434 | -file => $filename, |
| 435 | -line => $line_number); |
| 436 | |
| 437 | my $pod_seq4 = new Pod::InteriorSequence(-name => $cmd, $ptree); |
| 438 | my $pod_seq5 = new Pod::InteriorSequence($cmd, $ptree); |
| 439 | |
| 440 | This is a class method that constructs a C<Pod::InteriorSequence> object |
| 441 | and returns a reference to the new interior sequence object. It should |
| 442 | be given two keyword arguments. The C<-ldelim> keyword indicates the |
| 443 | corresponding left-delimiter of the interior sequence (e.g. 'E<lt>'). |
| 444 | The C<-name> keyword indicates the name of the corresponding interior |
| 445 | sequence command, such as C<I> or C<B> or C<C>. The C<-file> and |
| 446 | C<-line> keywords indicate the filename and line number corresponding |
| 447 | to the beginning of the interior sequence. If the C<$ptree> argument is |
| 448 | given, it must be the last argument, and it must be either string, or |
| 449 | else an array-ref suitable for passing to B<Pod::ParseTree::new> (or |
| 450 | it may be a reference to a Pod::ParseTree object). |
| 451 | |
| 452 | =cut |
| 453 | |
| 454 | sub new { |
| 455 | ## Determine if we were called via an object-ref or a classname |
| 456 | my $this = shift; |
| 457 | my $class = ref($this) || $this; |
| 458 | |
| 459 | ## See if first argument has no keyword |
| 460 | if (((@_ <= 2) or (@_ % 2)) and $_[0] !~ /^-\w/) { |
| 461 | ## Yup - need an implicit '-name' before first parameter |
| 462 | unshift @_, '-name'; |
| 463 | } |
| 464 | |
| 465 | ## See if odd number of args |
| 466 | if ((@_ % 2) != 0) { |
| 467 | ## Yup - need an implicit '-ptree' before the last parameter |
| 468 | splice @_, $#_, 0, '-ptree'; |
| 469 | } |
| 470 | |
| 471 | ## Any remaining arguments are treated as initial values for the |
| 472 | ## hash that is used to represent this object. Note that we default |
| 473 | ## certain values by specifying them *before* the arguments passed. |
| 474 | ## If they are in the argument list, they will override the defaults. |
| 475 | my $self = { |
| 476 | -name => (@_ == 1) ? $_[0] : undef, |
| 477 | -file => '<unknown-file>', |
| 478 | -line => 0, |
| 479 | -ldelim => '<', |
| 480 | -rdelim => '>', |
| 481 | @_ |
| 482 | }; |
| 483 | |
| 484 | ## Initialize contents if they havent been already |
| 485 | my $ptree = $self->{'-ptree'} || new Pod::ParseTree(); |
| 486 | if ( ref $ptree =~ /^(ARRAY)?$/ ) { |
| 487 | ## We have an array-ref, or a normal scalar. Pass it as an |
| 488 | ## an argument to the ptree-constructor |
| 489 | $ptree = new Pod::ParseTree($1 ? [$ptree] : $ptree); |
| 490 | } |
| 491 | $self->{'-ptree'} = $ptree; |
| 492 | |
| 493 | ## Bless ourselves into the desired class and perform any initialization |
| 494 | bless $self, $class; |
| 495 | return $self; |
| 496 | } |
| 497 | |
| 498 | ##--------------------------------------------------------------------------- |
| 499 | |
| 500 | =head2 $pod_seq-E<gt>B<cmd_name()> |
| 501 | |
| 502 | my $seq_cmd = $pod_seq->cmd_name(); |
| 503 | |
| 504 | The name of the interior sequence command. |
| 505 | |
| 506 | =cut |
| 507 | |
| 508 | sub cmd_name { |
| 509 | (@_ > 1) and $_[0]->{'-name'} = $_[1]; |
| 510 | return $_[0]->{'-name'}; |
| 511 | } |
| 512 | |
| 513 | ## let name() be an alias for cmd_name() |
| 514 | *name = \&cmd_name; |
| 515 | |
| 516 | ##--------------------------------------------------------------------------- |
| 517 | |
| 518 | ## Private subroutine to set the parent pointer of all the given |
| 519 | ## children that are interior-sequences to be $self |
| 520 | |
| 521 | sub _set_child2parent_links { |
| 522 | my ($self, @children) = @_; |
| 523 | ## Make sure any sequences know who their parent is |
| 524 | for (@children) { |
| 525 | next unless (length and ref and ref ne 'SCALAR'); |
| 526 | if (UNIVERSAL::isa($_, 'Pod::InteriorSequence') or |
| 527 | UNIVERSAL::can($_, 'nested')) |
| 528 | { |
| 529 | $_->nested($self); |
| 530 | } |
| 531 | } |
| 532 | } |
| 533 | |
| 534 | ## Private subroutine to unset child->parent links |
| 535 | |
| 536 | sub _unset_child2parent_links { |
| 537 | my $self = shift; |
| 538 | $self->{'-parent_sequence'} = undef; |
| 539 | my $ptree = $self->{'-ptree'}; |
| 540 | for (@$ptree) { |
| 541 | next unless (length and ref and ref ne 'SCALAR'); |
| 542 | $_->_unset_child2parent_links() |
| 543 | if UNIVERSAL::isa($_, 'Pod::InteriorSequence'); |
| 544 | } |
| 545 | } |
| 546 | |
| 547 | ##--------------------------------------------------------------------------- |
| 548 | |
| 549 | =head2 $pod_seq-E<gt>B<prepend()> |
| 550 | |
| 551 | $pod_seq->prepend($text); |
| 552 | $pod_seq1->prepend($pod_seq2); |
| 553 | |
| 554 | Prepends the given string or parse-tree or sequence object to the parse-tree |
| 555 | of this interior sequence. |
| 556 | |
| 557 | =cut |
| 558 | |
| 559 | sub prepend { |
| 560 | my $self = shift; |
| 561 | $self->{'-ptree'}->prepend(@_); |
| 562 | _set_child2parent_links($self, @_); |
| 563 | return $self; |
| 564 | } |
| 565 | |
| 566 | ##--------------------------------------------------------------------------- |
| 567 | |
| 568 | =head2 $pod_seq-E<gt>B<append()> |
| 569 | |
| 570 | $pod_seq->append($text); |
| 571 | $pod_seq1->append($pod_seq2); |
| 572 | |
| 573 | Appends the given string or parse-tree or sequence object to the parse-tree |
| 574 | of this interior sequence. |
| 575 | |
| 576 | =cut |
| 577 | |
| 578 | sub append { |
| 579 | my $self = shift; |
| 580 | $self->{'-ptree'}->append(@_); |
| 581 | _set_child2parent_links($self, @_); |
| 582 | return $self; |
| 583 | } |
| 584 | |
| 585 | ##--------------------------------------------------------------------------- |
| 586 | |
| 587 | =head2 $pod_seq-E<gt>B<nested()> |
| 588 | |
| 589 | $outer_seq = $pod_seq->nested || print "not nested"; |
| 590 | |
| 591 | If this interior sequence is nested inside of another interior |
| 592 | sequence, then the outer/parent sequence that contains it is |
| 593 | returned. Otherwise C<undef> is returned. |
| 594 | |
| 595 | =cut |
| 596 | |
| 597 | sub nested { |
| 598 | my $self = shift; |
| 599 | (@_ == 1) and $self->{'-parent_sequence'} = shift; |
| 600 | return $self->{'-parent_sequence'} || undef; |
| 601 | } |
| 602 | |
| 603 | ##--------------------------------------------------------------------------- |
| 604 | |
| 605 | =head2 $pod_seq-E<gt>B<raw_text()> |
| 606 | |
| 607 | my $seq_raw_text = $pod_seq->raw_text(); |
| 608 | |
| 609 | This method will return the I<raw> text of the POD interior sequence, |
| 610 | exactly as it appeared in the input. |
| 611 | |
| 612 | =cut |
| 613 | |
| 614 | sub raw_text { |
| 615 | my $self = shift; |
| 616 | my $text = $self->{'-name'} . $self->{'-ldelim'}; |
| 617 | for ( $self->{'-ptree'}->children ) { |
| 618 | $text .= (ref $_) ? $_->raw_text : $_; |
| 619 | } |
| 620 | $text .= $self->{'-rdelim'}; |
| 621 | return $text; |
| 622 | } |
| 623 | |
| 624 | ##--------------------------------------------------------------------------- |
| 625 | |
| 626 | =head2 $pod_seq-E<gt>B<left_delimiter()> |
| 627 | |
| 628 | my $ldelim = $pod_seq->left_delimiter(); |
| 629 | |
| 630 | The leftmost delimiter beginning the argument text to the interior |
| 631 | sequence (should be "<"). |
| 632 | |
| 633 | =cut |
| 634 | |
| 635 | sub left_delimiter { |
| 636 | (@_ > 1) and $_[0]->{'-ldelim'} = $_[1]; |
| 637 | return $_[0]->{'-ldelim'}; |
| 638 | } |
| 639 | |
| 640 | ## let ldelim() be an alias for left_delimiter() |
| 641 | *ldelim = \&left_delimiter; |
| 642 | |
| 643 | ##--------------------------------------------------------------------------- |
| 644 | |
| 645 | =head2 $pod_seq-E<gt>B<right_delimiter()> |
| 646 | |
| 647 | The rightmost delimiter beginning the argument text to the interior |
| 648 | sequence (should be ">"). |
| 649 | |
| 650 | =cut |
| 651 | |
| 652 | sub right_delimiter { |
| 653 | (@_ > 1) and $_[0]->{'-rdelim'} = $_[1]; |
| 654 | return $_[0]->{'-rdelim'}; |
| 655 | } |
| 656 | |
| 657 | ## let rdelim() be an alias for right_delimiter() |
| 658 | *rdelim = \&right_delimiter; |
| 659 | |
| 660 | ##--------------------------------------------------------------------------- |
| 661 | |
| 662 | =head2 $pod_seq-E<gt>B<parse_tree()> |
| 663 | |
| 664 | my $ptree = $pod_parser->parse_text($paragraph_text); |
| 665 | $pod_seq->parse_tree( $ptree ); |
| 666 | $ptree = $pod_seq->parse_tree(); |
| 667 | |
| 668 | This method will get/set the corresponding parse-tree of the interior |
| 669 | sequence's text. |
| 670 | |
| 671 | =cut |
| 672 | |
| 673 | sub parse_tree { |
| 674 | (@_ > 1) and $_[0]->{'-ptree'} = $_[1]; |
| 675 | return $_[0]->{'-ptree'}; |
| 676 | } |
| 677 | |
| 678 | ## let ptree() be an alias for parse_tree() |
| 679 | *ptree = \&parse_tree; |
| 680 | |
| 681 | ##--------------------------------------------------------------------------- |
| 682 | |
| 683 | =head2 $pod_seq-E<gt>B<file_line()> |
| 684 | |
| 685 | my ($filename, $line_number) = $pod_seq->file_line(); |
| 686 | my $position = $pod_seq->file_line(); |
| 687 | |
| 688 | Returns the current filename and line number for the interior sequence |
| 689 | object. If called in a list context, it returns a list of two |
| 690 | elements: first the filename, then the line number. If called in |
| 691 | a scalar context, it returns a string containing the filename, followed |
| 692 | by a colon (':'), followed by the line number. |
| 693 | |
| 694 | =cut |
| 695 | |
| 696 | sub file_line { |
| 697 | my @loc = ($_[0]->{'-file'} || '<unknown-file>', |
| 698 | $_[0]->{'-line'} || 0); |
| 699 | return (wantarray) ? @loc : join(':', @loc); |
| 700 | } |
| 701 | |
| 702 | ##--------------------------------------------------------------------------- |
| 703 | |
| 704 | =head2 Pod::InteriorSequence::B<DESTROY()> |
| 705 | |
| 706 | This method performs any necessary cleanup for the interior-sequence. |
| 707 | If you override this method then it is B<imperative> that you invoke |
| 708 | the parent method from within your own method, otherwise |
| 709 | I<interior-sequence storage will not be reclaimed upon destruction!> |
| 710 | |
| 711 | =cut |
| 712 | |
| 713 | sub DESTROY { |
| 714 | ## We need to get rid of all child->parent pointers throughout the |
| 715 | ## tree so their reference counts will go to zero and they can be |
| 716 | ## garbage-collected |
| 717 | _unset_child2parent_links(@_); |
| 718 | } |
| 719 | |
| 720 | ##--------------------------------------------------------------------------- |
| 721 | |
| 722 | ############################################################################# |
| 723 | |
| 724 | package Pod::ParseTree; |
| 725 | |
| 726 | ##--------------------------------------------------------------------------- |
| 727 | |
| 728 | =head1 B<Pod::ParseTree> |
| 729 | |
| 730 | This object corresponds to a tree of parsed POD text. As POD text is |
| 731 | scanned from left to right, it is parsed into an ordered list of |
| 732 | text-strings and B<Pod::InteriorSequence> objects (in order of |
| 733 | appearance). A B<Pod::ParseTree> object corresponds to this list of |
| 734 | strings and sequences. Each interior sequence in the parse-tree may |
| 735 | itself contain a parse-tree (since interior sequences may be nested). |
| 736 | |
| 737 | =cut |
| 738 | |
| 739 | ##--------------------------------------------------------------------------- |
| 740 | |
| 741 | =head2 Pod::ParseTree-E<gt>B<new()> |
| 742 | |
| 743 | my $ptree1 = Pod::ParseTree->new; |
| 744 | my $ptree2 = new Pod::ParseTree; |
| 745 | my $ptree4 = Pod::ParseTree->new($array_ref); |
| 746 | my $ptree3 = new Pod::ParseTree($array_ref); |
| 747 | |
| 748 | This is a class method that constructs a C<Pod::Parse_tree> object and |
| 749 | returns a reference to the new parse-tree. If a single-argument is given, |
| 750 | it must be a reference to an array, and is used to initialize the root |
| 751 | (top) of the parse tree. |
| 752 | |
| 753 | =cut |
| 754 | |
| 755 | sub new { |
| 756 | ## Determine if we were called via an object-ref or a classname |
| 757 | my $this = shift; |
| 758 | my $class = ref($this) || $this; |
| 759 | |
| 760 | my $self = (@_ == 1 and ref $_[0]) ? $_[0] : []; |
| 761 | |
| 762 | ## Bless ourselves into the desired class and perform any initialization |
| 763 | bless $self, $class; |
| 764 | return $self; |
| 765 | } |
| 766 | |
| 767 | ##--------------------------------------------------------------------------- |
| 768 | |
| 769 | =head2 $ptree-E<gt>B<top()> |
| 770 | |
| 771 | my $top_node = $ptree->top(); |
| 772 | $ptree->top( $top_node ); |
| 773 | $ptree->top( @children ); |
| 774 | |
| 775 | This method gets/sets the top node of the parse-tree. If no arguments are |
| 776 | given, it returns the topmost node in the tree (the root), which is also |
| 777 | a B<Pod::ParseTree>. If it is given a single argument that is a reference, |
| 778 | then the reference is assumed to a parse-tree and becomes the new top node. |
| 779 | Otherwise, if arguments are given, they are treated as the new list of |
| 780 | children for the top node. |
| 781 | |
| 782 | =cut |
| 783 | |
| 784 | sub top { |
| 785 | my $self = shift; |
| 786 | if (@_ > 0) { |
| 787 | @{ $self } = (@_ == 1 and ref $_[0]) ? ${ @_ } : @_; |
| 788 | } |
| 789 | return $self; |
| 790 | } |
| 791 | |
| 792 | ## let parse_tree() & ptree() be aliases for the 'top' method |
| 793 | *parse_tree = *ptree = \⊤ |
| 794 | |
| 795 | ##--------------------------------------------------------------------------- |
| 796 | |
| 797 | =head2 $ptree-E<gt>B<children()> |
| 798 | |
| 799 | This method gets/sets the children of the top node in the parse-tree. |
| 800 | If no arguments are given, it returns the list (array) of children |
| 801 | (each of which should be either a string or a B<Pod::InteriorSequence>. |
| 802 | Otherwise, if arguments are given, they are treated as the new list of |
| 803 | children for the top node. |
| 804 | |
| 805 | =cut |
| 806 | |
| 807 | sub children { |
| 808 | my $self = shift; |
| 809 | if (@_ > 0) { |
| 810 | @{ $self } = (@_ == 1 and ref $_[0]) ? ${ @_ } : @_; |
| 811 | } |
| 812 | return @{ $self }; |
| 813 | } |
| 814 | |
| 815 | ##--------------------------------------------------------------------------- |
| 816 | |
| 817 | =head2 $ptree-E<gt>B<prepend()> |
| 818 | |
| 819 | This method prepends the given text or parse-tree to the current parse-tree. |
| 820 | If the first item on the parse-tree is text and the argument is also text, |
| 821 | then the text is prepended to the first item (not added as a separate string). |
| 822 | Otherwise the argument is added as a new string or parse-tree I<before> |
| 823 | the current one. |
| 824 | |
| 825 | =cut |
| 826 | |
| 827 | use vars qw(@ptree); ## an alias used for performance reasons |
| 828 | |
| 829 | sub prepend { |
| 830 | my $self = shift; |
| 831 | local *ptree = $self; |
| 832 | for (@_) { |
| 833 | next unless length; |
| 834 | if (@ptree and !(ref $ptree[0]) and !(ref $_)) { |
| 835 | $ptree[0] = $_ . $ptree[0]; |
| 836 | } |
| 837 | else { |
| 838 | unshift @ptree, $_; |
| 839 | } |
| 840 | } |
| 841 | } |
| 842 | |
| 843 | ##--------------------------------------------------------------------------- |
| 844 | |
| 845 | =head2 $ptree-E<gt>B<append()> |
| 846 | |
| 847 | This method appends the given text or parse-tree to the current parse-tree. |
| 848 | If the last item on the parse-tree is text and the argument is also text, |
| 849 | then the text is appended to the last item (not added as a separate string). |
| 850 | Otherwise the argument is added as a new string or parse-tree I<after> |
| 851 | the current one. |
| 852 | |
| 853 | =cut |
| 854 | |
| 855 | sub append { |
| 856 | my $self = shift; |
| 857 | local *ptree = $self; |
| 858 | my $can_append = @ptree && !(ref $ptree[-1]); |
| 859 | for (@_) { |
| 860 | if (ref) { |
| 861 | push @ptree, $_; |
| 862 | } |
| 863 | elsif(!length) { |
| 864 | next; |
| 865 | } |
| 866 | elsif ($can_append) { |
| 867 | $ptree[-1] .= $_; |
| 868 | } |
| 869 | else { |
| 870 | push @ptree, $_; |
| 871 | } |
| 872 | } |
| 873 | } |
| 874 | |
| 875 | =head2 $ptree-E<gt>B<raw_text()> |
| 876 | |
| 877 | my $ptree_raw_text = $ptree->raw_text(); |
| 878 | |
| 879 | This method will return the I<raw> text of the POD parse-tree |
| 880 | exactly as it appeared in the input. |
| 881 | |
| 882 | =cut |
| 883 | |
| 884 | sub raw_text { |
| 885 | my $self = shift; |
| 886 | my $text = ""; |
| 887 | for ( @$self ) { |
| 888 | $text .= (ref $_) ? $_->raw_text : $_; |
| 889 | } |
| 890 | return $text; |
| 891 | } |
| 892 | |
| 893 | ##--------------------------------------------------------------------------- |
| 894 | |
| 895 | ## Private routines to set/unset child->parent links |
| 896 | |
| 897 | sub _unset_child2parent_links { |
| 898 | my $self = shift; |
| 899 | local *ptree = $self; |
| 900 | for (@ptree) { |
| 901 | next unless (defined and length and ref and ref ne 'SCALAR'); |
| 902 | $_->_unset_child2parent_links() |
| 903 | if UNIVERSAL::isa($_, 'Pod::InteriorSequence'); |
| 904 | } |
| 905 | } |
| 906 | |
| 907 | sub _set_child2parent_links { |
| 908 | ## nothing to do, Pod::ParseTrees cant have parent pointers |
| 909 | } |
| 910 | |
| 911 | =head2 Pod::ParseTree::B<DESTROY()> |
| 912 | |
| 913 | This method performs any necessary cleanup for the parse-tree. |
| 914 | If you override this method then it is B<imperative> |
| 915 | that you invoke the parent method from within your own method, |
| 916 | otherwise I<parse-tree storage will not be reclaimed upon destruction!> |
| 917 | |
| 918 | =cut |
| 919 | |
| 920 | sub DESTROY { |
| 921 | ## We need to get rid of all child->parent pointers throughout the |
| 922 | ## tree so their reference counts will go to zero and they can be |
| 923 | ## garbage-collected |
| 924 | _unset_child2parent_links(@_); |
| 925 | } |
| 926 | |
| 927 | ############################################################################# |
| 928 | |
| 929 | =head1 SEE ALSO |
| 930 | |
| 931 | See L<Pod::Parser>, L<Pod::Select> |
| 932 | |
| 933 | =head1 AUTHOR |
| 934 | |
| 935 | Please report bugs using L<http://rt.cpan.org>. |
| 936 | |
| 937 | Brad Appleton E<lt>bradapp@enteract.comE<gt> |
| 938 | |
| 939 | =cut |
| 940 | |
| 941 | 1; |