GPL_bin_fullset/NaturalDocs/Modules/NaturalDocs/Languages/Perl.pm

   1 ###############################################################################
   2 #
   3 #   Class: NaturalDocs::Languages::Perl
   4 #
   5 ###############################################################################
   6 #
   7 #   A subclass to handle the language variations of Perl.
   8 #
   9 #
  10 #   Topic: Language Support
  11 #
  12 #       Supported:
  13 #
  14 #       - Packages
  15 #       - Inheritance via "use base" and "@ISA =".
  16 #       - Functions
  17 #       - Variables
  18 #
  19 #       Not supported yet:
  20 #
  21 #       - Constants
  22 #
  23 ###############################################################################
  24
  25 # This file is part of Natural Docs, which is Copyright © 2003-2010 Greg Valure
  26 # Natural Docs is licensed under version 3 of the GNU Affero General Public License (AGPL)
  27 # Refer to License.txt for the complete details
  28
  29 use strict;
  30 use integer;
  31
  32 package NaturalDocs::Languages::Perl;
  33
  34 use base 'NaturalDocs::Languages::Advanced';
  35
  36
  37 #
  38 #   array: hereDocTerminators
  39 #   An array of active Here Doc terminators, or an empty array if not active.  Each entry is an arrayref of tokens.  The entries
  40 #   must appear in the order they must appear in the source.
  41 #
  42 my @hereDocTerminators;
  43
  44
  45
  46 ###############################################################################
  47 # Group: Interface Functions
  48
  49
  50 #
  51 #   Function: PackageSeparator
  52 #   Returns the package separator symbol.
  53 #
  54 sub PackageSeparator
  55     {  return '::';  };
  56
  57 #
  58 #   Function: EnumValues
  59 #   Returns the <EnumValuesType> that describes how the language handles enums.
  60 #
  61 sub EnumValues
  62     {  return ::ENUM_GLOBAL();  };
  63
  64
  65 #
  66 #   Function: ParseFile
  67 #
  68 #   Parses the passed source file, sending comments acceptable for documentation to <NaturalDocs::Parser->OnComment()>.
  69 #
  70 #   Parameters:
  71 #
  72 #       sourceFile - The name of the source file to parse.
  73 #       topicList - A reference to the list of <NaturalDocs::Parser::ParsedTopics> being built by the file.
  74 #
  75 #   Returns:
  76 #
  77 #       The array ( autoTopics, scopeRecord ).
  78 #
  79 #       autoTopics - An arrayref of automatically generated topics from the file, or undef if none.
  80 #       scopeRecord - An arrayref of <NaturalDocs::Languages::Advanced::ScopeChanges>, or undef if none.
  81 #
  82 sub ParseFile #(sourceFile, topicsList)
  83     {
  84     my ($self, $sourceFile, $topicsList) = @_;
  85
  86     @hereDocTerminators = ( );
  87
  88     # The regular block comment symbols are undef because they're all potentially JavaDoc comments.  PreprocessFile() will
  89     # handle translating things like =begin naturaldocs and =begin javadoc to =begin nd.
  90     $self->ParseForCommentsAndTokens($sourceFile, [ '#' ], undef, [ '##' ], [ '=begin nd', '=end nd' ]);
  91
  92     my $tokens = $self->Tokens();
  93     my $index = 0;
  94     my $lineNumber = 1;
  95
  96     while ($index < scalar @$tokens)
  97         {
  98         if ($self->TryToSkipWhitespace(\$index, \$lineNumber) ||
  99             $self->TryToGetPackage(\$index, \$lineNumber) ||
 100             $self->TryToGetBase(\$index, \$lineNumber) ||
 101             $self->TryToGetFunction(\$index, \$lineNumber) ||
 102             $self->TryToGetVariable(\$index, \$lineNumber) )
 103             {
 104             # The functions above will handle everything.
 105             }
 106
 107         elsif ($tokens->[$index] eq '{')
 108             {
 109             $self->StartScope('}', $lineNumber, undef);
 110             $index++;
 111             }
 112
 113         elsif ($tokens->[$index] eq '}')
 114             {
 115             if ($self->ClosingScopeSymbol() eq '}')
 116                 {  $self->EndScope($lineNumber);  };
 117
 118             $index++;
 119             }
 120
 121         elsif (lc($tokens->[$index]) eq 'eval')
 122             {
 123             # We want to skip the token in this case instead of letting it fall to SkipRestOfStatement.  This allows evals with braces
 124             # to be treated like normal floating braces.
 125             $index++;
 126             }
 127
 128         else
 129             {
 130             $self->SkipRestOfStatement(\$index, \$lineNumber);
 131             };
 132         };
 133
 134
 135     # Don't need to keep these around.
 136     $self->ClearTokens();
 137
 138     return ( $self->AutoTopics(), $self->ScopeRecord() );
 139     };
 140
 141
 142 #
 143 #   Function: PreprocessFile
 144 #
 145 #   Overridden to support "=begin nd" and similar.
 146 #
 147 #   - "=begin [nd|naturaldocs|natural docs|jd|javadoc|java doc]" all translate to "=begin nd".
 148 #   - "=[nd|naturaldocs|natural docs]" also translate to "=begin nd".
 149 #   - "=end [nd|naturaldocs|natural docs|jd|javadoc]" all translate to "=end nd".
 150 #   - "=cut" from a ND block translates into "=end nd", but the next line will be altered to begin with "(NDPODBREAK)".  This is
 151 #     so if there is POD leading into ND which ends with a cut, the parser can still end the original POD because the end ND line
 152 #     would have been removed.  Remember, <NaturalDocs::Languages::Advanced->ParseForCommentsAndTokens()> removes
 153 #     Natural Docs-worthy comments to save parsing time.
 154 #   - "=pod begin nd" and "=pod end nd" are supported for compatibility with ND 1.32 and earlier, even though the syntax is a
 155 #     mistake.
 156 #   - It also supports the wrong plural forms, so naturaldoc/natural doc/javadocs/java docs will work.
 157 #
 158 sub PreprocessFile #(lines)
 159     {
 160     my ($self, $lines) = @_;
 161
 162     my $inNDPOD = 0;
 163     my $mustBreakPOD = 0;
 164
 165     for (my $i = 0; $i < scalar @$lines; $i++)
 166         {
 167         if ($lines->[$i] =~ /^\=(?:(?:pod[ \t]+)?begin[ \t]+)?(?:nd|natural[ \t]*docs?|jd|java[ \t]*docs?)[ \t]*$/i)
 168             {
 169             $lines->[$i] = '=begin nd';
 170             $inNDPOD = 1;
 171             $mustBreakPOD = 0;
 172             }
 173         elsif ($lines->[$i] =~ /^\=(?:pod[ \t]+)end[ \t]+(?:nd|natural[ \t]*docs?|jd|javadocs?)[ \t]*$/i)
 174             {
 175             $lines->[$i] = '=end nd';
 176             $inNDPOD = 0;
 177             $mustBreakPOD = 0;
 178             }
 179         elsif ($lines->[$i] =~ /^\=cut[ \t]*$/i)
 180             {
 181             if ($inNDPOD)
 182                 {
 183                 $lines->[$i] = '=end nd';
 184                 $inNDPOD = 0;
 185                 $mustBreakPOD = 1;
 186                 };
 187             }
 188         elsif ($mustBreakPOD)
 189             {
 190             $lines->[$i] = '(NDPODBREAK)' . $lines->[$i];
 191             $mustBreakPOD = 0;
 192             };
 193         };
 194     };
 195
 196
 197
 198 ###############################################################################
 199 # Group: Statement Parsing Functions
 200 # All functions here assume that the current position is at the beginning of a statement.
 201 #
 202 # Note for developers: I am well aware that the code in these functions do not check if we're past the end of the tokens as
 203 # often as it should.  We're making use of the fact that Perl will always return undef in these cases to keep the code simpler.
 204
 205
 206 #
 207 #   Function: TryToGetPackage
 208 #
 209 #   Determines whether the position is at a package declaration statement, and if so, generates a topic for it, skips it, and
 210 #   returns true.
 211 #
 212 sub TryToGetPackage #(indexRef, lineNumberRef)
 213     {
 214     my ($self, $indexRef, $lineNumberRef) = @_;
 215     my $tokens = $self->Tokens();
 216
 217     if (lc($tokens->[$$indexRef]) eq 'package')
 218         {
 219         my $index = $$indexRef + 1;
 220         my $lineNumber = $$lineNumberRef;
 221
 222         if (!$self->TryToSkipWhitespace(\$index, \$lineNumber))
 223             {  return undef;  };
 224
 225         my $name;
 226
 227         while ($tokens->[$index] =~ /^[a-z_\:]/i)
 228             {
 229             $name .= $tokens->[$index];
 230             $index++;
 231             };
 232
 233         if (!defined $name)
 234             {  return undef;  };
 235
 236         my $autoTopic = NaturalDocs::Parser::ParsedTopic->New(::TOPIC_CLASS(), $name,
 237                                                                                              undef, undef,
 238                                                                                              undef,
 239                                                                                              undef, undef, $$lineNumberRef);
 240         $self->AddAutoTopic($autoTopic);
 241
 242         NaturalDocs::Parser->OnClass($autoTopic->Symbol());
 243
 244         $self->SetPackage($autoTopic->Symbol(), $$lineNumberRef);
 245
 246         $$indexRef = $index;
 247         $$lineNumberRef = $lineNumber;
 248         $self->SkipRestOfStatement($indexRef, $lineNumberRef);
 249
 250         return 1;
 251         };
 252
 253     return undef;
 254     };
 255
 256
 257 #
 258 #   Function: TryToGetBase
 259 #
 260 #   Determines whether the position is at a package base declaration statement, and if so, calls
 261 #   <NaturalDocs::Parser->OnClassParent()>.
 262 #
 263 #   Supported Syntaxes:
 264 #
 265 #   > use base [list of strings]
 266 #   > @ISA = [list of strings]
 267 #   > @[package]::ISA = [list of strings]
 268 #   > our @ISA = [list of strings]
 269 #
 270 sub TryToGetBase #(indexRef, lineNumberRef)
 271     {
 272     my ($self, $indexRef, $lineNumberRef) = @_;
 273     my $tokens = $self->Tokens();
 274
 275     my ($index, $lineNumber, $class, $parents);
 276
 277     if (lc($tokens->[$$indexRef]) eq 'use')
 278         {
 279         $index = $$indexRef + 1;
 280         $lineNumber = $$lineNumberRef;
 281
 282         if (!$self->TryToSkipWhitespace(\$index, \$lineNumber) ||
 283            lc($tokens->[$index]) ne 'base')
 284             {  return undef;  }
 285
 286         $index++;
 287         $self->TryToSkipWhitespace(\$index, \$lineNumber);
 288
 289         $parents = $self->TryToGetListOfStrings(\$index, \$lineNumber);
 290         }
 291
 292     else
 293         {
 294         $index = $$indexRef;
 295         $lineNumber = $$lineNumberRef;
 296
 297         if (lc($tokens->[$index]) eq 'our')
 298             {
 299             $index++;
 300             $self->TryToSkipWhitespace(\$index, \$lineNumber);
 301             };
 302
 303         if ($tokens->[$index] eq '@')
 304             {
 305             $index++;
 306
 307             while ($index < scalar @$tokens)
 308                 {
 309                 if ($tokens->[$index] eq 'ISA')
 310                     {
 311                     $index++;
 312                     $self->TryToSkipWhitespace(\$index, \$lineNumber);
 313
 314                     if ($tokens->[$index] eq '=')
 315                         {
 316                         $index++;
 317                         $self->TryToSkipWhitespace(\$index, \$lineNumber);
 318
 319                         $parents = $self->TryToGetListOfStrings(\$index, \$lineNumber);
 320                         }
 321                     else
 322                         {  last;  };
 323                     }
 324
 325                 # If token isn't ISA...
 326                 elsif ($tokens->[$index] =~ /^[a-z0-9_:]/i)
 327                     {
 328                     $class .= $tokens->[$index];
 329                     $index++;
 330                     }
 331                 else
 332                     {  last;  };
 333                 };
 334             };
 335         };
 336
 337     if (defined $parents)
 338         {
 339         if (defined $class)
 340             {
 341             $class =~ s/::$//;
 342             my @classIdentifiers = split(/::/, $class);
 343             $class = NaturalDocs::SymbolString->Join(@classIdentifiers);
 344             }
 345         else
 346             {  $class = $self->CurrentScope();  };
 347
 348         foreach my $parent (@$parents)
 349             {
 350             my @parentIdentifiers = split(/::/, $parent);
 351             my $parentSymbol = NaturalDocs::SymbolString->Join(@parentIdentifiers);
 352
 353             NaturalDocs::Parser->OnClassParent($class, $parentSymbol, undef, undef, ::RESOLVE_ABSOLUTE());
 354             };
 355
 356         $$indexRef = $index;
 357         $$lineNumberRef = $lineNumber;
 358         $self->SkipRestOfStatement($indexRef, $lineNumberRef);
 359
 360         return 1;
 361         }
 362     else
 363         {  return undef;  };
 364     };
 365
 366
 367 #
 368 #   Function: TryToGetFunction
 369 #
 370 #   Determines whether the position is at a function declaration statement, and if so, generates a topic for it, skips it, and
 371 #   returns true.
 372 #
 373 sub TryToGetFunction #(indexRef, lineNumberRef)
 374     {
 375     my ($self, $indexRef, $lineNumberRef) = @_;
 376     my $tokens = $self->Tokens();
 377
 378     if ( lc($tokens->[$$indexRef]) eq 'sub')
 379         {
 380         my $prototypeStart = $$indexRef;
 381         my $prototypeStartLine = $$lineNumberRef;
 382         my $prototypeEnd = $$indexRef + 1;
 383         my $prototypeEndLine = $$lineNumberRef;
 384
 385         if ( !$self->TryToSkipWhitespace(\$prototypeEnd, \$prototypeEndLine) ||
 386              $tokens->[$prototypeEnd] !~ /^[a-z_]/i )
 387             {  return undef;  };
 388
 389         my $name = $tokens->[$prototypeEnd];
 390         $prototypeEnd++;
 391
 392         # We parsed 'sub [name]'.  Now keep going until we find a semicolon or a brace.
 393
 394         for (;;)
 395             {
 396             if ($prototypeEnd >= scalar @$tokens)
 397                 {  return undef;  }
 398
 399             # End if we find a semicolon, since it means we found a predeclaration rather than an actual function.
 400             elsif ($tokens->[$prototypeEnd] eq ';')
 401                 {  return undef;  }
 402
 403             elsif ($tokens->[$prototypeEnd] eq '{')
 404                 {
 405                 # Found it!
 406
 407                 my $prototype = $self->NormalizePrototype( $self->CreateString($prototypeStart, $prototypeEnd) );
 408
 409                 $self->AddAutoTopic(NaturalDocs::Parser::ParsedTopic->New(::TOPIC_FUNCTION(), $name,
 410                                                                                                           $self->CurrentScope(), undef,
 411                                                                                                           $prototype,
 412                                                                                                           undef, undef, $prototypeStartLine));
 413
 414                 $$indexRef = $prototypeEnd;
 415                 $$lineNumberRef = $prototypeEndLine;
 416
 417                 $self->SkipRestOfStatement($indexRef, $lineNumberRef);
 418
 419                 return 1;
 420                 }
 421
 422             else
 423                 {  $self->GenericSkip(\$prototypeEnd, \$prototypeEndLine, 0, 1);  };
 424             };
 425         }
 426     else
 427         {  return undef;  };
 428     };
 429
 430
 431 #
 432 #   Function: TryToGetVariable
 433 #
 434 #   Determines if the position is at a variable declaration statement, and if so, generates a topic for it, skips it, and returns
 435 #   true.
 436 #
 437 #   Supported Syntaxes:
 438 #
 439 #   - Supports variables declared with "my", "our", and "local".
 440 #   - Supports multiple declarations in one statement, such as "my ($x, $y);".
 441 #   - Supports types and attributes.
 442 #
 443 sub TryToGetVariable #(indexRef, lineNumberRef)
 444     {
 445     my ($self, $indexRef, $lineNumberRef) = @_;
 446     my $tokens = $self->Tokens();
 447
 448     my $firstToken = lc( $tokens->[$$indexRef] );
 449
 450     if ($firstToken eq 'my' || $firstToken eq 'our' || $firstToken eq 'local')
 451         {
 452         my $prototypeStart = $$indexRef;
 453         my $prototypeStartLine = $$lineNumberRef;
 454         my $prototypeEnd = $$indexRef + 1;
 455         my $prototypeEndLine = $$lineNumberRef;
 456
 457         $self->TryToSkipWhitespace(\$prototypeEnd, \$prototypeEndLine);
 458
 459
 460         # Get the type if present.
 461
 462         my $type;
 463
 464         if ($tokens->[$prototypeEnd] =~ /^[a-z\:]/i)
 465             {
 466             do
 467                 {
 468                 $type .= $tokens->[$prototypeEnd];
 469                 $prototypeEnd++;
 470                 }
 471             while ($tokens->[$prototypeEnd] =~ /^[a-z\:]/i);
 472
 473             if (!$self->TryToSkipWhitespace(\$prototypeEnd, \$prototypeEndLine))
 474                 {  return undef;  };
 475             };
 476
 477
 478         # Get the name, or possibly names.
 479
 480         if ($tokens->[$prototypeEnd] eq '(')
 481             {
 482             # If there's multiple variables, we'll need to build a custom prototype for each one.  $firstToken already has the
 483             # declaring word.  We're going to store each name in @names, and we're going to use $prototypeStart and
 484             # $prototypeEnd to capture any properties appearing after the list.
 485
 486             my $name;
 487             my @names;
 488             my $hasComma = 0;
 489
 490             $prototypeStart = $prototypeEnd + 1;
 491             $prototypeStartLine = $prototypeEndLine;
 492
 493             for (;;)
 494                 {
 495                 $self->TryToSkipWhitespace(\$prototypeStart, \$prototypeStartLine);
 496
 497                 $name = $self->TryToGetVariableName(\$prototypeStart, \$prototypeStartLine);
 498
 499                 if (!defined $name)
 500                     {  return undef;  };
 501
 502                 push @names, $name;
 503
 504                 $self->TryToSkipWhitespace(\$prototypeStart, \$prototypeStartLine);
 505
 506                 # We can have multiple commas in a row.  We can also have trailing commas.  However, the parenthesis must
 507                 # not start with a comma or be empty, hence this logic does not appear earlier.
 508                 while ($tokens->[$prototypeStart] eq ',')
 509                     {
 510                     $prototypeStart++;
 511                     $self->TryToSkipWhitespace(\$prototypeStart, \$prototypeStartLine);
 512
 513                     $hasComma = 1;
 514                     }
 515
 516                 if ($tokens->[$prototypeStart] eq ')')
 517                     {
 518                     $prototypeStart++;
 519                     last;
 520                     }
 521                 elsif (!$hasComma)
 522                     {  return undef;  };
 523                 };
 524
 525
 526             # Now find the end of the prototype.
 527
 528             $prototypeEnd = $prototypeStart;
 529             $prototypeEndLine = $prototypeStartLine;
 530
 531             while ($prototypeEnd < scalar @$tokens &&
 532                      $tokens->[$prototypeEnd] !~ /^[\;\=]/)
 533                 {
 534                 $prototypeEnd++;
 535                 };
 536
 537
 538             my $prototypePrefix = $firstToken . ' ';
 539             if (defined $type)
 540                 {  $prototypePrefix .= $type . ' ';  };
 541
 542             my $prototypeSuffix = ' ' . $self->CreateString($prototypeStart, $prototypeEnd);
 543
 544             foreach $name (@names)
 545                 {
 546                 my $prototype = $self->NormalizePrototype( $prototypePrefix . $name . $prototypeSuffix );
 547
 548                 $self->AddAutoTopic(NaturalDocs::Parser::ParsedTopic->New(::TOPIC_VARIABLE(), $name,
 549                                                                                                            $self->CurrentScope(), undef,
 550                                                                                                            $prototype,
 551                                                                                                            undef, undef, $prototypeStartLine));
 552                 };
 553
 554             $self->SkipRestOfStatement(\$prototypeEnd, \$prototypeEndLine);
 555
 556             $$indexRef = $prototypeEnd;
 557             $$lineNumberRef = $prototypeEndLine;
 558             }
 559
 560         else # no parenthesis
 561             {
 562             my $name = $self->TryToGetVariableName(\$prototypeEnd, \$prototypeEndLine);
 563
 564             if (!defined $name)
 565                 {  return undef;  };
 566
 567             while ($prototypeEnd < scalar @$tokens &&
 568                      $tokens->[$prototypeEnd] !~ /^[\;\=]/)
 569                 {
 570                 $prototypeEnd++;
 571                 };
 572
 573             my $prototype = $self->NormalizePrototype( $self->CreateString($prototypeStart, $prototypeEnd) );
 574
 575             $self->AddAutoTopic(NaturalDocs::Parser::ParsedTopic->New(::TOPIC_VARIABLE(), $name,
 576                                                                                                        $self->CurrentScope(), undef,
 577                                                                                                        $prototype,
 578                                                                                                        undef, undef, $prototypeStartLine));
 579
 580             $self->SkipRestOfStatement(\$prototypeEnd, \$prototypeEndLine);
 581
 582             $$indexRef = $prototypeEnd;
 583             $$lineNumberRef = $prototypeEndLine;
 584             };
 585
 586         return 1;
 587         }
 588     else
 589         {  return undef;  };
 590     };
 591
 592
 593 #
 594 #   Function: TryToGetVariableName
 595 #
 596 #   Determines if the position is at a variable name, and if so, skips it and returns the name.
 597 #
 598 sub TryToGetVariableName #(indexRef, lineNumberRef)
 599     {
 600     my ($self, $indexRef, $lineNumberRef) = @_;
 601     my $tokens = $self->Tokens();
 602
 603     my $name;
 604
 605     if ($tokens->[$$indexRef] =~ /^[\$\@\%\*]/)
 606         {
 607         $name .= $tokens->[$$indexRef];
 608         $$indexRef++;
 609
 610         $self->TryToSkipWhitespace($indexRef, $lineNumberRef);
 611
 612         if ($tokens->[$$indexRef] =~ /^[a-z_]/i)
 613             {
 614             $name .= $tokens->[$$indexRef];
 615             $$indexRef++;
 616             }
 617         else
 618             {  return undef;  };
 619         };
 620
 621     return $name;
 622     };
 623
 624
 625 #
 626 #   Function: TryToGetListOfStrings
 627 #
 628 #   Attempts to retrieve a list of strings from the current position.  Returns an arrayref of them if any are found, or undef if none.
 629 #   It stops the moment it reaches a non-string, so "string1, variable, string2" will only return string1.
 630 #
 631 #   Supported Syntaxes:
 632 #
 633 #   - Supports parenthesis.
 634 #   - Supports all string forms supported by <TryToSkipString()>.
 635 #   - Supports qw() string arrays.
 636 #
 637 sub TryToGetListOfStrings #(indexRef, lineNumberRef)
 638     {
 639     my ($self, $indexRef, $lineNumberRef) = @_;
 640     my $tokens = $self->Tokens();
 641
 642     my $parenthesis = 0;
 643     my $strings;
 644
 645     while ($$indexRef < scalar @$tokens)
 646         {
 647         # We'll tolerate parenthesis.
 648         if ($tokens->[$$indexRef] eq '(')
 649             {
 650             $$indexRef++;
 651             $parenthesis++;
 652             }
 653         elsif ($tokens->[$$indexRef] eq ')')
 654             {
 655             if ($parenthesis == 0)
 656                 {  last;  };
 657
 658             $$indexRef++;
 659             $parenthesis--;
 660             }
 661         elsif ($tokens->[$$indexRef] eq ',')
 662             {
 663             $$indexRef++;
 664             }
 665         else
 666             {
 667             my ($startContent, $endContent);
 668             my $symbolIndex = $$indexRef;
 669
 670             if ($self->TryToSkipString($indexRef, $lineNumberRef, \$startContent, \$endContent))
 671                 {
 672                 my $content = $self->CreateString($startContent, $endContent);
 673
 674                 if (!defined $strings)
 675                     {  $strings = [ ];  };
 676
 677                 if (lc($tokens->[$symbolIndex]) eq 'qw')
 678                     {
 679                     $content =~ tr/ \t\n/ /s;
 680                     $content =~ s/^ //;
 681
 682                     my @qwStrings = split(/ /, $content);
 683
 684                     push @$strings, @qwStrings;
 685                     }
 686                 else
 687                     {
 688                     push @$strings, $content;
 689                     };
 690                 }
 691             else
 692                 {  last;  };
 693             };
 694
 695         $self->TryToSkipWhitespace($indexRef, $lineNumberRef);
 696         };
 697
 698     return $strings;
 699     };
 700
 701
 702 ###############################################################################
 703 # Group: Low Level Parsing Functions
 704
 705
 706 #
 707 #   Function: GenericSkip
 708 #
 709 #   Advances the position one place through general code.
 710 #
 711 #   - If the position is on a comment or string, it will skip it completely.
 712 #   - If the position is on an opening symbol, it will skip until the past the closing symbol.
 713 #   - If the position is on a regexp or quote-like operator, it will skip it completely.
 714 #   - If the position is on a backslash, it will skip it and the following token.
 715 #   - If the position is on whitespace (including comments), it will skip it completely.
 716 #   - Otherwise it skips one token.
 717 #
 718 #   Parameters:
 719 #
 720 #       indexRef - A reference to the current index.
 721 #       lineNumberRef - A reference to the current line number.
 722 #       noRegExps - If set, does not test for regular expressions.
 723 #
 724 sub GenericSkip #(indexRef, lineNumberRef, noRegExps)
 725     {
 726     my ($self, $indexRef, $lineNumberRef, $noRegExps, $allowStringedClosingParens) = @_;
 727     my $tokens = $self->Tokens();
 728
 729     if ($tokens->[$$indexRef] eq "\\" && $$indexRef + 1 < scalar @$tokens && $tokens->[$$indexRef+1] ne "\n")
 730         {  $$indexRef += 2;  }
 731
 732     # Note that we don't want to count backslashed ()[]{} since they could be in regexps.  Also, ()[] are valid variable names
 733     # when preceded by a string.
 734
 735     # We can ignore the scope stack because we're just skipping everything without parsing, and we need recursion anyway.
 736     elsif ($tokens->[$$indexRef] eq '{' && !$self->IsBackslashed($$indexRef))
 737         {
 738         $$indexRef++;
 739         $self->GenericSkipUntilAfter($indexRef, $lineNumberRef, '}', $noRegExps, $allowStringedClosingParens);
 740         }
 741     elsif ($tokens->[$$indexRef] eq '(' && !$self->IsBackslashed($$indexRef) && !$self->IsStringed($$indexRef))
 742         {
 743         # Temporarily allow stringed closing parenthesis if it looks like we're in an anonymous function declaration with Perl's
 744         # cheap version of prototypes, such as "my $_declare = sub($) {}".
 745         my $tempAllowStringedClosingParens = $allowStringedClosingParens;
 746         if (!$allowStringedClosingParens)
 747                 {
 748                 my $tempIndex = $$indexRef - 1;
 749                 if ($tempIndex >= 0 && $tokens->[$tempIndex] =~ /^[ \t]/)
 750                         {  $tempIndex--;  }
 751                 if ($tempIndex >= 0 && $tokens->[$tempIndex] eq 'sub')
 752                         {  $tempAllowStringedClosingParens = 1;  }
 753                 }
 754
 755         $$indexRef++;
 756
 757         do
 758             {  $self->GenericSkipUntilAfter($indexRef, $lineNumberRef, ')', $noRegExps, $tempAllowStringedClosingParens);  }
 759         while ($$indexRef < scalar @$tokens && $self->IsStringed($$indexRef - 1) && !$tempAllowStringedClosingParens);
 760         }
 761     elsif ($tokens->[$$indexRef] eq '[' && !$self->IsBackslashed($$indexRef) && !$self->IsStringed($$indexRef))
 762         {
 763         $$indexRef++;
 764
 765         do
 766             {  $self->GenericSkipUntilAfter($indexRef, $lineNumberRef, ']', $noRegExps, $allowStringedClosingParens);  }
 767         while ($$indexRef < scalar @$tokens && $self->IsStringed($$indexRef - 1));
 768         }
 769
 770     elsif ($self->TryToSkipWhitespace($indexRef, $lineNumberRef) ||
 771             $self->TryToSkipString($indexRef, $lineNumberRef) ||
 772             $self->TryToSkipHereDocDeclaration($indexRef, $lineNumberRef) ||
 773             (!$noRegExps && $self->TryToSkipRegexp($indexRef, $lineNumberRef) ) )
 774         {
 775         }
 776
 777     else
 778         {  $$indexRef++;  };
 779     };
 780
 781
 782 #
 783 #   Function: GenericSkipUntilAfter
 784 #
 785 #   Advances the position via <GenericSkip()> until a specific token is reached and passed.
 786 #
 787 sub GenericSkipUntilAfter #(indexRef, lineNumberRef, token, noRegExps, allowStringedClosingParens)
 788     {
 789     my ($self, $indexRef, $lineNumberRef, $token, $noRegExps, $allowStringedClosingParens) = @_;
 790     my $tokens = $self->Tokens();
 791
 792     while ($$indexRef < scalar @$tokens && $tokens->[$$indexRef] ne $token)
 793         {  $self->GenericSkip($indexRef, $lineNumberRef, $noRegExps, $allowStringedClosingParens);  };
 794
 795     if ($tokens->[$$indexRef] eq "\n")
 796         {  $$lineNumberRef++;  };
 797     $$indexRef++;
 798     };
 799
 800
 801 #
 802 #   Function: GenericRegexpSkip
 803 #
 804 #   Advances the position one place through regexp code.
 805 #
 806 #   - If the position is on an opening symbol, it will skip until the past the closing symbol.
 807 #   - If the position is on a backslash, it will skip it and the following token.
 808 #   - If the position is on whitespace (not including comments), it will skip it completely.
 809 #   - Otherwise it skips one token.
 810 #
 811 #   Also differs from <GenericSkip()> in that the parenthesis in $( and $) do count against the scope, where they wouldn't
 812 #   normally.
 813 #
 814 #   Parameters:
 815 #
 816 #       indexRef - A reference to the current index.
 817 #       lineNumberRef - A reference to the current line number.
 818 #       inBrackets - Whether we're in brackets or not.  If true, we don't care about matching braces and parenthesis.
 819 #
 820 sub GenericRegexpSkip #(indexRef, lineNumberRef, inBrackets)
 821     {
 822     my ($self, $indexRef, $lineNumberRef, $inBrackets) = @_;
 823     my $tokens = $self->Tokens();
 824
 825     if ($tokens->[$$indexRef] eq "\\" && $$indexRef + 1 < scalar @$tokens && $tokens->[$$indexRef+1] ne "\n")
 826         {  $$indexRef += 2;  }
 827
 828     # We can ignore the scope stack because we're just skipping everything without parsing, and we need recursion anyway.
 829     elsif ($tokens->[$$indexRef] eq '{' && !$self->IsBackslashed($$indexRef) && !$inBrackets)
 830         {
 831         $$indexRef++;
 832         $self->GenericRegexpSkipUntilAfter($indexRef, $lineNumberRef, '}');
 833         }
 834     elsif ($tokens->[$$indexRef] eq '(' && !$self->IsBackslashed($$indexRef) && !$inBrackets)
 835         {
 836         $$indexRef++;
 837         $self->GenericRegexpSkipUntilAfter($indexRef, $lineNumberRef, ')');
 838         }
 839     elsif ($tokens->[$$indexRef] eq '[' && !$self->IsBackslashed($$indexRef) && !$self->IsStringed($$indexRef))
 840         {
 841         $$indexRef++;
 842
 843         do
 844             {  $self->GenericRegexpSkipUntilAfter($indexRef, $lineNumberRef, ']');  }
 845         while ($$indexRef < scalar @$tokens && $self->IsStringed($$indexRef - 1));
 846         }
 847
 848     elsif ($tokens->[$$indexRef] eq "\n")
 849         {
 850         $$lineNumberRef++;
 851         $$indexRef++;
 852         }
 853
 854     else
 855         {  $$indexRef++;  };
 856     };
 857
 858
 859 #
 860 #   Function: GenericRegexpSkipUntilAfter
 861 #
 862 #   Advances the position via <GenericRegexpSkip()> until a specific token is reached and passed.
 863 #
 864 sub GenericRegexpSkipUntilAfter #(indexRef, lineNumberRef, token)
 865     {
 866     my ($self, $indexRef, $lineNumberRef, $token) = @_;
 867     my $tokens = $self->Tokens();
 868
 869     my $inBrackets = ( $token eq ']' );
 870
 871     while ($$indexRef < scalar @$tokens && $tokens->[$$indexRef] ne $token)
 872         {  $self->GenericRegexpSkip($indexRef, $lineNumberRef, $inBrackets);  };
 873
 874     if ($tokens->[$$indexRef] eq "\n")
 875         {  $$lineNumberRef++;  };
 876     $$indexRef++;
 877     };
 878
 879
 880 #
 881 #   Function: SkipRestOfStatement
 882 #
 883 #   Advances the position via <GenericSkip()> until after the end of the current statement, which is defined as a semicolon or
 884 #   a brace group.  Of course, either of those appearing inside parenthesis, a nested brace group, etc. don't count.
 885 #
 886 sub SkipRestOfStatement #(indexRef, lineNumberRef)
 887     {
 888     my ($self, $indexRef, $lineNumberRef) = @_;
 889     my $tokens = $self->Tokens();
 890
 891     while ($$indexRef < scalar @$tokens &&
 892              $tokens->[$$indexRef] ne ';' &&
 893              !($tokens->[$$indexRef] eq '{' && !$self->IsStringed($$indexRef)) )
 894         {
 895         $self->GenericSkip($indexRef, $lineNumberRef);
 896         };
 897
 898     if ($tokens->[$$indexRef] eq ';')
 899         {  $$indexRef++;  }
 900     elsif ($tokens->[$$indexRef] eq '{')
 901         {  $self->GenericSkip($indexRef, $lineNumberRef);  };
 902     };
 903
 904
 905 #
 906 #   Function: TryToSkipWhitespace
 907 #
 908 #   If the current position is on whitespace it skips them and returns true.  If there are a number of these in a row, it skips them
 909 #   all.
 910 #
 911 #   Supported Syntax:
 912 #
 913 #       - Whitespace
 914 #       - Line break
 915 #       - All comment forms supported by <TryToSkipComment()>
 916 #       - Here Doc content
 917 #
 918 sub TryToSkipWhitespace #(indexRef, lineNumberRef)
 919     {
 920     my ($self, $indexRef, $lineNumberRef) = @_;
 921     my $tokens = $self->Tokens();
 922
 923     my $result;
 924
 925     while ($$indexRef < scalar @$tokens)
 926         {
 927         if ($self->TryToSkipHereDocContent($indexRef, $lineNumberRef) ||
 928             $self->TryToSkipComment($indexRef, $lineNumberRef))
 929             {
 930             $result = 1;
 931             }
 932         elsif ($tokens->[$$indexRef] =~ /^[ \t]/)
 933             {
 934             $$indexRef++;
 935             $result = 1;
 936             }
 937         elsif ($tokens->[$$indexRef] eq "\n")
 938             {
 939             $$indexRef++;
 940             $$lineNumberRef++;
 941             $result = 1;
 942             }
 943         else
 944             {  last;  };
 945         };
 946
 947     return $result;
 948     };
 949
 950
 951 #
 952 #   Function: TryToSkipComment
 953 #   If the current position is on a comment, skip past it and return true.
 954 #
 955 sub TryToSkipComment #(indexRef, lineNumberRef)
 956     {
 957     my ($self, $indexRef, $lineNumberRef) = @_;
 958
 959     return ( $self->TryToSkipLineComment($indexRef, $lineNumberRef) ||
 960                 $self->TryToSkipPODComment($indexRef, $lineNumberRef) );
 961     };
 962
 963
 964 #
 965 #   Function: TryToSkipLineComment
 966 #   If the current position is on a line comment symbol, skip past it and return true.
 967 #
 968 sub TryToSkipLineComment #(indexRef, lineNumberRef)
 969     {
 970     my ($self, $indexRef, $lineNumberRef) = @_;
 971     my $tokens = $self->Tokens();
 972
 973     # Note that $#var is not a comment.
 974     if ($tokens->[$$indexRef] eq '#' && !$self->IsStringed($$indexRef))
 975         {
 976         $self->SkipRestOfLine($indexRef, $lineNumberRef);
 977         return 1;
 978         }
 979     else
 980         {  return undef;  };
 981     };
 982
 983
 984 #
 985 #   Function: TryToSkipPODComment
 986 #   If the current position is on a POD comment symbol, skip past it and return true.
 987 #
 988 sub TryToSkipPODComment #(indexRef, lineNumberRef)
 989     {
 990     my ($self, $indexRef, $lineNumberRef) = @_;
 991     my $tokens = $self->Tokens();
 992
 993     # Note that whitespace is not allowed before the equals sign.  It must directly start a line.
 994     if ($tokens->[$$indexRef] eq '=' &&
 995         ( $$indexRef == 0 || $tokens->[$$indexRef - 1] eq "\n" ) &&
 996         $tokens->[$$indexRef + 1] =~ /^[a-z]/i )
 997         {
 998         # Skip until =cut or (NDPODBREAK).  Note that it's theoretically possible for =cut to appear without a prior POD directive.
 999
1000         do
1001             {
1002             if ($tokens->[$$indexRef] eq '=' && lc( $tokens->[$$indexRef + 1] ) eq 'cut')
1003                 {
1004                 $self->SkipRestOfLine($indexRef, $lineNumberRef);
1005                 last;
1006                 }
1007             elsif ($tokens->[$$indexRef] eq '(' && $$indexRef + 2 < scalar @$tokens &&
1008                     $tokens->[$$indexRef+1] eq 'NDPODBREAK' && $tokens->[$$indexRef+2] eq ')')
1009                 {
1010                 $$indexRef += 3;
1011                 last;
1012                 }
1013             else
1014                 {
1015                 $self->SkipRestOfLine($indexRef, $lineNumberRef);
1016                 };
1017             }
1018         while ($$indexRef < scalar @$tokens);
1019
1020         return 1;
1021         }
1022
1023     # It's also possible that (NDPODBREAK) will appear without any opening pod statement because "=begin nd" and "=cut" will
1024     # still result in one.  We need to pick off the stray (NDPODBREAK).
1025     elsif ($tokens->[$$indexRef] eq '(' && $$indexRef + 2 < scalar @$tokens &&
1026             $tokens->[$$indexRef+1] eq 'NDPODBREAK' && $tokens->[$$indexRef+2] eq ')')
1027         {
1028         $$indexRef += 3;
1029         return 1;
1030         }
1031
1032     else
1033         {  return undef;  };
1034     };
1035
1036
1037 #
1038 #   Function: TryToSkipString
1039 #   If the current position is on a string delimiter, skip past the string and return true.
1040 #
1041 #   Parameters:
1042 #
1043 #       indexRef - A reference to the index of the position to start at.
1044 #       lineNumberRef - A reference to the line number of the position.
1045 #       startContentIndexRef - A reference to the variable in which to store the index of the first content token.  May be undef.
1046 #       endContentIndexRef - A reference to the variable in which to store the index of the end of the content, which is one past
1047 #                                        the last content token.  may be undef.
1048 #
1049 #   Returns:
1050 #
1051 #       Whether the position was at a string.  The index, line number, and content index variabls will only be changed if true.
1052 #
1053 #   Syntax Support:
1054 #
1055 #       - Supports quotes, apostrophes, backticks, q(), qq(), qx(), and qw().
1056 #       - All symbols are supported for the letter forms.
1057 #
1058 sub TryToSkipString #(indexRef, lineNumberRef, startContentIndexRef, endContentIndexRef)
1059     {
1060     my ($self, $indexRef, $lineNumberRef, $startContentIndexRef, $endContentIndexRef) = @_;
1061     my $tokens = $self->Tokens();
1062
1063     # The three string delimiters.  All three are Perl variables when preceded by a dollar sign.
1064     if (!$self->IsStringed($$indexRef) &&
1065         ( $self->SUPER::TryToSkipString($indexRef, $lineNumberRef, '\'', '\'', $startContentIndexRef, $endContentIndexRef) ||
1066           $self->SUPER::TryToSkipString($indexRef, $lineNumberRef, '"', '"', $startContentIndexRef, $endContentIndexRef) ||
1067           $self->SUPER::TryToSkipString($indexRef, $lineNumberRef, '`', '`', $startContentIndexRef, $endContentIndexRef) ) )
1068         {
1069         return 1;
1070         }
1071     elsif ($tokens->[$$indexRef] =~ /^(?:q|qq|qx|qw)$/i &&
1072             ($$indexRef == 0 || $tokens->[$$indexRef - 1] !~ /^[\$\%\@\*]$/))
1073         {
1074         $$indexRef++;
1075
1076         $self->TryToSkipWhitespace($indexRef, $lineNumberRef);
1077
1078         my $openingSymbol = $tokens->[$$indexRef];
1079         my $closingSymbol;
1080
1081         if ($openingSymbol eq '{')
1082             {  $closingSymbol = '}';  }
1083         elsif ($openingSymbol eq '(')
1084             {  $closingSymbol = ')';  }
1085         elsif ($openingSymbol eq '[')
1086             {  $closingSymbol = ']';  }
1087         elsif ($openingSymbol eq '<')
1088             {  $closingSymbol = '>';  }
1089         else
1090             {  $closingSymbol = $openingSymbol;  };
1091
1092         $self->SUPER::TryToSkipString($indexRef, $lineNumberRef, $openingSymbol, $closingSymbol,
1093                                                       $startContentIndexRef, $endContentIndexRef);
1094
1095         return 1;
1096         }
1097     else
1098         {  return undef;  };
1099     };
1100
1101
1102 #
1103 #   Function: TryToSkipHereDocDeclaration
1104 #
1105 #   If the current position is on a Here Doc declaration, add its terminators to <hereDocTerminators> and skip it.
1106 #
1107 #   Syntax Support:
1108 #
1109 #       - Supports <<EOF
1110 #       - Supports << "String" with all string forms supported by <TryToSkipString()>.
1111 #
1112 sub TryToSkipHereDocDeclaration #(indexRef, lineNumberRef)
1113     {
1114     my ($self, $indexRef, $lineNumberRef) = @_;
1115     my $tokens = $self->Tokens();
1116
1117     my $index = $$indexRef;
1118     my $lineNumber = $$lineNumberRef;
1119
1120     if ($tokens->[$index] eq '<' && $tokens->[$index + 1] eq '<')
1121         {
1122         $index += 2;
1123         my $success;
1124
1125         # No whitespace allowed with the bare word.
1126         if ($tokens->[$index] =~ /^[a-z0-9_]/i)
1127             {
1128             push @hereDocTerminators, [ $tokens->[$index] ];
1129             $index++;
1130             $success = 1;
1131             }
1132         else
1133             {
1134             $self->TryToSkipWhitespace(\$index, \$lineNumber);
1135
1136             my ($contentStart, $contentEnd);
1137             if ($self->TryToSkipString(\$index, \$lineNumber, \$contentStart, \$contentEnd))
1138                 {
1139                 push @hereDocTerminators, [ @{$tokens}[$contentStart..$contentEnd - 1] ];
1140                 $success = 1;
1141                 };
1142             };
1143
1144         if ($success)
1145             {
1146             $$indexRef = $index;
1147             $$lineNumberRef = $lineNumber;
1148
1149             return 1;
1150             };
1151         };
1152
1153     return 0;
1154     };
1155
1156
1157 #
1158 #   Function: TryToSkipHereDocContent
1159 #
1160 #   If the current position is at the beginning of a line and there are entries in <hereDocTerminators>, skips lines until all the
1161 #   terminators are exhausted or we reach the end of the file.
1162 #
1163 #   Returns:
1164 #
1165 #       Whether the position was on Here Doc content.
1166 #
1167 sub TryToSkipHereDocContent #(indexRef, lineNumberRef)
1168     {
1169     my ($self, $indexRef, $lineNumberRef) = @_;
1170     my $tokens = $self->Tokens();
1171
1172     # We don't use IsFirstLineToken() because it really needs to be the first line token.  Whitespace is not allowed.
1173     if ($$indexRef > 0 && $tokens->[$$indexRef - 1] eq "\n")
1174         {
1175         my $success = (scalar @hereDocTerminators > 0);
1176
1177         while (scalar @hereDocTerminators && $$indexRef < scalar @$tokens)
1178             {
1179             my $terminatorIndex = 0;
1180
1181             while ($hereDocTerminators[0]->[$terminatorIndex] eq $tokens->[$$indexRef])
1182                 {
1183                 $terminatorIndex++;
1184                 $$indexRef++;
1185                 };
1186
1187             if ($terminatorIndex == scalar @{$hereDocTerminators[0]} &&
1188                 ($tokens->[$$indexRef] eq "\n" || ($tokens->[$$indexRef] =~ /^[ \t]/ && $tokens->[$$indexRef + 1] eq "\n")) )
1189                 {
1190                 shift @hereDocTerminators;
1191                 $$indexRef++;
1192                 $$lineNumberRef++;
1193                 }
1194             else
1195                 {  $self->SkipRestOfLine($indexRef, $lineNumberRef);  };
1196             };
1197
1198         return $success;
1199         }
1200
1201     else
1202         {  return 0;  };
1203     };
1204
1205
1206 #
1207 #   Function: TryToSkipRegexp
1208 #   If the current position is on a regular expression or a quote-like operator, skip past it and return true.
1209 #
1210 #   Syntax Support:
1211 #
1212 #       - Supports //, ??, m//, qr//, s///, tr///, and y///.
1213 #       - All symbols are supported for the letter forms.
1214 #       - ?? is *not* supported because it could cause problems with ?: statements.  The generic parser has a good chance of
1215 #         successfully stumbling through a regex, whereas the regex code will almost certainly see the rest of the file as part of it.
1216 #
1217 sub TryToSkipRegexp #(indexRef, lineNumberRef)
1218     {
1219     my ($self, $indexRef, $lineNumberRef) = @_;
1220     my $tokens = $self->Tokens();
1221
1222     my $isRegexp;
1223
1224     # If it's a supported character sequence that's not a variable (ex $qr) or package (ex a::tr)...
1225     if ($tokens->[$$indexRef] =~ /^(?:m|qr|s|tr|y)$/i &&
1226          ($$indexRef == 0 || $tokens->[$$indexRef - 1] !~ /^[\$\%\@\*\-\>\:]$/) )
1227         {  $isRegexp = 1;  }
1228
1229     elsif ($tokens->[$$indexRef] eq '/' && !$self->IsStringed($$indexRef))
1230         {
1231         # This is a bit of a hack.  If we find a random slash, it could be a divide operator or a bare regexp.  Find the first previous
1232         # non-whitespace token and if it's text, a closing brace, or a string, assume it's a divide operator.  (Strings don't make
1233         # much pratical sense there but a regexp would be impossible.)  Otherwise assume it's a regexp.
1234
1235         # We make a special consideration for split() appearing without parenthesis.  If the previous token is split and it's not a
1236         # variable, assume it is a regexp even though it fails the above test.
1237
1238         my $index = $$indexRef - 1;
1239
1240         while ($index >= 0 && $tokens->[$index] =~ /^(?: |\t|\n)/)
1241             {  $index--;  };
1242
1243         if ($index < 0 || $tokens->[$index] !~ /^[a-zA-Z0-9_\)\]\}\'\"\`]/ ||
1244             ($tokens->[$index] =~ /^split|grep$/ && $index > 0 && $tokens->[$index-1] !~ /^[\$\%\@\*]$/) )
1245             {  $isRegexp = 1;  };
1246         };
1247
1248     if ($isRegexp)
1249         {
1250         my $operator = lc($tokens->[$$indexRef]);
1251         my $index = $$indexRef;
1252         my $lineNumber = $$lineNumberRef;
1253
1254         if ($operator =~ /^[\?\/]/)
1255             {  $operator = 'm';  }
1256         else
1257             {
1258             $index++;
1259
1260             # Believe it or not, s#...# is allowed.  We can't pass over number signs here.
1261             if ($tokens->[$index] ne '#')
1262                 {  $self->TryToSkipWhitespace(\$index, \$lineNumber);  };
1263             };
1264
1265         if ($tokens->[$index] =~ /^\w/)
1266             {  return undef;  };
1267         if ($tokens->[$index] eq '=' && $tokens->[$index+1] eq '>')
1268                 {  return undef;  };
1269
1270         my $openingSymbol = $tokens->[$index];
1271         my $closingSymbol;
1272
1273         if ($openingSymbol eq '{')
1274             {  $closingSymbol = '}';  }
1275         elsif ($openingSymbol eq '(')
1276             {  $closingSymbol = ')';  }
1277         elsif ($openingSymbol eq '[')
1278             {  $closingSymbol = ']';  }
1279         elsif ($openingSymbol eq '<')
1280             {  $closingSymbol = '>';  }
1281         else
1282             {  $closingSymbol = $openingSymbol;  };
1283
1284         $index++;
1285
1286         $self->GenericRegexpSkipUntilAfter(\$index, \$lineNumber, $closingSymbol);
1287
1288         $$indexRef = $index;
1289         $$lineNumberRef = $lineNumber;
1290
1291         if ($operator =~ /^(?:s|tr|y)$/)
1292             {
1293             if ($openingSymbol ne $closingSymbol)
1294                 {
1295                 $self->TryToSkipWhitespace($indexRef, $lineNumberRef);
1296
1297                 $openingSymbol = $tokens->[$index];
1298
1299                 if ($openingSymbol eq '{')
1300                     {  $closingSymbol = '}';  }
1301                 elsif ($openingSymbol eq '(')
1302                     {  $closingSymbol = ')';  }
1303                 elsif ($openingSymbol eq '[')
1304                     {  $closingSymbol = ']';  }
1305                 elsif ($openingSymbol eq '<')
1306                     {  $closingSymbol = '>';  }
1307                 else
1308                     {  $closingSymbol = $openingSymbol;  };
1309
1310                 $$indexRef++;
1311                 };
1312
1313             if ($operator eq 's')
1314                 {
1315                 $self->GenericSkipUntilAfter($indexRef, $lineNumberRef, $closingSymbol, 1);
1316                 }
1317             else # ($operator eq 'tr' || $operator eq 'y')
1318                 {
1319                 while ($$indexRef < scalar @$tokens &&
1320                           ($tokens->[$$indexRef] ne $closingSymbol || $self->IsBackslashed($$indexRef)) )
1321                     {
1322                     if ($tokens->[$$indexRef] eq "\n")
1323                         {  $$lineNumberRef++;  };
1324                     $$indexRef++;
1325                     };
1326
1327                 $$indexRef++;
1328                 };
1329             };
1330
1331         # We want to skip any letters after the regexp.  Otherwise something like tr/a/b/s; could have the trailing s; interpreted
1332         # as another regexp.  Whitespace is not allowed between the closing symbol and the letters.
1333
1334         if ($tokens->[$$indexRef] =~ /^[a-z]/i)
1335             {  $$indexRef++;  };
1336
1337         return 1;
1338         };
1339
1340     return undef;
1341     };
1342
1343
1344
1345 ###############################################################################
1346 # Group: Support Functions
1347
1348
1349 #
1350 #   Function: IsStringed
1351 #
1352 #   Returns whether the position is after a string (dollar sign) character.  Returns false if it's preceded by two dollar signs so
1353 #   "if ($x == $$)" doesn't skip the closing parenthesis as stringed.
1354 #
1355 #   Parameters:
1356 #
1357 #       index - The index of the postition.
1358 #
1359 sub IsStringed #(index)
1360     {
1361     my ($self, $index) = @_;
1362     my $tokens = $self->Tokens();
1363
1364     if ($index > 0 && $tokens->[$index - 1] eq '$' && !($index > 1 && $tokens->[$index - 2] eq '$'))
1365         {  return 1;  }
1366     else
1367         {  return undef;  };
1368     };
1369
1370
1371 1;