| 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; |