local-lib5/lib/perl5/PPI/Node.pm

   1 package PPI::Node;
   2
   3 =pod
   4
   5 =head1 NAME
   6
   7 PPI::Node - Abstract PPI Node class, an Element that can contain other Elements
   8
   9 =head1 INHERITANCE
  10
  11   PPI::Node
  12   isa PPI::Element
  13
  14 =head1 SYNOPSIS
  15
  16   # Create a typical node (a Document in this case)
  17   my $Node = PPI::Document->new;
  18
  19   # Add an element to the node( in this case, a token )
  20   my $Token = PPI::Token::Word->new('my');
  21   $Node->add_element( $Token );
  22
  23   # Get the elements for the Node
  24   my @elements = $Node->children;
  25
  26   # Find all the barewords within a Node
  27   my $barewords = $Node->find( 'PPI::Token::Word' );
  28
  29   # Find by more complex criteria
  30   my $my_tokens = $Node->find( sub { $_[1]->content eq 'my' } );
  31
  32   # Remove all the whitespace
  33   $Node->prune( 'PPI::Token::Whitespace' );
  34
  35   # Remove by more complex criteria
  36   $Node->prune( sub { $_[1]->content eq 'my' } );
  37
  38 =head1 DESCRIPTION
  39
  40 The C<PPI::Node> class provides an abstract base class for the Element
  41 classes that are able to contain other elements L<PPI::Document>,
  42 L<PPI::Statement>, and L<PPI::Structure>.
  43
  44 As well as those listed below, all of the methods that apply to
  45 L<PPI::Element> objects also apply to C<PPI::Node> objects.
  46
  47 =head1 METHODS
  48
  49 =cut
  50
  51 use strict;
  52 use Carp            ();
  53 use Scalar::Util    qw{refaddr};
  54 use List::MoreUtils ();
  55 use Params::Util    qw{_INSTANCE _CLASS _CODELIKE};
  56 use PPI::Element    ();
  57
  58 use vars qw{$VERSION @ISA *_PARENT};
  59 BEGIN {
  60         $VERSION = '1.206';
  61         @ISA     = 'PPI::Element';
  62         *_PARENT = *PPI::Element::_PARENT;
  63 }
  64
  65
  66
  67
  68
  69 #####################################################################
  70 # The basic constructor
  71
  72 sub new {
  73         my $class = ref $_[0] || $_[0];
  74         bless { children => [] }, $class;
  75 }
  76
  77
  78
  79
  80
  81 #####################################################################
  82 # PDOM Methods
  83
  84 =pod
  85
  86 =head2 scope
  87
  88 The C<scope> method returns true if the node represents a lexical scope
  89 boundary, or false if it does not.
  90
  91 =cut
  92
  93 ### XS -> PPI/XS.xs:_PPI_Node__scope 0.903+
  94 sub scope { '' }
  95
  96 =pod
  97
  98 =head2 add_element $Element
  99
 100 The C<add_element> method adds a L<PPI::Element> object to the end of a
 101 C<PPI::Node>. Because Elements maintain links to their parent, an
 102 Element can only be added to a single Node.
 103
 104 Returns true if the L<PPI::Element> was added. Returns C<undef> if the
 105 Element was already within another Node, or the method is not passed
 106 a L<PPI::Element> object.
 107
 108 =cut
 109
 110 sub add_element {
 111         my $self = shift;
 112
 113         # Check the element
 114         my $Element = _INSTANCE(shift, 'PPI::Element') or return undef;
 115         $_PARENT{refaddr $Element} and return undef;
 116
 117         # Add the argument to the elements
 118         push @{$self->{children}}, $Element;
 119         Scalar::Util::weaken(
 120                 $_PARENT{refaddr $Element} = $self
 121         );
 122
 123         1;
 124 }
 125
 126 # In a typical run profile, add_element is the number 1 resource drain.
 127 # This is a highly optimised unsafe version, for internal use only.
 128 sub __add_element {
 129         Scalar::Util::weaken(
 130                 $_PARENT{refaddr $_[1]} = $_[0]
 131         );
 132         push @{$_[0]->{children}}, $_[1];
 133 }
 134
 135 =pod
 136
 137 =head2 elements
 138
 139 The C<elements> method accesses all child elements B<structurally> within
 140 the C<PPI::Node> object. Note that in the base of the L<PPI::Structure>
 141 classes, this C<DOES> include the brace tokens at either end of the
 142 structure.
 143
 144 Returns a list of zero or more L<PPI::Element> objects.
 145
 146 Alternatively, if called in the scalar context, the C<elements> method
 147 returns a count of the number of elements.
 148
 149 =cut
 150
 151 sub elements {
 152         if ( wantarray ) {
 153                 return @{$_[0]->{children}};
 154         } else {
 155                 return scalar @{$_[0]->{children}};
 156         }
 157 }
 158
 159 =pod
 160
 161 =head2 first_element
 162
 163 The C<first_element> method accesses the first element structurally within
 164 the C<PPI::Node> object. As for the C<elements> method, this does include
 165 the brace tokens for L<PPI::Structure> objects.
 166
 167 Returns a L<PPI::Element> object, or C<undef> if for some reason the
 168 C<PPI::Node> object does not contain any elements.
 169
 170 =cut
 171
 172 # Normally the first element is also the first child
 173 sub first_element {
 174         $_[0]->{children}->[0];
 175 }
 176
 177 =pod
 178
 179 =head2 last_element
 180
 181 The C<last_element> method accesses the last element structurally within
 182 the C<PPI::Node> object. As for the C<elements> method, this does include
 183 the brace tokens for L<PPI::Structure> objects.
 184
 185 Returns a L<PPI::Element> object, or C<undef> if for some reason the
 186 C<PPI::Node> object does not contain any elements.
 187
 188 =cut
 189
 190 # Normally the last element is also the last child
 191 sub last_element {
 192         $_[0]->{children}->[-1];
 193 }
 194
 195 =pod
 196
 197 =head2 children
 198
 199 The C<children> method accesses all child elements lexically within the
 200 C<PPI::Node> object. Note that in the case of the L<PPI::Structure>
 201 classes, this does B<NOT> include the brace tokens at either end of the
 202 structure.
 203
 204 Returns a list of zero of more L<PPI::Element> objects.
 205
 206 Alternatively, if called in the scalar context, the C<children> method
 207 returns a count of the number of lexical children.
 208
 209 =cut
 210
 211 # In the default case, this is the same as for the elements method
 212 sub children {
 213         wantarray ? @{$_[0]->{children}} : scalar @{$_[0]->{children}};
 214 }
 215
 216 =pod
 217
 218 =head2 schildren
 219
 220 The C<schildren> method is really just a convenience, the significant-only
 221 variation of the normal C<children> method.
 222
 223 In list context, returns a list of significant children. In scalar context,
 224 returns the number of significant children.
 225
 226 =cut
 227
 228 sub schildren {
 229         return grep { $_->significant } @{$_[0]->{children}} if wantarray;
 230         my $count = 0;
 231         foreach ( @{$_[0]->{children}} ) {
 232                 $count++ if $_->significant;
 233         }
 234         return $count;
 235 }
 236
 237 =pod
 238
 239 =head2 child $index
 240
 241 The C<child> method accesses a child L<PPI::Element> object by its
 242 position within the Node.
 243
 244 Returns a L<PPI::Element> object, or C<undef> if there is no child
 245 element at that node.
 246
 247 =cut
 248
 249 sub child {
 250         $_[0]->{children}->[$_[1]];
 251 }
 252
 253 =pod
 254
 255 =head2 schild $index
 256
 257 The lexical structure of the Perl language ignores 'insignificant' items,
 258 such as whitespace and comments, while L<PPI> treats these items as valid
 259 tokens so that it can reassemble the file at any time. Because of this,
 260 in many situations there is a need to find an Element within a Node by
 261 index, only counting lexically significant Elements.
 262
 263 The C<schild> method returns a child Element by index, ignoring
 264 insignificant Elements. The index of a child Element is specified in the
 265 same way as for a normal array, with the first Element at index 0, and
 266 negative indexes used to identify a "from the end" position.
 267
 268 =cut
 269
 270 sub schild {
 271         my $self = shift;
 272         my $idx  = 0 + shift;
 273         my $el   = $self->{children};
 274         if ( $idx < 0 ) {
 275                 my $cursor = 0;
 276                 while ( exists $el->[--$cursor] ) {
 277                         return $el->[$cursor] if $el->[$cursor]->significant and ++$idx >= 0;
 278                 }
 279         } else {
 280                 my $cursor = -1;
 281                 while ( exists $el->[++$cursor] ) {
 282                         return $el->[$cursor] if $el->[$cursor]->significant and --$idx < 0;
 283                 }
 284         }
 285         undef;
 286 }
 287
 288 =pod
 289
 290 =head2 contains $Element
 291
 292 The C<contains> method is used to determine if another L<PPI::Element>
 293 object is logically "within" a C<PPI::Node>. For the special case of the
 294 brace tokens at either side of a L<PPI::Structure> object, they are
 295 generally considered "within" a L<PPI::Structure> object, even if they are
 296 not actually in the elements for the L<PPI::Structure>.
 297
 298 Returns true if the L<PPI::Element> is within us, false if not, or C<undef>
 299 on error.
 300
 301 =cut
 302
 303 sub contains {
 304         my $self    = shift;
 305         my $Element = _INSTANCE(shift, 'PPI::Element') or return undef;
 306
 307         # Iterate up the Element's parent chain until we either run out
 308         # of parents, or get to ourself.
 309         while ( $Element = $Element->parent ) {
 310                 return 1 if refaddr($self) == refaddr($Element);
 311         }
 312
 313         '';
 314 }
 315
 316 =pod
 317
 318 =head2 find $class | \&wanted
 319
 320 The C<find> method is used to search within a code tree for
 321 L<PPI::Element> objects that meet a particular condition.
 322
 323 To specify the condition, the method can be provided with either a simple
 324 class name (full or shortened), or a C<CODE>/function reference.
 325
 326   # Find all single quotes in a Document (which is a Node)
 327   $Document->find('PPI::Quote::Single');
 328
 329   # The same thing with a shortened class name
 330   $Document->find('Quote::Single');
 331
 332   # Anything more elaborate, we so with the sub
 333   $Document->find( sub {
 334         # At the top level of the file...
 335         $_[1]->parent == $_[0]
 336         and (
 337                 # ...find all comments and POD
 338                 $_[1]->isa('PPI::Token::Pod')
 339                 or
 340                 $_[1]->isa('PPI::Token::Comment')
 341         )
 342   } );
 343
 344 The function will be passed two arguments, the top-level C<PPI::Node>
 345 you are searching in and the current L<PPI::Element> that the condition
 346 is testing.
 347
 348 The anonymous function should return one of three values. Returning true
 349 indicates a condition match, defined-false (C<0> or C<''>) indicates
 350 no-match, and C<undef> indicates no-match and no-descend.
 351
 352 In the last case, the tree walker will skip over anything below the
 353 C<undef>-returning element and move on to the next element at the same
 354 level.
 355
 356 To halt the entire search and return C<undef> immediately, a condition
 357 function should throw an exception (i.e. C<die>).
 358
 359 Note that this same wanted logic is used for all methods documented to
 360 have a C<\&wanted> parameter, as this one does.
 361
 362 The C<find> method returns a reference to an array of L<PPI::Element>
 363 objects that match the condition, false (but defined) if no Elements match
 364 the condition, or C<undef> if you provide a bad condition, or an error
 365 occurs during the search process.
 366
 367 In the case of a bad condition, a warning will be emitted as well.
 368
 369 =cut
 370
 371 sub find {
 372         my $self   = shift;
 373         my $wanted = $self->_wanted(shift) or return undef;
 374
 375         # Use a queue based search, rather than a recursive one
 376         my @found = ();
 377         my @queue = $self->children;
 378         eval {
 379                 while ( my $Element = shift @queue ) {
 380                         my $rv = &$wanted( $self, $Element );
 381                         push @found, $Element if $rv;
 382
 383                         # Support "don't descend on undef return"
 384                         next unless defined $rv;
 385
 386                         # Skip if the Element doesn't have any children
 387                         next unless $Element->isa('PPI::Node');
 388
 389                         # Depth-first keeps the queue size down and provides a
 390                         # better logical order.
 391                         if ( $Element->isa('PPI::Structure') ) {
 392                                 unshift @queue, $Element->finish if $Element->finish;
 393                                 unshift @queue, $Element->children;
 394                                 unshift @queue, $Element->start if $Element->start;
 395                         } else {
 396                                 unshift @queue, $Element->children;
 397                         }
 398                 }
 399         };
 400         if ( $@ ) {
 401                 # Caught exception thrown from the wanted function
 402                 return undef;
 403         }
 404
 405         @found ? \@found : '';
 406 }
 407
 408 =pod
 409
 410 =head2 find_first $class | \&wanted
 411
 412 If the normal C<find> method is like a grep, then C<find_first> is
 413 equivalent to the L<Scalar::Util> C<first> function.
 414
 415 Given an element class or a wanted function, it will search depth-first
 416 through a tree until it finds something that matches the condition,
 417 returning the first Element that it encounters.
 418
 419 See the C<find> method for details on the format of the search condition.
 420
 421 Returns the first L<PPI::Element> object that matches the condition, false
 422 if nothing matches the condition, or C<undef> if given an invalid condition,
 423 or an error occurs.
 424
 425 =cut
 426
 427 sub find_first {
 428         my $self   = shift;
 429         my $wanted = $self->_wanted(shift) or return undef;
 430
 431         # Use the same queue-based search as for ->find
 432         my @queue = $self->children;
 433         my $rv    = eval {
 434                 # The defined() here prevents a ton of calls to PPI::Util::TRUE
 435                 while ( defined( my $Element = shift @queue ) ) {
 436                         my $rv = &$wanted( $self, $Element );
 437                         return $Element if $rv;
 438
 439                         # Support "don't descend on undef return"
 440                         next unless defined $rv;
 441
 442                         # Skip if the Element doesn't have any children
 443                         next unless $Element->isa('PPI::Node');
 444
 445                         # Depth-first keeps the queue size down and provides a
 446                         # better logical order.
 447                         if ( $Element->isa('PPI::Structure') ) {
 448                                 unshift @queue, $Element->finish if defined($Element->finish);
 449                                 unshift @queue, $Element->children;
 450                                 unshift @queue, $Element->start  if defined($Element->start);
 451                         } else {
 452                                 unshift @queue, $Element->children;
 453                         }
 454                 }
 455         };
 456         if ( $@ ) {
 457                 # Caught exception thrown from the wanted function
 458                 return undef;
 459         }
 460
 461         $rv or '';
 462 }
 463
 464 =pod
 465
 466 =head2 find_any $class | \&wanted
 467
 468 The C<find_any> method is a short-circuiting true/false method that behaves
 469 like the normal C<find> method, but returns true as soon as it finds any
 470 Elements that match the search condition.
 471
 472 See the C<find> method for details on the format of the search condition.
 473
 474 Returns true if any Elements that match the condition can be found, false if
 475 not, or C<undef> if given an invalid condition, or an error occurs.
 476
 477 =cut
 478
 479 sub find_any {
 480         my $self = shift;
 481         my $rv   = $self->find_first(@_);
 482         $rv ? 1 : $rv; # false or undef
 483 }
 484
 485 =pod
 486
 487 =head2 remove_child $Element
 488
 489 If passed a L<PPI::Element> object that is a direct child of the Node,
 490 the C<remove_element> method will remove the C<Element> intact, along
 491 with any of its children. As such, this method acts essentially as a
 492 'cut' function.
 493
 494 If successful, returns the removed element.  Otherwise, returns C<undef>.
 495
 496 =cut
 497
 498 sub remove_child {
 499         my $self  = shift;
 500         my $child = _INSTANCE(shift, 'PPI::Element') or return undef;
 501
 502         # Find the position of the child
 503         my $key = refaddr $child;
 504         my $p   = List::MoreUtils::firstidx {
 505                 refaddr $_ == $key
 506         } @{$self->{children}};
 507         return undef unless defined $p;
 508
 509         # Splice it out, and remove the child's parent entry
 510         splice( @{$self->{children}}, $p, 1 );
 511         delete $_PARENT{refaddr $child};
 512
 513         $child;
 514 }
 515
 516 =pod
 517
 518 =head2 prune $class | \&wanted
 519
 520 The C<prune> method is used to strip L<PPI::Element> objects out of a code
 521 tree. The argument is the same as for the C<find> method, either a class
 522 name, or an anonymous subroutine which returns true/false. Any Element
 523 that matches the class|wanted will be deleted from the code tree, along
 524 with any of its children.
 525
 526 The C<prune> method returns the number of C<Element> objects that matched
 527 and were removed, B<non-recursively>. This might also be zero, so avoid a
 528 simple true/false test on the return false of the C<prune> method. It
 529 returns C<undef> on error, which you probably B<should> test for.
 530
 531 =begin testing prune 2
 532
 533 # Avoids a bug in old Perls relating to the detection of scripts
 534 # Known to occur in ActivePerl 5.6.1 and at least one 5.6.2 install.
 535 my $hashbang = reverse 'lrep/nib/rsu/!#';
 536 my $document = PPI::Document->new( \<<"END_PERL" );
 537 $hashbang
 538
 539 use strict;
 540
 541 sub one { 1 }
 542 sub two { 2 }
 543 sub three { 3 }
 544
 545 print one;
 546 print "\n";
 547 print three;
 548 print "\n";
 549
 550 exit;
 551 END_PERL
 552
 553 isa_ok( $document, 'PPI::Document' );
 554 ok( defined($document->prune ('PPI::Statement::Sub')),
 555         'Pruned multiple subs ok' );
 556
 557 =end testing
 558
 559 =cut
 560
 561 sub prune {
 562         my $self   = shift;
 563         my $wanted = $self->_wanted(shift) or return undef;
 564
 565         # Use a depth-first queue search
 566         my $pruned = 0;
 567         my @queue  = $self->children;
 568         eval {
 569                 while ( my $element = shift @queue ) {
 570                         my $rv = &$wanted( $self, $element );
 571                         if ( $rv ) {
 572                                 # Delete the child
 573                                 $element->delete or return undef;
 574                                 $pruned++;
 575                                 next;
 576                         }
 577
 578                         # Support the undef == "don't descend"
 579                         next unless defined $rv;
 580
 581                         if ( _INSTANCE($element, 'PPI::Node') ) {
 582                                 # Depth-first keeps the queue size down
 583                                 unshift @queue, $element->children;
 584                         }
 585                 }
 586         };
 587         if ( $@ ) {
 588                 # Caught exception thrown from the wanted function
 589                 return undef;
 590         }
 591
 592         $pruned;
 593 }
 594
 595 # This method is likely to be very heavily used, to take
 596 # it slowly and carefuly.
 597 ### NOTE: Renaming this function or changing either to self will probably
 598 ###       break File::Find::Rule::PPI
 599 sub _wanted {
 600         my $either = shift;
 601         my $it     = defined($_[0]) ? shift : do {
 602                 Carp::carp('Undefined value passed as search condition') if $^W;
 603                 return undef;
 604         };
 605
 606         # Has the caller provided a wanted function directly
 607         return $it if _CODELIKE($it);
 608         if ( ref $it ) {
 609                 # No other ref types are supported
 610                 Carp::carp('Illegal non-CODE reference passed as search condition') if $^W;
 611                 return undef;
 612         }
 613
 614         # The first argument should be an Element class, possibly in shorthand
 615         $it = "PPI::$it" unless substr($it, 0, 5) eq 'PPI::';
 616         unless ( _CLASS($it) and $it->isa('PPI::Element') ) {
 617                 # We got something, but it isn't an element
 618                 Carp::carp("Cannot create search condition for '$it': Not a PPI::Element") if $^W;
 619                 return undef;
 620         }
 621
 622         # Create the class part of the wanted function
 623         my $wanted_class = "\n\treturn '' unless \$_[1]->isa('$it');";
 624
 625         # Have we been given a second argument to check the content
 626         my $wanted_content = '';
 627         if ( defined $_[0] ) {
 628                 my $content = shift;
 629                 if ( ref $content eq 'Regexp' ) {
 630                         $content = "$content";
 631                 } elsif ( ref $content ) {
 632                         # No other ref types are supported
 633                         Carp::carp("Cannot create search condition for '$it': Not a PPI::Element") if $^W;
 634                         return undef;
 635                 } else {
 636                         $content = quotemeta $content;
 637                 }
 638
 639                 # Complete the content part of the wanted function
 640                 $wanted_content .= "\n\treturn '' unless defined \$_[1]->{content};";
 641                 $wanted_content .= "\n\treturn '' unless \$_[1]->{content} =~ /$content/;";
 642         }
 643
 644         # Create the complete wanted function
 645         my $code = "sub {"
 646                 . $wanted_class
 647                 . $wanted_content
 648                 . "\n\t1;"
 649                 . "\n}";
 650
 651         # Compile the wanted function
 652         $code = eval $code;
 653         (ref $code eq 'CODE') ? $code : undef;
 654 }
 655
 656
 657
 658
 659
 660 ####################################################################
 661 # PPI::Element overloaded methods
 662
 663 sub tokens {
 664         map { $_->tokens } @{$_[0]->{children}};
 665 }
 666
 667 ### XS -> PPI/XS.xs:_PPI_Element__content 0.900+
 668 sub content {
 669         join '', map { $_->content } @{$_[0]->{children}};
 670 }
 671
 672 # Clone as normal, but then go down and relink all the _PARENT entries
 673 sub clone {
 674         my $self  = shift;
 675         my $clone = $self->SUPER::clone;
 676         $clone->__link_children;
 677         $clone;
 678 }
 679
 680 sub location {
 681         my $self  = shift;
 682         my $first = $self->{children}->[0] or return undef;
 683         $first->location;
 684 }
 685
 686
 687
 688
 689
 690 #####################################################################
 691 # Internal Methods
 692
 693 sub DESTROY {
 694         local $_;
 695         if ( $_[0]->{children} ) {
 696                 my @queue = $_[0];
 697                 while ( defined($_ = shift @queue) ) {
 698                         unshift @queue, @{delete $_->{children}} if $_->{children};
 699
 700                         # Remove all internal/private weird crosslinking so that
 701                         # the cascading DESTROY calls will get called properly.
 702                         %$_ = ();
 703                 }
 704         }
 705
 706         # Remove us from our parent node as normal
 707         delete $_PARENT{refaddr $_[0]};
 708 }
 709
 710 # Find the position of a child
 711 sub __position {
 712         my $key = refaddr $_[1];
 713         List::MoreUtils::firstidx { refaddr $_ == $key } @{$_[0]->{children}};
 714 }
 715
 716 # Insert one or more elements before a child
 717 sub __insert_before_child {
 718         my $self = shift;
 719         my $key  = refaddr shift;
 720         my $p    = List::MoreUtils::firstidx {
 721                  refaddr $_ == $key
 722                  } @{$self->{children}};
 723         foreach ( @_ ) {
 724                 Scalar::Util::weaken(
 725                         $_PARENT{refaddr $_} = $self
 726                         );
 727         }
 728         splice( @{$self->{children}}, $p, 0, @_ );
 729         1;
 730 }
 731
 732 # Insert one or more elements after a child
 733 sub __insert_after_child {
 734         my $self = shift;
 735         my $key  = refaddr shift;
 736         my $p    = List::MoreUtils::firstidx {
 737                  refaddr $_ == $key
 738                  } @{$self->{children}};
 739         foreach ( @_ ) {
 740                 Scalar::Util::weaken(
 741                         $_PARENT{refaddr $_} = $self
 742                         );
 743         }
 744         splice( @{$self->{children}}, $p + 1, 0, @_ );
 745         1;
 746 }
 747
 748 # Replace a child
 749 sub __replace_child {
 750         my $self = shift;
 751         my $key  = refaddr shift;
 752         my $p    = List::MoreUtils::firstidx {
 753                  refaddr $_ == $key
 754                  } @{$self->{children}};
 755         foreach ( @_ ) {
 756                 Scalar::Util::weaken(
 757                         $_PARENT{refaddr $_} = $self
 758                         );
 759         }
 760         splice( @{$self->{children}}, $p, 1, @_ );
 761         1;
 762 }
 763
 764 # Create PARENT links for an entire tree.
 765 # Used when cloning or thawing.
 766 sub __link_children {
 767         my $self = shift;
 768
 769         # Relink all our children ( depth first )
 770         my @queue = ( $self );
 771         while ( my $Node = shift @queue ) {
 772                 # Link our immediate children
 773                 foreach my $Element ( @{$Node->{children}} ) {
 774                         Scalar::Util::weaken(
 775                                 $_PARENT{refaddr($Element)} = $Node
 776                                 );
 777                         unshift @queue, $Element if $Element->isa('PPI::Node');
 778                 }
 779
 780                 # If it's a structure, relink the open/close braces
 781                 next unless $Node->isa('PPI::Structure');
 782                 Scalar::Util::weaken(
 783                         $_PARENT{refaddr($Node->start)}  = $Node
 784                         ) if $Node->start;
 785                 Scalar::Util::weaken(
 786                         $_PARENT{refaddr($Node->finish)} = $Node
 787                         ) if $Node->finish;
 788         }
 789
 790         1;
 791 }
 792
 793 1;
 794
 795 =pod
 796
 797 =head1 TO DO
 798
 799 - Move as much as possible to L<PPI::XS>
 800
 801 =head1 SUPPORT
 802
 803 See the L<support section|PPI/SUPPORT> in the main module.
 804
 805 =head1 AUTHOR
 806
 807 Adam Kennedy E<lt>adamk@cpan.orgE<gt>
 808
 809 =head1 COPYRIGHT
 810
 811 Copyright 2001 - 2009 Adam Kennedy.
 812
 813 This program is free software; you can redistribute
 814 it and/or modify it under the same terms as Perl itself.
 815
 816 The full text of the license can be found in the
 817 LICENSE file included with this module.
 818
 819 =cut