examples/includes/HTML-Toc-0.91/TocGenerator.pm

   1 #=== HTML::TocGenerator =======================================================
   2 # function: Generate 'HTML::Toc' table of contents.
   3 # note:     - 'TT' is an abbrevation of 'TocToken'.
   4
   5
   6 package HTML::TocGenerator;
   7
   8
   9 use strict;
  10 use HTML::Parser;
  11
  12
  13 BEGIN {
  14         use vars qw(@ISA $VERSION);
  15
  16         $VERSION = '0.91';
  17
  18         @ISA = qw(HTML::Parser);
  19 }
  20
  21
  22         # Warnings
  23 use constant WARNING_NESTED_ANCHOR_PS_WITHIN_PS               => 1;
  24 use constant WARNING_TOC_ATTRIBUTE_PS_NOT_AVAILABLE_WITHIN_PS => 2;
  25
  26
  27 use constant TOC_TOKEN_ID       => 0;
  28 use constant TOC_TOKEN_INCLUDE  => 1;
  29 use constant TOC_TOKEN_EXCLUDE  => 2;
  30 use constant TOC_TOKEN_TOKENS   => 3;
  31 use constant TOC_TOKEN_GROUP    => 4;
  32 use constant TOC_TOKEN_TOC      => 5;
  33
  34         # Token types
  35 use constant TT_TAG_BEGIN                => 0;
  36 use constant TT_TAG_END                  => 1;
  37 use constant TT_TAG_TYPE_END             => 2;
  38 use constant TT_INCLUDE_ATTRIBUTES_BEGIN => 3;
  39 use constant TT_EXCLUDE_ATTRIBUTES_BEGIN => 4;
  40 use constant TT_INCLUDE_ATTRIBUTES_END   => 5;
  41 use constant TT_EXCLUDE_ATTRIBUTES_END   => 6;
  42 use constant TT_GROUP                    => 7;
  43 use constant TT_TOC                      => 8;
  44 use constant TT_ATTRIBUTES_TOC           => 9;
  45
  46
  47 use constant CONTAINMENT_INCLUDE => 0;
  48 use constant CONTAINMENT_EXCLUDE => 1;
  49
  50 use constant TEMPLATE_ANCHOR            => '$groupId."-".$node';
  51 use constant TEMPLATE_ANCHOR_HREF       =>
  52                                         '"<a href=#".' . TEMPLATE_ANCHOR . '.">"';
  53 use constant TEMPLATE_ANCHOR_HREF_FILE  =>
  54                                         '"<a href=".$file."#".' . TEMPLATE_ANCHOR . '.">"';
  55 use constant TEMPLATE_ANCHOR_NAME       =>
  56                                         '"<a name=".' . TEMPLATE_ANCHOR . '.">"';
  57
  58 use constant TEMPLATE_TOKEN_NUMBER      => '"$node &nbsp"';
  59
  60
  61 use constant TT_TOKENTYPE_START        => 0;
  62 use constant TT_TOKENTYPE_END          => 1;
  63 use constant TT_TOKENTYPE_TEXT         => 2;
  64 use constant TT_TOKENTYPE_COMMENT      => 3;
  65 use constant TT_TOKENTYPE_DECLARATION  => 4;
  66
  67
  68 END {}
  69
  70
  71 #--- HTML::TocGenerator::new() ------------------------------------------------
  72 # function: Constructor
  73
  74 sub new {
  75                 # Get arguments
  76         my ($aType) = @_;
  77         my $self = $aType->SUPER::new;
  78                 # Bias to not generate ToC
  79         $self->{_doGenerateToc} = 0;
  80                 # Bias to not use global groups
  81         $self->{_doUseGroupsGlobal} = 0;
  82                 # Output
  83         $self->{output} = "";
  84                 # Reset internal variables
  85         $self->_resetBatchVariables();
  86
  87         $self->{options} = {};
  88
  89         return $self;
  90 }  # new()
  91
  92
  93 #--- HTML::TocGenerator::_deinitializeBatch() ---------------------------------
  94
  95 sub _deinitializeBatch() {
  96                 # Get arguments
  97         my ($self) = @_;
  98 }  # _deinitializeBatch()
  99
 100
 101 #--- HTML::TocGenerator::_deinitializeExtenderBatch() -------------------------
 102
 103 sub _deinitializeExtenderBatch() {
 104                 # Get arguments
 105         my ($self) = @_;
 106                 # Do general batch deinitialization
 107         $self->_deinitializeBatch();
 108                 # Indicate end of ToC generation
 109         $self->{_doGenerateToc} = 0;
 110                 # Reset batch variables
 111         $self->_resetBatchVariables();
 112 }  # _deinitializeExtenderBatch()
 113
 114
 115 #--- HTML::TocGenerator::_deinitializeGeneratorBatch() ------------------------
 116
 117 sub _deinitializeGeneratorBatch() {
 118                 # Get arguments
 119         my ($self) = @_;
 120                 # Do 'extender' batch deinitialization
 121         $self->_deinitializeExtenderBatch();
 122 }  # _deinitializeBatchGenerator()
 123
 124
 125 #--- HTML::TocGenerator::_doesHashContainHash() -------------------------------
 126 # function: Determines whether hash1 matches regular expressions of hash2.
 127 # args:     - $aHash1
 128 #           - $aHash2
 129 #           - $aContainmentType: 0 (include) or 1 (exclude)
 130 # returns:  True (1) if hash1 satisfies hash2, 0 if not.  For example, with the
 131 #           following hashes:
 132 #
 133 #              %hash1 = {                                                       %hash2 = {
 134 #                 'class' => 'header'                           'class' => '^h'
 135 #                 'id'    => 'intro'         }
 136 #              }
 137 #
 138 #           the routine will return 1 if 'aContainmentType' equals 0, cause
 139 #           'hash1' satisfies the conditions of 'hash2'.  The routine will
 140 #           return 0 if 'aContainmentType' equals 1, cause 'hash1' doesn't
 141 #           exclude the conditions of 'hash2'.
 142 # note:     Class function.
 143
 144 sub _doesHashContainHash {
 145                 # Get arguments
 146         my ($aHash1, $aHash2, $aContainmentType) = @_;
 147                 # Local variables
 148         my ($key1, $value1, $key2, $value2, $result);
 149                 # Bias to success
 150         $result = 1;
 151                 # Loop through hash2
 152         HASH2: while (($key2, $value2) = each %$aHash2) {
 153                 # Yes, values are available;
 154                         # Get value1
 155                 $value1 = $aHash1->{$key2};
 156                         # Does value1 match criteria of value2?
 157                 if (defined($value1) && $value1 =~ m/$value2/) {
 158                         # Yes, value1 matches criteria of value2;
 159                                 # Containment type was exclude?
 160                         if ($aContainmentType == CONTAINMENT_EXCLUDE) {
 161                                 # Yes, containment type was exclude;
 162                                         # Indicate condition fails
 163                                 $result = 0;
 164                                         # Reset 'each' iterator which we're going to break
 165                                 keys %$aHash2;
 166                                         # Break loop
 167                                 last HASH2;
 168                         }
 169                 }
 170                 else {
 171                         # No, value1 didn't match criteria of value2;
 172                                 # Containment type was include?
 173                         if ($aContainmentType == CONTAINMENT_INCLUDE) {
 174                                 # Yes, containment type was include;
 175                                         # Indicate condition fails
 176                                 $result = 0;
 177                                         # Reset 'each' iterator which we're going to break
 178                                 keys %$aHash2;
 179                                         # Break loop
 180                                 last HASH2;
 181                         }
 182                 }
 183         }
 184                 # Return value
 185         return $result;
 186 }  # _doesHashContainHash()
 187
 188
 189 #--- HTML::TocGenerator::_extend() --------------------------------------------
 190 # function: Extend ToC.
 191 #           - $aString: String to parse.
 192
 193 sub _extend {
 194                 # Get arguments
 195         my ($self, $aFile) = @_;
 196                 # Local variables
 197         my ($file);
 198                 # Parse string
 199         $self->parse($aFile);
 200                 # Flush remaining buffered text
 201         $self->eof();
 202 }  # _extend()
 203
 204
 205 #--- HTML::TocGenerator::_extendFromFile() ------------------------------------
 206 # function: Extend ToC.
 207 #           - $aFile: (reference to array of) file to parse.
 208
 209 sub _extendFromFile {
 210                 # Get arguments
 211         my ($self, $aFile) = @_;
 212                 # Local variables
 213         my ($file, @files);
 214                 # Dereference array reference or make array of file specification
 215         @files = (ref($aFile) =~ m/ARRAY/) ? @$aFile : ($aFile);
 216                 # Loop through files
 217         foreach $file (@files) {
 218                         # Store filename
 219                 $self->{_currentFile} = $file;
 220                         # Parse file
 221                 $self->parse_file($file);
 222                         # Flush remaining buffered text
 223                 $self->eof();
 224         }
 225 }  # _extendFromFile()
 226
 227
 228 #--- HTML::TocGenerator::_formatHeadingLevel() --------------------------------
 229 # function: Format heading level.
 230 # args:     - $aLevel: Level of current heading
 231 #           - $aClass: Class of current heading
 232 #           - $aGroup: Group of current heading
 233 #           - $aToc: Toc of current heading
 234
 235 sub _formatHeadingLevel {
 236                 # Get arguments
 237         my ($self, $aLevel, $aClass, $aGroup, $aToc) = @_;
 238                 # Local variables
 239         my ($result, $headingNumber, $numberingStyle);
 240
 241         $headingNumber = $self->_getGroupIdManager($aToc)->
 242                 {levels}{$aClass}[$aLevel - 1] || 0;
 243
 244                 # Alias numbering style of current group
 245         $numberingStyle = $aGroup->{numberingStyle};
 246
 247         SWITCH: {
 248                 if ($numberingStyle eq "decimal") {
 249                         $result = $headingNumber;
 250                         last SWITCH;
 251                 }
 252                 if ($numberingStyle eq "lower-alpha") {
 253                         $result = chr($headingNumber + ord('a') - 1);
 254                         last SWITCH;
 255                 }
 256                 if ($numberingStyle eq "upper-alpha") {
 257                         $result = chr($headingNumber + ord('A') - 1);
 258                         last SWITCH;
 259                 }
 260                 if ($numberingStyle eq "lower-roman") {
 261                         require Roman;
 262                         $result = Roman::roman($headingNumber);
 263                         last SWITCH;
 264                 }
 265                 if ($numberingStyle eq "upper-roman") {
 266                         require Roman;
 267                         $result = Roman::Roman($headingNumber);
 268                         last SWITCH;
 269                 }
 270                 die "Unknown case: $numberingStyle";
 271         }
 272                 # Return value
 273         return $result;
 274 }       # _formatHeadingLevel()
 275
 276
 277 #--- HTML::TocGenerator::_formatTocNode() -------------------------------------
 278 # function: Format heading node.
 279 # args:     - $aLevel: Level of current heading
 280 #           - $aClass: Class of current heading
 281 #           - $aGroup: Group of current heading
 282 #           - $aToc: Toc of current heading
 283
 284 sub _formatTocNode {
 285                 # Get arguments
 286         my ($self, $aLevel, $aClass, $aGroup, $aToc) = @_;
 287                 # Local variables
 288         my ($result, $level, $levelGroups);
 289
 290                 # Alias 'levelGroups' of right 'groupId'
 291         $levelGroups = $aToc->{_levelGroups}{$aGroup->{'groupId'}};
 292                 # Loop through levels
 293         for ($level = 1; $level <= $aLevel; $level++) {
 294                         # If not first level, add dot
 295                 $result = ($result ? $result . "." : $result);
 296                         # Format heading level using argument group
 297                 $result .= $self->_formatHeadingLevel(
 298                         $level, $aClass, @{$levelGroups}[$level - 1], $aToc
 299                 );
 300         }
 301                 # Return value
 302         return $result;
 303 }  # _formatTocNode()
 304
 305
 306 #--- HTML::TocGenerator::_generate() ------------------------------------------
 307 # function: Generate ToC.
 308 # args:     - $aString: Reference to string to parse
 309
 310 sub _generate {
 311                 # Get arguments
 312         my ($self, $aString) = @_;
 313                 # Local variables
 314         my ($toc);
 315                 # Loop through ToCs
 316         foreach $toc (@{$self->{_tocs}}) {
 317                         # Clear ToC
 318                 $toc->clear();
 319         }
 320                 # Extend ToCs
 321         $self->_extend($aString);
 322 }  # _generate()
 323
 324
 325 #--- HTML::TocGenerator::_generateFromFile() ----------------------------------
 326 # function: Generate ToC.
 327 # args:     - $aFile: (reference to array of) file to parse.
 328
 329 sub _generateFromFile {
 330                 # Get arguments
 331         my ($self, $aFile) = @_;
 332                 # Local variables
 333         my ($toc);
 334                 # Loop through ToCs
 335         foreach $toc (@{$self->{_tocs}}) {
 336                         # Clear ToC
 337                 $toc->clear();
 338         }
 339                 # Extend ToCs
 340         $self->_extendFromFile($aFile);
 341 }  # _generateFromFile()
 342
 343
 344 #--- HTML::TocGenerator::_getGroupIdManager() ---------------------------------
 345 # function: Get group id manager.
 346 # args:     - $aToc: Active ToC.
 347 # returns:  Group id levels.
 348
 349 sub _getGroupIdManager {
 350                 # Get arguments
 351         my ($self, $aToc) = @_;
 352                 # Local variables
 353         my ($result);
 354                 # Global groups?
 355         if ($self->{options}{'doUseGroupsGlobal'}) {
 356                 # Yes, global groups;
 357                 $result = $self;
 358         }
 359         else {
 360                 # No, local groups;
 361                 $result = $aToc;
 362         }
 363                 # Return value
 364         return $result;
 365 }  # _getGroupIdManager()
 366
 367
 368 #--- HTML::TocGenerator::_initializeBatch() -----------------------------------
 369 # function: Initialize batch.  This function is called once when a parse batch
 370 #           is started.
 371 # args:     - $aTocs: Reference to array of tocs.
 372
 373 sub _initializeBatch {
 374                 # Get arguments
 375         my ($self, $aTocs) = @_;
 376                 # Local variables
 377         my ($toc);
 378
 379                 # Store reference to tocs
 380
 381                 # Is ToC specification reference to array?
 382         if (ref($aTocs) =~ m/ARRAY/) {
 383                 # Yes, ToC specification is reference to array;
 384                         # Store array reference
 385                 $self->{_tocs} = $aTocs;
 386         }
 387         else {
 388                 # No, ToC specification is reference to ToC object;
 389                         # Wrap reference in array reference, containing only one element
 390                 $self->{_tocs} = [$aTocs];
 391         }
 392                 # Loop through ToCs
 393         foreach $toc (@{$self->{_tocs}}) {
 394                         # Parse ToC options
 395                 $toc->parseOptions();
 396         }
 397 }  # _initializeBatch()
 398
 399
 400 #--- HTML::TocGenerator::_initializeExtenderBatch() --------------------------
 401 # function: Initialize 'extender' batch.  This function is called once when a
 402 #           parse batch is started.
 403 # args:     - $aTocs: Reference to array of tocs.
 404
 405 sub _initializeExtenderBatch {
 406                 # Get arguments
 407         my ($self, $aTocs) = @_;
 408                 # Do general batch initialization
 409         $self->_initializeBatch($aTocs);
 410                 # Parse ToC options
 411         $self->_parseTocOptions();
 412                 # Indicate start of batch
 413         $self->{_doGenerateToc} = 1;
 414 }  # _initializeExtenderBatch()
 415
 416
 417 #--- HTML::TocGenerator::_initializeGeneratorBatch() --------------------------
 418 # function: Initialize generator batch.  This function is called once when a
 419 #           parse batch is started.
 420 # args:     - $aTocs: Reference to array of tocs.
 421 #           - $aOptions: optional options
 422
 423 sub _initializeGeneratorBatch {
 424                 # Get arguments
 425         my ($self, $aTocs, $aOptions) = @_;
 426                 # Add invocation options
 427         $self->setOptions($aOptions);
 428                 # Option 'doUseGroupsGlobal' specified?
 429         if (!defined($self->{options}{'doUseGroupsGlobal'})) {
 430                 # No, options 'doUseGroupsGlobal' not specified;
 431                         # Default to no 'doUseGroupsGlobal'
 432                 $self->{options}{'doUseGroupsGlobal'} = 0;
 433         }
 434                 # Global groups?
 435         if ($self->{options}{'doUseGroupsGlobal'}) {
 436                 # Yes, global groups;
 437                         # Reset groups and levels
 438                 $self->_resetStackVariables();
 439         }
 440                 # Do 'extender' batch initialization
 441         $self->_initializeExtenderBatch($aTocs);
 442 }  # _initializeGeneratorBatch()
 443
 444
 445 #--- HTML::TocGenerator::_linkTocToToken() ------------------------------------
 446 # function: Link ToC to token.
 447 # args:     - $aToc: ToC to add token to.
 448 #           - $aFile
 449 #           - $aGroupId
 450 #           - $aLevel
 451 #           - $aNode
 452 #           - $aGroupLevel
 453 #           - $aLinkType
 454 #           - $aTokenAttributes: reference to hash containing attributes of
 455 #                currently parsed token
 456
 457 sub _linkTocToToken {
 458                 # Get arguments
 459         my (
 460                 $self, $aToc, $aFile, $aGroupId, $aLevel, $aNode, $aGroupLevel,
 461                 $aDoLinkToId, $aTokenAttributes
 462         ) = @_;
 463                 # Local variables
 464         my ($file, $groupId, $level, $node, $anchorName);
 465         my ($doInsertAnchor, $doInsertId);
 466
 467                 # Fill local arguments to be used by templates
 468         $file    = $aFile;
 469         $groupId = $aGroupId;
 470         $level   = $aLevel;
 471         $node    = $aNode;
 472
 473                 # Assemble anchor name
 474         $anchorName =
 475                 ref($aToc->{_templateAnchorName}) eq "CODE" ?
 476                         &{$aToc->{_templateAnchorName}}(
 477                                 $aFile, $aGroupId, $aLevel, $aNode
 478                         ) :
 479                         eval($aToc->{_templateAnchorName});
 480
 481                 # Bias to insert anchor name
 482         $doInsertAnchor = 1;
 483         $doInsertId     = 0;
 484                 # Link to 'id'?
 485         if ($aDoLinkToId) {
 486                 # Yes, link to 'id';
 487                         # Indicate to insert anchor id
 488                 $doInsertAnchor = 0;
 489                 $doInsertId     = 1;
 490                         # Id attribute is available?
 491                 if (defined($aTokenAttributes->{id})) {
 492                         # Yes, id attribute is available;
 493                                 # Use existing ids?
 494                         if ($aToc->{options}{'doUseExistingIds'}) {
 495                                 # Yes, use existing ids;
 496                                         # Use existing id
 497                                 $anchorName = $aTokenAttributes->{id};
 498                                         # Indicate to not insert id
 499                                 $doInsertId = 0;
 500                         }
 501                 }
 502
 503         }
 504         else {
 505                 # No, link to 'name';
 506                         # Anchor name is currently active?
 507                 if (defined($self->{_activeAnchorName})) {
 508                         # Yes, anchor name is currently active;
 509                                 # Use existing anchors?
 510                         if ($aToc->{options}{'doUseExistingAnchors'}) {
 511                                 # Yes, use existing anchors;
 512                                         # Use existing anchor name
 513                                 $anchorName = $self->{_activeAnchorName};
 514                                         # Indicate to not insert anchor name
 515                                 $doInsertAnchor = 0;
 516                         }
 517                         else {
 518                                 # No, don't use existing anchors; insert new anchor;
 519                                         #
 520                         }
 521                 }
 522         }
 523
 524                 # Add reference to ToC
 525         $aToc->{_toc} .=
 526                 ref($aToc->{_templateAnchorHrefBegin}) eq "CODE" ?
 527                         &{$aToc->{_templateAnchorHrefBegin}}(
 528                                 $aFile, $aGroupId, $aLevel, $aNode, $anchorName
 529                         ) :
 530                         eval($aToc->{_templateAnchorHrefBegin});
 531
 532                 # Bias to not output anchor name end
 533         $self->{_doOutputAnchorNameEnd} = 0;
 534                 # Must anchor be inserted?
 535         if ($doInsertAnchor) {
 536                 # Yes, anchor must be inserted;
 537                         # Allow adding of anchor name begin token to text by calling
 538                         # 'anchorNameBegin' method
 539                 $self->anchorNameBegin(
 540                         ref($aToc->{_templateAnchorNameBegin}) eq "CODE" ?
 541                                 &{$aToc->{_templateAnchorNameBegin}}(
 542                                         $aFile, $aGroupId, $aLevel, $aNode, $anchorName
 543                                 ) :
 544                                 eval($aToc->{_templateAnchorNameBegin}),
 545                         $aToc
 546                 );
 547         }
 548
 549                 # Must anchorId attribute be inserted?
 550         if ($doInsertId) {
 551                 # Yes, anchorId attribute must be inserted;
 552                         # Allow adding of anchorId attribute to text by calling 'anchorId'
 553                         # method
 554                 $self->anchorId($anchorName);
 555         }
 556 }  # _linkTocToToken()
 557
 558
 559 #--- HTML::TocGenerator::_outputAnchorNameEndConditionally() ------------------
 560 # function: Output 'anchor name end' if necessary
 561 # args:     - $aToc: ToC of which 'anchor name end' must be output.
 562
 563 sub _outputAnchorNameEndConditionally {
 564                 # Get arguments
 565         my ($self, $aToc) = @_;
 566                 # Must anchor name end be output?
 567         if ($self->{_doOutputAnchorNameEnd}) {
 568                 # Yes, output anchor name end;
 569                         # Allow adding of anchor to text by calling 'anchorNameEnd'
 570                         # method
 571                 $self->anchorNameEnd(
 572                         ref($aToc->{_templateAnchorNameEnd}) eq "CODE" ?
 573                                 &{$aToc->{_templateAnchorNameEnd}} :
 574                                 eval($aToc->{_templateAnchorNameEnd}),
 575                         $aToc
 576                 );
 577         }
 578 }  # _outputAnchorNameEndConditionally()
 579
 580
 581 #--- HTML::TocGenerator::_parseTocOptions() -----------------------------------
 582 # function: Parse ToC options.
 583
 584 sub _parseTocOptions {
 585                 # Get arguments
 586         my ($self) = @_;
 587                 # Local variables
 588         my ($toc, $group, $tokens, $tokenType, $i);
 589                 # Create parsers for ToC tokens
 590         $self->{_tokensTocBegin} = [];
 591         my $tokenTocBeginParser = HTML::_TokenTocBeginParser->new(
 592                 $self->{_tokensTocBegin}
 593         );
 594         my $tokenTocEndParser = HTML::_TokenTocEndParser->new();
 595                 # Loop through ToCs
 596         foreach $toc (@{$self->{_tocs}}) {
 597                         # Reference parser ToC to current ToC
 598                 $tokenTocBeginParser->setToc($toc);
 599                         # Loop through 'tokenToToc' groups
 600                 foreach $group (@{$toc->{options}{'tokenToToc'}}) {
 601                                 # Reference parser group to current group
 602                         $tokenTocBeginParser->setGroup($group);
 603                                 # Parse 'tokenToToc' group
 604                         $tokenTocBeginParser->parse($group->{'tokenBegin'});
 605                                 # Flush remaining buffered text
 606                         $tokenTocBeginParser->eof();
 607                         $tokenTocEndParser->parse(
 608                                 $group->{'tokenEnd'},
 609                                 $tokenTocBeginParser->{_lastAddedToken},
 610                                 $tokenTocBeginParser->{_lastAddedTokenType}
 611                         );
 612                                 # Flush remaining buffered text
 613                         $tokenTocEndParser->eof();
 614                 }
 615         }
 616 }  # _parseTocOptions()
 617
 618
 619 #--- HTML::TocGenerator::_processTocEndingToken() -----------------------------
 620 # function: Process ToC-ending-token.
 621 # args:     - $aTocToken: token which acts as ToC-ending-token.
 622
 623 sub _processTocEndingToken {
 624                 # Get arguments
 625         my ($self, $aTocToken) = @_;
 626                 # Local variables
 627         my ($toc);
 628                 # Aliases
 629         $toc = $aTocToken->[TT_TOC];
 630                 # Link ToC to tokens?
 631         if ($toc->{options}{'doLinkToToken'}) {
 632                 # Yes, link ToC to tokens;
 633                         # Add anchor href end
 634                 $toc->{_toc} .=
 635                         (ref($toc->{_templateAnchorHrefEnd}) eq "CODE") ?
 636                                 &{$toc->{_templateAnchorHrefEnd}} :
 637                                 eval($toc->{_templateAnchorHrefEnd});
 638
 639                         # Output anchor name end only if necessary
 640                 $self->_outputAnchorNameEndConditionally($toc);
 641         }
 642 }  # _processTocEndingToken()
 643
 644
 645 #--- HTML::TocGenerator::_processTocStartingToken() ---------------------------
 646 # function: Process ToC-starting-token.
 647 # args:     - $aTocToken: token which acts as ToC-starting-token.
 648 #           - $aTokenType: type of token.  Can be either TT_TOKENTYPE_START,
 649 #                _END, _TEXT, _COMMENT or _DECLARATION.
 650 #           - $aTokenAttributes: reference to hash containing attributes of
 651 #                currently parsed token
 652 #           - $aTokenOrigText: reference to original token text
 653
 654 sub _processTocStartingToken {
 655                 # Get arguments
 656         my ($self, $aTocToken, $aTokenType, $aTokenAttributes, $aTokenOrigText) = @_;
 657                 # Local variables
 658         my ($i, $level, $doLinkToId, $node, $groupLevel);
 659         my ($file, $tocTokenId, $groupId, $toc, $attribute);
 660                 # Aliases
 661         $file        = $self->{_currentFile};
 662         $toc                = $aTocToken->[TT_TOC];
 663         $level      = $aTocToken->[TT_GROUP]{'level'};
 664         $groupId            = $aTocToken->[TT_GROUP]{'groupId'};
 665
 666                 # Retrieve 'doLinkToId' setting from either group options or toc options
 667         $doLinkToId = (defined($aTocToken->[TT_GROUP]{'doLinkToId'})) ?
 668                 $aTocToken->[TT_GROUP]{'doLinkToId'} : $toc->{options}{'doLinkToId'};
 669
 670                 # Link to 'id' and tokenType isn't 'start'?
 671         if (($doLinkToId) && ($aTokenType != TT_TOKENTYPE_START)) {
 672                 # Yes, link to 'id' and tokenType isn't 'start';
 673                         # Indicate to *not* link to 'id'
 674                 $doLinkToId = 0;
 675         }
 676
 677         if (ref($level) eq "CODE") {
 678                 $level = &$level($self->{_currentFile}, $node);
 679         }
 680         if (ref($groupId) eq "CODE") {
 681                 $groupId = &$groupId($self->{_currentFile}, $node);
 682         }
 683
 684                 # Determine class level
 685
 686         my $groupIdManager = $self->_getGroupIdManager($toc);
 687                 # Known group?
 688         if (!exists($groupIdManager->{groupIdLevels}{$groupId})) {
 689                 # No, unknown group;
 690                         # Add group
 691                 $groupIdManager->{groupIdLevels}{$groupId} = keys(
 692                         %{$groupIdManager->{groupIdLevels}}
 693                 ) + 1;
 694         }
 695         $groupLevel = $groupIdManager->{groupIdLevels}{$groupId};
 696
 697                 # Temporarily allow symbolic references
 698         #no strict qw(refs);
 699                 # Increase level
 700         $groupIdManager->{levels}{$groupId}[$level - 1] += 1;
 701                 # Reset remaining levels of same group
 702         for ($i = $level; $i < @{$groupIdManager->{levels}{$groupId}}; $i++) {
 703                 $groupIdManager->{levels}{$groupId}[$i] = 0;
 704         }
 705
 706                 # Assemble numeric string indicating current level
 707         $node = $self->_formatTocNode(
 708                 $level, $groupId, $aTocToken->[TT_GROUP], $toc
 709         );
 710
 711                 # Add newline if _toc not empty
 712         if ($toc->{_toc}) {
 713                 $toc->{_toc} .= "\n";
 714         }
 715
 716                 # Add toc item info
 717         $toc->{_toc} .= "$level $groupLevel $groupId $node " .
 718                 $groupIdManager->{levels}{$groupId}[$level - 1] . " ";
 719
 720                 # Add value of 'id' attribute if available
 721         if (defined($aTokenAttributes->{id})) {
 722                 $toc->{_toc} .= $aTokenAttributes->{id};
 723         }
 724         $toc->{_toc} .= " ";
 725                 # Link ToC to tokens?
 726         if ($toc->{options}{'doLinkToToken'}) {
 727                 # Yes, link ToC to tokens;
 728                         # Link ToC to token
 729                 $self->_linkTocToToken(
 730                         $toc, $file, $groupId, $level, $node, $groupLevel, $doLinkToId,
 731                         $aTokenAttributes
 732                 );
 733         }
 734
 735                 # Number tokens?
 736         if (
 737                 $aTocToken->[TT_GROUP]{'doNumberToken'} ||
 738                 (
 739                         ! defined($aTocToken->[TT_GROUP]{'doNumberToken'}) &&
 740                         $toc->{options}{'doNumberToken'}
 741                 )
 742         ) {
 743                 # Yes, number tokens;
 744                         # Add number by calling 'number' method
 745                 $self->number(
 746                         ref($toc->{_templateTokenNumber}) eq "CODE" ?
 747                                 &{$toc->{_templateTokenNumber}}(
 748                                         $node, $groupId, $file, $groupLevel, $level, $toc
 749                                 ) :
 750                                 eval($toc->{_templateTokenNumber}),
 751                         $toc
 752                 );
 753         }
 754
 755                 # Must attribute be used as ToC text?
 756         if (defined($aTocToken->[TT_ATTRIBUTES_TOC])) {
 757                 # Yes, attribute must be used as ToC text;
 758                         # Loop through attributes
 759                 foreach $attribute (@{$aTocToken->[TT_ATTRIBUTES_TOC]}) {
 760                                 # Attribute is available?
 761                         if (defined($$aTokenAttributes{$attribute})) {
 762                                 # Yes, attribute is available;
 763                                         # Add attribute value to ToC
 764                                 $self->_processTocText($$aTokenAttributes{$attribute}, $toc);
 765                         }
 766                         else {
 767                                 # No, attribute isn't available;
 768                                         # Show warning
 769                                 $self->_showWarning(
 770                                         WARNING_TOC_ATTRIBUTE_PS_NOT_AVAILABLE_WITHIN_PS,
 771                                         [$attribute, $$aTokenOrigText]
 772                                 );
 773                         }
 774                                 # Output anchor name end only if necessary
 775                         #$self->_outputAnchorNameEndConditionally($toc);
 776                                 # End attribute
 777                         $self->_processTocEndingToken($aTocToken);
 778                 }
 779         }
 780         else {
 781                 # No, attribute mustn't be used as ToC text;
 782                         # Add end token to 'end token array'
 783                 push(
 784                         @{$self->{_tokensTocEnd}[$aTocToken->[TT_TAG_TYPE_END]]}, $aTocToken
 785                 );
 786         }
 787 }  # _processTocStartingToken()
 788
 789
 790 #--- HTML::TocGenerator::_processTocText() ------------------------------------
 791 # function: This function processes text which must be added to the preliminary
 792 #           ToC.
 793 # args:     - $aText: Text to add to ToC.
 794 #           - $aToc: ToC to add text to.
 795
 796 sub _processTocText {
 797                 # Get arguments
 798         my ($self, $aText, $aToc) = @_;
 799                 # Add text to ToC
 800         $aToc->{_toc} .= $aText;
 801 }  # _processTocText()
 802
 803
 804 #--- HTML::TocGenerator::_processTokenAsTocEndingToken() ----------------------
 805 # function: Check for token being a token to use for triggering the end of
 806 #           a ToC line and process it accordingly.
 807 # args:     - $aTokenType: type of token: 'start', 'end', 'comment' or 'text'.
 808 #           - $aTokenId: token id of currently parsed token
 809
 810 sub _processTokenAsTocEndingToken {
 811                 # Get arguments
 812         my ($self, $aTokenType, $aTokenId) = @_;
 813                 # Local variables
 814         my ($i, $tokenId, $toc, $tokens);
 815                 # Loop through dirty start tokens
 816         $i = 0;
 817
 818                 # Alias token array of right type
 819         $tokens = $self->{_tokensTocEnd}[$aTokenType];
 820                 # Loop through token array
 821         while ($i < scalar @$tokens) {
 822                         # Aliases
 823                 $tokenId = $tokens->[$i][TT_TAG_END];
 824                         # Does current end tag equals dirty tag?
 825                 if ($aTokenId eq $tokenId) {
 826                         # Yes, current end tag equals dirty tag;
 827                                 # Process ToC-ending-token
 828                         $self->_processTocEndingToken($tokens->[$i]);
 829                                 # Remove dirty tag from array, automatically advancing to
 830                                 # next token
 831                         splice(@$tokens, $i, 1);
 832                 }
 833                 else {
 834                         # No, current end tag doesn't equal dirty tag;
 835                                 # Advance to next token
 836                         $i++;
 837                 }
 838         }
 839 }  # _processTokenAsTocEndingToken()
 840
 841
 842 #--- HTML::TocGenerator::_processTokenAsTocStartingToken() --------------------
 843 # function: Check for token being a ToC-starting-token and process it
 844 #           accordingly.
 845 # args:     - $aTokenType: type of token.  Can be either TT_TOKENTYPE_START,
 846 #                _END, _TEXT, _COMMENT or _DECLARATION.
 847 #           - $aTokenId: token id of currently parsed token
 848 #           - $aTokenAttributes: reference to hash containing attributes of
 849 #                currently parsed token
 850 #           - $aTokenOrigText: reference to original text of token
 851 # returns:  1 if successful, i.e. token is processed as ToC-starting-token, 0
 852 #           if not.
 853
 854 sub _processTokenAsTocStartingToken {
 855                 # Get arguments
 856         my ($self, $aTokenType, $aTokenId, $aTokenAttributes, $aTokenOrigText) = @_;
 857                 # Local variables
 858         my ($level, $levelToToc, $groupId, $groupToToc);
 859         my ($result, $tocToken, $tagBegin, @tokensTocBegin, $fileSpec);
 860                 # Bias to token not functioning as ToC-starting-token
 861         $result = 0;
 862                 # Loop through start tokens of right type
 863         foreach $tocToken (@{$self->{_tokensTocBegin}[$aTokenType]}) {
 864                         # Alias file filter
 865                 $fileSpec = $tocToken->[TT_GROUP]{'fileSpec'};
 866                         # File matches?
 867                 if (!defined($fileSpec) || (
 868                         defined($fileSpec) &&
 869                         ($self->{_currentFile} =~ m/$fileSpec/)
 870                 )) {
 871                         # Yes, file matches;
 872                                 # Alias tag begin
 873                         $tagBegin = $tocToken->[TT_TAG_BEGIN];
 874                                 # Tag and attributes match?
 875                         if (
 876                                 defined($tagBegin) &&
 877                                 ($aTokenId =~ m/$tagBegin/) &&
 878                                 HTML::TocGenerator::_doesHashContainHash(
 879                                         $aTokenAttributes, $tocToken->[TT_INCLUDE_ATTRIBUTES_BEGIN], 0
 880                                 ) &&
 881                                 HTML::TocGenerator::_doesHashContainHash(
 882                                         $aTokenAttributes, $tocToken->[TT_EXCLUDE_ATTRIBUTES_BEGIN], 1
 883                                 )
 884                         ) {
 885                                 # Yes, tag and attributes match;
 886                                         # Aliases
 887                                 $level      = $tocToken->[TT_GROUP]{'level'};
 888                                 $levelToToc = $tocToken->[TT_TOC]{options}{'levelToToc'};
 889                                 $groupId     = $tocToken->[TT_GROUP]{'groupId'};
 890                                 $groupToToc = $tocToken->[TT_TOC]{options}{'groupToToc'};
 891                                         # Must level and group be processed?
 892                                 if (
 893                                         ($level =~ m/$levelToToc/) &&
 894                                         ($groupId =~ m/$groupToToc/)
 895                                 ) {
 896                                         # Yes, level and group must be processed;
 897                                                 # Indicate token acts as ToC-starting-token
 898                                         $result = 1;
 899                                                 # Process ToC-starting-token
 900                                         $self->_processTocStartingToken(
 901                                                 $tocToken, $aTokenType, $aTokenAttributes, $aTokenOrigText
 902                                         );
 903                                 }
 904                         }
 905                 }
 906         }
 907                 # Return value
 908         return $result;
 909 }  # _processTokenAsTocStartingToken()
 910
 911
 912 #--- HTML::TocGenerator::_resetBatchVariables() -------------------------------
 913 # function: Reset variables which are set because of batch invocation.
 914
 915 sub _resetBatchVariables {
 916                 # Get arguments
 917         my ($self) = @_;
 918
 919                 # Filename of current file being parsed, empty string if not available
 920         $self->{_currentFile} = "";
 921                 # Arrays containing start, end, comment, text & declaration tokens which
 922                 # must trigger the ToC assembling.  Each array element may contain a
 923                 # reference to an array containing the following elements:
 924                 #
 925       #    TT_TAG_BEGIN                => 0;
 926       #    TT_TAG_END                  => 1;
 927       #    TT_TAG_TYPE_END             => 2;
 928       #    TT_INCLUDE_ATTRIBUTES_BEGIN => 3;
 929       #    TT_EXCLUDE_ATTRIBUTES_BEGIN => 4;
 930       #    TT_INCLUDE_ATTRIBUTES_END   => 5;
 931       #    TT_EXCLUDE_ATTRIBUTES_END   => 6;
 932       #    TT_GROUP                    => 7;
 933       #    TT_TOC                      => 8;
 934                 #    TT_ATTRIBUTES_TOC           => 9;
 935                 #
 936         $self->{_tokensTocBegin} = [
 937                 [],  # TT_TOKENTYPE_START
 938                 [],  # TT_TOKENTYPE_END
 939                 [],  # TT_TOKENTYPE_COMMENT
 940                 [],  # TT_TOKENTYPE_TEXT
 941                 []   # TT_TOKENTYPE_DECLARATION
 942         ];
 943         $self->{_tokensTocEnd} = [
 944                 [],  # TT_TOKENTYPE_START
 945                 [],  # TT_TOKENTYPE_END
 946                 [],  # TT_TOKENTYPE_COMMENT
 947                 [],  # TT_TOKENTYPE_TEXT
 948                 []   # TT_TOKENTYPE_DECLARATION
 949         ];
 950                 # TRUE if ToCs have been initialized, FALSE if not.
 951         $self->{_doneInitializeTocs} = 0;
 952                 # Array of ToCs to process
 953         $self->{_tocs} = [];
 954                 # Active anchor name
 955         $self->{_activeAnchorName} = undef;
 956 }  # _resetBatchVariables()
 957
 958
 959 #--- HTML::TocGenerator::_resetStackVariables() -------------------------------
 960 # function: Reset variables which cumulate during ToC generation.
 961
 962 sub _resetStackVariables {
 963                 # Get arguments
 964         my ($self) = @_;
 965                 # Reset variables
 966         $self->{levels}        = undef;
 967         $self->{groupIdLevels} = undef;
 968 }  # _resetStackVariables()
 969
 970
 971 #--- HTML::TocGenerator::_setActiveAnchorName() -------------------------------
 972 # function: Set active anchor name.
 973 # args:     - aAnchorName: Name of anchor name to set active.
 974
 975 sub _setActiveAnchorName {
 976                 # Get arguments
 977         my ($self, $aAnchorName) = @_;
 978                 # Set active anchor name
 979         $self->{_activeAnchorName} = $aAnchorName;
 980 }  # _setActiveAnchorName()
 981
 982
 983 #--- HTML::TocGenerator::_showWarning() ---------------------------------------
 984 # function: Show warning.
 985 # args:     - aWarningNr: Number of warning to show.
 986 #           - aWarningArgs: Arguments to display within the warning.
 987
 988 sub _showWarning {
 989                 # Get arguments
 990         my ($self, $aWarningNr, $aWarningArgs) = @_;
 991                 # Local variables
 992         my (%warnings);
 993                 # Set warnings
 994         %warnings = (
 995                 WARNING_NESTED_ANCHOR_PS_WITHIN_PS()               =>
 996                         "Nested anchor '%s' within anchor '%s'.",
 997                 WARNING_TOC_ATTRIBUTE_PS_NOT_AVAILABLE_WITHIN_PS() =>
 998                         "ToC attribute '%s' not available within token '%s'.",
 999         );
1000                 # Show warning
1001         print STDERR "warning ($aWarningNr): " . sprintf($warnings{"$aWarningNr"}, @$aWarningArgs) . "\n";
1002 }  # _showWarning()
1003
1004
1005 #--- HTML::TocGenerator::anchorId() -------------------------------------------
1006 # function: Anchor id processing method.  Leave it up to the descendant to do
1007 #           something useful with it.
1008 # args:     - $aAnchorId
1009 #           - $aToc: Reference to ToC to which anchorId belongs.
1010
1011 sub anchorId {
1012 }  # anchorId()
1013
1014
1015 #--- HTML::TocGenerator::anchorNameBegin() ------------------------------------
1016 # function: Anchor name begin processing method.  Leave it up to the descendant
1017 #           to do something useful with it.
1018 # args:     - $aAnchorName
1019 #           - $aToc: Reference to ToC to which anchorname belongs.
1020
1021 sub anchorNameBegin {
1022 }  # anchorNameBegin()
1023
1024
1025 #--- HTML::TocGenerator::anchorNameEnd() --------------------------------------
1026 # function: Anchor name end processing method.  Leave it up to the descendant
1027 #           to do something useful with it.
1028 # args:     - $aAnchorName
1029 #           - $aToc: Reference to ToC to which anchorname belongs.
1030
1031 sub anchorNameEnd {
1032 }  # anchorNameEnd()
1033
1034
1035 #--- HTML::TocGenerator::comment() --------------------------------------------
1036 # function: Process comment.
1037 # args:     - $aComment: comment text with '<!--' and '-->' tags stripped off.
1038
1039 sub comment {
1040                 # Get arguments
1041         my ($self, $aComment) = @_;
1042                 # Must a ToC be generated?
1043         if ($self->{_doGenerateToc}) {
1044                 # Yes, a ToC must be generated
1045                         # Process end tag as ToC-starting-token
1046                 $self->_processTokenAsTocStartingToken(
1047                         TT_TOKENTYPE_COMMENT, $aComment, undef, \$aComment
1048                 );
1049                         # Process end tag as token which ends ToC registration
1050                 $self->_processTokenAsTocEndingToken(
1051                         TT_TOKENTYPE_COMMENT, $aComment
1052                 );
1053         }
1054 }  # comment()
1055
1056
1057 #--- HTML::TocGenerator::end() ------------------------------------------------
1058 # function: This function is called every time a closing tag is encountered.
1059 # args:     - $aTag: tag name (in lower case).
1060 #           - $aOrigText: tag name including brackets.
1061
1062 sub end {
1063                 # Get arguments
1064         my ($self, $aTag, $aOrigText) = @_;
1065                 # Local variables
1066         my ($tag, $toc, $i);
1067                 # Must a ToC be generated?
1068         if ($self->{_doGenerateToc}) {
1069                 # Yes, a ToC must be generated
1070                         # Process end tag as ToC-starting-token
1071                 $self->_processTokenAsTocStartingToken(
1072                         TT_TOKENTYPE_END, $aTag, undef, \$aOrigText
1073                 );
1074                         # Process end tag as ToC-ending-token
1075                 $self->_processTokenAsTocEndingToken(
1076                         TT_TOKENTYPE_END, $aTag
1077                 );
1078                         # Tag is of type 'anchor'?
1079                 if (defined($self->{_activeAnchorName}) && ($aTag eq "a")) {
1080                         # Yes, tag is of type 'anchor';
1081                                 # Reset dirty anchor
1082                         $self->{_activeAnchorName} = undef;
1083                 }
1084         }
1085 }  # end()
1086
1087
1088 #--- HTML::TocGenerator::extend() ---------------------------------------------
1089 # function: Extend ToCs.
1090 # args:     - $aTocs: Reference to array of ToC objects
1091 #           - $aString: String to parse.
1092
1093 sub extend {
1094                 # Get arguments
1095         my ($self, $aTocs, $aString) = @_;
1096                 # Initialize TocGenerator batch
1097         $self->_initializeExtenderBatch($aTocs);
1098                 # Extend ToCs
1099         $self->_extend($aString);
1100                 # Deinitialize TocGenerator batch
1101         $self->_deinitializeExtenderBatch();
1102 }  # extend()
1103
1104
1105 #--- HTML::TocGenerator::extendFromFile() -------------------------------------
1106 # function: Extend ToCs.
1107 # args:     - @aTocs: Reference to array of ToC objects
1108 #           - @aFiles: Reference to array of files to parse.
1109
1110 sub extendFromFile {
1111                 # Get arguments
1112         my ($self, $aTocs, $aFiles) = @_;
1113                 # Initialize TocGenerator batch
1114         $self->_initializeExtenderBatch($aTocs);
1115                 # Extend ToCs
1116         $self->_extendFromFile($aFiles);
1117                 # Deinitialize TocGenerator batch
1118         $self->_deinitializeExtenderBatch();
1119 }  # extendFromFile()
1120
1121
1122 #--- HTML::TocGenerator::generate() -------------------------------------------
1123 # function: Generate ToC.
1124 # args:     - $aToc: Reference to (array of) ToC object(s)
1125 #           - $aString: Reference to string to parse
1126 #           - $aOptions: optional options
1127
1128 sub generate {
1129                 # Get arguments
1130         my ($self, $aToc, $aString, $aOptions) = @_;
1131                 # Initialize TocGenerator batch
1132         $self->_initializeGeneratorBatch($aToc, $aOptions);
1133                 # Do generate ToC
1134         $self->_generate($aString);
1135                 # Deinitialize TocGenerator batch
1136         $self->_deinitializeGeneratorBatch();
1137 }  # generate()
1138
1139
1140 #--- HTML::TocGenerator::generateFromFile() -----------------------------------
1141 # function: Generate ToC.
1142 # args:     - $aToc: Reference to (array of) ToC object(s)
1143 #           - $aFile: (reference to array of) file to parse.
1144 #           - $aOptions: optional options
1145
1146 sub generateFromFile {
1147                 # Get arguments
1148         my ($self, $aToc, $aFile, $aOptions) = @_;
1149                 # Initialize TocGenerator batch
1150         $self->_initializeGeneratorBatch($aToc, $aOptions);
1151                 # Do generate ToC
1152         $self->_generateFromFile($aFile);
1153                 # Deinitialize TocGenerator batch
1154         $self->_deinitializeGeneratorBatch();
1155 }  # generateFromFile()
1156
1157
1158 #--- HTML::TocGenerator::number() ---------------------------------------------
1159 # function: Heading number processing method.  Leave it up to the descendant
1160 #           to do something useful with it.
1161 # args:     - $aNumber
1162 #           - $aToc: Reference to ToC to which anchorname belongs.
1163
1164 sub number {
1165                 # Get arguments
1166         my ($self, $aNumber, $aToc) = @_;
1167 }  # number()
1168
1169
1170 #--- HTML::TocGenerator::parse() ----------------------------------------------
1171 # function: Parse scalar.
1172 # args:     - $aString: string to parse
1173
1174 sub parse {
1175                 # Get arguments
1176         my ($self, $aString) = @_;
1177                 # Call ancestor
1178         $self->SUPER::parse($aString);
1179 }  # parse()
1180
1181
1182 #--- HTML::TocGenerator::parse_file() -----------------------------------------
1183 # function: Parse file.
1184
1185 sub parse_file {
1186                 # Get arguments
1187         my ($self, $aFile) = @_;
1188                 # Call ancestor
1189         $self->SUPER::parse_file($aFile);
1190 }  # parse_file()
1191
1192
1193 #--- HTML::TocGenerator::setOptions() -----------------------------------------
1194 # function: Set options.
1195 # args:     - aOptions: Reference to hash containing options.
1196
1197 sub setOptions {
1198                 # Get arguments
1199         my ($self, $aOptions) = @_;
1200                 # Options are defined?
1201         if (defined($aOptions)) {
1202                 # Yes, options are defined; add to options
1203                 %{$self->{options}} = (%{$self->{options}}, %$aOptions);
1204         }
1205 }  # setOptions()
1206
1207
1208 #--- HTML::TocGenerator::start() ----------------------------------------------
1209 # function: This function is called every time an opening tag is encountered.
1210 # args:     - $aTag: tag name (in lower case).
1211 #           - $aAttr: reference to hash containing all tag attributes (in lower
1212 #                case).
1213 #           - $aAttrSeq: reference to array containing all tag attributes (in
1214 #                lower case) in the original order
1215 #           - $aOrigText: the original HTML text
1216
1217 sub start {
1218                 # Get arguments
1219         my ($self, $aTag, $aAttr, $aAttrSeq, $aOrigText) = @_;
1220         $self->{isTocToken} = 0;
1221                 # Start tag is of type 'anchor name'?
1222         if ($aTag eq "a" && defined($aAttr->{name})) {
1223                 # Yes, start tag is of type 'anchor name';
1224                         # Is another anchor already active?
1225                 if (defined($self->{_activeAnchorName})) {
1226                         # Yes, another anchor is already active;
1227                                 # Is the first anchor inserted by 'TocGenerator'?
1228                         if ($self->{_doOutputAnchorNameEnd}) {
1229                                 # Yes, the first anchor is inserted by 'TocGenerator';
1230                                         # Show warning
1231                                 $self->_showWarning(
1232                                         WARNING_NESTED_ANCHOR_PS_WITHIN_PS,
1233                                         [$aOrigText, $self->{_activeAnchorName}]
1234                                 );
1235                         }
1236                 }
1237                         # Set active anchor name
1238                 $self->_setActiveAnchorName($aAttr->{name});
1239         }
1240                 # Must a ToC be generated?
1241         if ($self->{_doGenerateToc}) {
1242                 # Yes, a ToC must be generated
1243                         # Process start tag as ToC token
1244                 $self->{isTocToken} = $self->_processTokenAsTocStartingToken(
1245                         TT_TOKENTYPE_START, $aTag, $aAttr, \$aOrigText
1246                 );
1247                         # Process end tag as ToC-ending-token
1248                 $self->_processTokenAsTocEndingToken(
1249                         TT_TOKENTYPE_START, $aTag
1250                 );
1251         }
1252 }  # start()
1253
1254
1255 #--- HTML::TocGenerator::text() -----------------------------------------------
1256 # function: This function is called every time plain text is encountered.
1257 # args:     - @_: array containing data.
1258
1259 sub text {
1260                 # Get arguments
1261         my ($self, $aText) = @_;
1262                 # Local variables
1263         my ($text, $toc, $i, $token, $tokens);
1264                 # Must a ToC be generated?
1265         if ($self->{_doGenerateToc}) {
1266                 # Yes, a ToC must be generated
1267                         # Are there dirty start tags?
1268
1269                         # Loop through token types
1270                 foreach $tokens (@{$self->{_tokensTocEnd}}) {
1271                                 # Loop though tokens
1272                         foreach $token (@$tokens) {
1273                                         # Add text to toc
1274
1275                                         # Alias
1276                                 $toc = $token->[TT_TOC];
1277                                         # Remove possible newlines from text
1278                                 ($text = $aText) =~ s/\s*\n\s*/ /g;
1279                                         # Add text to toc
1280                                 $self->_processTocText($text, $toc);
1281                         }
1282                 }
1283         }
1284 }  # text()
1285
1286
1287
1288
1289 #=== HTML::_TokenTocParser ====================================================
1290 # function: Parse 'toc tokens'.  'Toc tokens' mark HTML code which is to be
1291 #           inserted into the ToC.
1292 # note:     Used internally.
1293
1294 package HTML::_TokenTocParser;
1295
1296
1297 BEGIN {
1298         use vars qw(@ISA);
1299
1300         @ISA = qw(HTML::Parser);
1301 }
1302
1303
1304 END {}
1305
1306
1307 #--- HTML::_TokenTocParser::new() ---------------------------------------------
1308 # function: Constructor
1309
1310 sub new {
1311                 # Get arguments
1312         my ($aType) = @_;
1313                 # Create instance
1314         my $self = $aType->SUPER::new;
1315
1316                 # Return instance
1317         return $self;
1318 }  # new()
1319
1320
1321 #--- HTML::_TokenTocParser::_parseAttributes() --------------------------------
1322 # function: Parse attributes.
1323 # args:     - $aAttr: Reference to hash containing all tag attributes (in lower
1324 #                case).
1325 #           - $aIncludeAttributes: Reference to hash to which 'include
1326 #                attributes' must be added.
1327 #           - $aExcludeAttributes: Reference to hash to which 'exclude
1328 #                attributes' must be added.
1329 #           - $aTocAttributes: Reference to hash to which 'ToC attributes'
1330 #                must be added.
1331
1332 sub _parseAttributes {
1333                 # Get arguments
1334         my (
1335                 $self, $aAttr, $aIncludeAttributes, $aExcludeAttributes,
1336                 $aTocAttributes
1337         ) = @_;
1338                 # Local variables
1339         my ($key, $value);
1340         my ($attributeToExcludeToken, $attributeToTocToken);
1341                 # Get token which marks attributes which must be excluded
1342         $attributeToExcludeToken = $self->{_toc}{options}{'attributeToExcludeToken'};
1343         $attributeToTocToken     = $self->{_toc}{options}{'attributeToTocToken'};
1344                 # Loop through attributes
1345         while (($key, $value) = each %$aAttr) {
1346                         # Attribute value equals 'ToC token'?
1347                 if ($value =~ m/$attributeToTocToken/) {
1348                         # Yes, attribute value equals 'ToC token';
1349                                 # Add attribute to 'ToC attributes'
1350                         push @$aTocAttributes, $key;
1351                 }
1352                 else {
1353                         # No, attribute isn't 'ToC' token;
1354                                 # Attribute value starts with 'exclude token'?
1355                         if ($value =~ m/^$attributeToExcludeToken(.*)/) {
1356                                 # Yes, attribute value starts with 'exclude token';
1357                                         # Add attribute to 'exclude attributes'
1358                                 $$aExcludeAttributes{$key} = "$1";
1359                         }
1360                         else {
1361                                 # No, attribute key doesn't start with '-';
1362                                         # Add attribute to 'include attributes'
1363                                 $$aIncludeAttributes{$key} = $value;
1364                         }
1365                 }
1366         }
1367 }  # _parseAttributes()
1368
1369
1370
1371
1372 #=== HTML::_TokenTocBeginParser ===============================================
1373 # function: Parse 'toc tokens'.  'Toc tokens' mark HTML code which is to be
1374 #           inserted into the ToC.
1375 # note:     Used internally.
1376
1377 package HTML::_TokenTocBeginParser;
1378
1379
1380 BEGIN {
1381         use vars qw(@ISA);
1382
1383         @ISA = qw(HTML::_TokenTocParser);
1384 }
1385
1386 END {}
1387
1388
1389 #--- HTML::_TokenTocBeginParser::new() ----------------------------------------
1390 # function: Constructor
1391
1392 sub new {
1393                 # Get arguments
1394         my ($aType, $aTokenArray) = @_;
1395                 # Create instance
1396         my $self = $aType->SUPER::new;
1397                 # Reference token array
1398         $self->{tokens} = $aTokenArray;
1399                 # Reference to last added token
1400         $self->{_lastAddedToken}     = undef;
1401         $self->{_lastAddedTokenType} = undef;
1402                 # Return instance
1403         return $self;
1404 }  # new()
1405
1406
1407 #--- HTML::_TokenTocBeginParser::_processAttributes() -------------------------
1408 # function: Process attributes.
1409 # args:     - $aAttributes: Attributes to parse.
1410
1411 sub _processAttributes {
1412                 # Get arguments
1413         my ($self, $aAttributes) = @_;
1414                 # Local variables
1415         my (%includeAttributes, %excludeAttributes, @tocAttributes);
1416
1417                 # Parse attributes
1418         $self->_parseAttributes(
1419                 $aAttributes, \%includeAttributes, \%excludeAttributes, \@tocAttributes
1420         );
1421                 # Include attributes are specified?
1422         if (keys(%includeAttributes) > 0) {
1423                 # Yes, include attributes are specified;
1424                         # Store include attributes
1425                 @${$self->{_lastAddedToken}}[
1426                         HTML::TocGenerator::TT_INCLUDE_ATTRIBUTES_BEGIN
1427                 ] = \%includeAttributes;
1428         }
1429                 # Exclude attributes are specified?
1430         if (keys(%excludeAttributes) > 0) {
1431                 # Yes, exclude attributes are specified;
1432                         # Store exclude attributes
1433                 @${$self->{_lastAddedToken}}[
1434                         HTML::TocGenerator::TT_EXCLUDE_ATTRIBUTES_BEGIN
1435                 ] = \%excludeAttributes;
1436         }
1437                 # Toc attributes are specified?
1438         if (@tocAttributes > 0) {
1439                 # Yes, toc attributes are specified;
1440                         # Store toc attributes
1441                 @${$self->{_lastAddedToken}}[
1442                         HTML::TocGenerator::TT_ATTRIBUTES_TOC
1443                 ] = \@tocAttributes;
1444         }
1445 }  # _processAttributes()
1446
1447
1448 #--- HTML::_TokenTocBeginParser::_processToken() ------------------------------
1449 # function: Process token.
1450 # args:     - $aTokenType: Type of token to process.
1451 #           - $aTag: Tag of token.
1452
1453 sub _processToken {
1454                 # Get arguments
1455         my ($self, $aTokenType, $aTag) = @_;
1456                 # Local variables
1457         my ($tokenArray, $index);
1458                 # Push element on array of update tokens
1459         $index = push(@{$self->{tokens}[$aTokenType]}, []) - 1;
1460                 # Alias token array to add element to
1461         $tokenArray = $self->{tokens}[$aTokenType];
1462                 # Indicate last updated token array element
1463         $self->{_lastAddedTokenType} = $aTokenType;
1464         $self->{_lastAddedToken}     = \$$tokenArray[$index];
1465                 # Add fields
1466         $$tokenArray[$index][HTML::TocGenerator::TT_TAG_BEGIN] = $aTag;
1467         $$tokenArray[$index][HTML::TocGenerator::TT_GROUP]     = $self->{_group};
1468         $$tokenArray[$index][HTML::TocGenerator::TT_TOC]       = $self->{_toc};
1469 }  # _processToken()
1470
1471
1472 #--- HTML::_TokenTocBeginParser::comment() ------------------------------------
1473 # function: Process comment.
1474 # args:     - $aComment: comment text with '<!--' and '-->' tags stripped off.
1475
1476 sub comment {
1477                 # Get arguments
1478         my ($self, $aComment) = @_;
1479                 # Process token
1480         $self->_processToken(HTML::TocGenerator::TT_TOKENTYPE_COMMENT, $aComment);
1481 }  # comment()
1482
1483
1484 #--- HTML::_TokenTocBeginParser::declaration() --------------------------------
1485 # function: This function is called every time a markup declaration is
1486 #           encountered by HTML::Parser.
1487 # args:     - $aDeclaration: Markup declaration.
1488
1489 sub declaration {
1490                 # Get arguments
1491         my ($self, $aDeclaration) = @_;
1492                 # Process token
1493         $self->_processToken(
1494                 HTML::TocGenerator::TT_TOKENTYPE_DECLARATION, $aDeclaration
1495         );
1496 }  # declaration()
1497
1498
1499 #--- HTML::_TokenTocBeginParser::end() ----------------------------------------
1500 # function: This function is called every time a closing tag is encountered
1501 #           by HTML::Parser.
1502 # args:     - $aTag: tag name (in lower case).
1503
1504 sub end {
1505                 # Get arguments
1506         my ($self, $aTag, $aOrigText) = @_;
1507                 # Process token
1508         $self->_processToken(HTML::TocGenerator::TT_TOKENTYPE_END, $aTag);
1509 }  # end()
1510
1511
1512 #--- HTML::_TokenTocBeginParser::parse() --------------------------------------
1513 # function: Parse begin token.
1514 # args:     - $aToken: 'toc token' to parse
1515
1516 sub parse {
1517                 # Get arguments
1518         my ($self, $aString) = @_;
1519                 # Call ancestor
1520         $self->SUPER::parse($aString);
1521 }  # parse()
1522
1523
1524 #--- HTML::_TokenTocBeginParser->setGroup() -----------------------------------
1525 # function: Set current 'tokenToToc' group.
1526
1527 sub setGroup {
1528                 # Get arguments
1529         my ($self, $aGroup) = @_;
1530                 # Set current 'tokenToToc' group
1531         $self->{_group} = $aGroup;
1532 }  # setGroup()
1533
1534
1535 #--- HTML::_TokenTocBeginParser->setToc() -------------------------------------
1536 # function: Set current ToC.
1537
1538 sub setToc {
1539                 # Get arguments
1540         my ($self, $aToc) = @_;
1541                 # Set current ToC
1542         $self->{_toc} = $aToc;
1543 }  # setToc()
1544
1545
1546 #--- HTML::_TokenTocBeginParser::start() --------------------------------------
1547 # function: This function is called every time an opening tag is encountered.
1548 # args:     - $aTag: tag name (in lower case).
1549 #           - $aAttr: reference to hash containing all tag attributes (in lower
1550 #                case).
1551 #           - $aAttrSeq: reference to array containing all attribute keys (in
1552 #                lower case) in the original order
1553 #           - $aOrigText: the original HTML text
1554
1555 sub start {
1556                 # Get arguments
1557         my ($self, $aTag, $aAttr, $aAttrSeq, $aOrigText) = @_;
1558                 # Process token
1559         $self->_processToken(HTML::TocGenerator::TT_TOKENTYPE_START, $aTag);
1560                 # Process attributes
1561         $self->_processAttributes($aAttr);
1562 }  # start()
1563
1564
1565 #--- HTML::_TokenTocBeginParser::text() ---------------------------------------
1566 # function: This function is called every time plain text is encountered.
1567 # args:     - @_: array containing data.
1568
1569 sub text {
1570                 # Get arguments
1571         my ($self, $aText) = @_;
1572                 # Was token already created and is last added token of type 'text'?
1573         if (
1574                 defined($self->{_lastAddedToken}) &&
1575                 $self->{_lastAddedTokenType} == HTML::TocGenerator::TT_TOKENTYPE_TEXT
1576         ) {
1577                 # Yes, token is already created;
1578                         # Add tag to existing token
1579                 @${$self->{_lastAddedToken}}[HTML::TocGenerator::TT_TAG_BEGIN] .= $aText;
1580         }
1581         else {
1582                 # No, token isn't created;
1583                         # Process token
1584                 $self->_processToken(HTML::TocGenerator::TT_TOKENTYPE_TEXT, $aText);
1585         }
1586 }  # text()
1587
1588
1589
1590
1591 #=== HTML::_TokenTocEndParser =================================================
1592 # function: Parse 'toc tokens'.  'Toc tokens' mark HTML code which is to be
1593 #           inserted into the ToC.
1594 # note:     Used internally.
1595
1596 package HTML::_TokenTocEndParser;
1597
1598
1599 BEGIN {
1600         use vars qw(@ISA);
1601
1602         @ISA = qw(HTML::_TokenTocParser);
1603 }
1604
1605
1606 END {}
1607
1608
1609 #--- HTML::_TokenTocEndParser::new() ------------------------------------------
1610 # function: Constructor
1611 # args:     - $aType: Class type.
1612
1613 sub new {
1614                 # Get arguments
1615         my ($aType) = @_;
1616                 # Create instance
1617         my $self = $aType->SUPER::new;
1618                 # Reference to last added token
1619         $self->{_lastAddedToken} = undef;
1620                 # Return instance
1621         return $self;
1622 }  # new()
1623
1624
1625 #--- HTML::_TokenTocEndParser::_processAttributes() ---------------------------
1626 # function: Process attributes.
1627 # args:     - $aAttributes: Attributes to parse.
1628
1629 sub _processAttributes {
1630                 # Get arguments
1631         my ($self, $aAttributes) = @_;
1632                 # Local variables
1633         my (%includeAttributes, %excludeAttributes);
1634
1635                 # Parse attributes
1636         $self->_parseAttributes(
1637                 $aAttributes, \%includeAttributes, \%excludeAttributes
1638         );
1639                 # Include attributes are specified?
1640         if (keys(%includeAttributes) > 0) {
1641                 # Yes, include attributes are specified;
1642                         # Store include attributes
1643                 @${$self->{_Token}}[
1644                         HTML::TocGenerator::TT_INCLUDE_ATTRIBUTES_END
1645                 ] = \%includeAttributes;
1646         }
1647                 # Exclude attributes are specified?
1648         if (keys(%excludeAttributes) > 0) {
1649                 # Yes, exclude attributes are specified;
1650                         # Store exclude attributes
1651                 @${$self->{_Token}}[
1652                         HTML::TocGenerator::TT_EXCLUDE_ATTRIBUTES_END
1653                 ] = \%excludeAttributes;
1654         }
1655 }  # _processAttributes()
1656
1657
1658 #--- HTML::_TokenTocEndParser::_processToken() --------------------------------
1659 # function: Process token.
1660 # args:     - $aTokenType: Type of token to process.
1661 #           - $aTag: Tag of token.
1662
1663 sub _processToken {
1664                 # Get arguments
1665         my ($self, $aTokenType, $aTag) = @_;
1666                 # Update token
1667         @${$self->{_token}}[HTML::TocGenerator::TT_TAG_TYPE_END] = $aTokenType;
1668         @${$self->{_token}}[HTML::TocGenerator::TT_TAG_END]      = $aTag;
1669                 # Indicate token type which has been processed
1670         $self->{_lastAddedTokenType} = $aTokenType;
1671 }  # _processToken()
1672
1673
1674 #--- HTML::_TokenTocEndParser::comment() --------------------------------------
1675 # function: Process comment.
1676 # args:     - $aComment: comment text with '<!--' and '-->' tags stripped off.
1677
1678 sub comment {
1679                 # Get arguments
1680         my ($self, $aComment) = @_;
1681                 # Process token
1682         $self->_processToken(HTML::TocGenerator::TT_TOKENTYPE_COMMENT, $aComment);
1683 }  # comment()
1684
1685
1686 #--- HTML::_TokenTocDeclarationParser::declaration() --------------------------
1687 # function: This function is called every time a markup declaration is
1688 #           encountered by HTML::Parser.
1689 # args:     - $aDeclaration: Markup declaration.
1690
1691 sub declaration {
1692                 # Get arguments
1693         my ($self, $aDeclaration) = @_;
1694                 # Process token
1695         $self->_processToken(
1696                 HTML::TocGenerator::TT_TOKENTYPE_DECLARATION, $aDeclaration
1697         );
1698 }  # declaration()
1699
1700
1701 #--- HTML::_TokenTocEndParser::end() ------------------------------------------
1702 # function: This function is called every time a closing tag is encountered
1703 #           by HTML::Parser.
1704 # args:     - $aTag: tag name (in lower case).
1705
1706 sub end {
1707                 # Get arguments
1708         my ($self, $aTag, $aOrigText) = @_;
1709                 # Process token
1710         $self->_processToken(HTML::TocGenerator::TT_TOKENTYPE_END, $aTag);
1711 }  # end()
1712
1713
1714 #--- HTML::_TokenTocEndParser::parse() ----------------------------------------
1715 # function: Parse token.
1716 # args:     - $aString: 'toc token' to parse
1717 #           - $aToken: Reference to token
1718 #           - $aTokenTypeBegin: Type of begin token
1719
1720 sub parse {
1721                 # Get arguments
1722         my ($self, $aString, $aToken, $aTokenTypeBegin) = @_;
1723                 # Token argument specified?
1724         if (defined($aToken)) {
1725                 # Yes, token argument is specified;
1726                         # Store token reference
1727                 $self->{_token} = $aToken;
1728         }
1729                 # End tag defined?
1730         if (! defined($aString)) {
1731                 # No, end tag isn't defined;
1732                         # Last added tokentype was of type 'start'?
1733                 if (
1734                         (defined($aTokenTypeBegin)) &&
1735                         ($aTokenTypeBegin == HTML::TocGenerator::TT_TOKENTYPE_START)
1736                 ) {
1737                         # Yes, last added tokentype was of type 'start';
1738                                 # Assume end tag
1739                         $self->_processToken(
1740                                 HTML::TocGenerator::TT_TAG_END,
1741                                 @${$self->{_token}}[HTML::TocGenerator::TT_TAG_BEGIN]
1742                         );
1743                 }
1744         }
1745         else {
1746                         # Call ancestor
1747                 $self->SUPER::parse($aString);
1748         }
1749 }  # parse()
1750
1751
1752 #--- HTML::_TokenTocEndParser::start() ----------------------------------------
1753 # function: This function is called every time an opening tag is encountered.
1754 # args:     - $aTag: tag name (in lower case).
1755 #           - $aAttr: reference to hash containing all tag attributes (in lower
1756 #                case).
1757 #           - $aAttrSeq: reference to array containing all attribute keys (in
1758 #                lower case) in the original order
1759 #           - $aOrigText: the original HTML text
1760
1761 sub start {
1762                 # Get arguments
1763         my ($self, $aTag, $aAttr, $aAttrSeq, $aOrigText) = @_;
1764                 # Process token
1765         $self->_processToken(HTML::TocGenerator::TT_TOKENTYPE_START, $aTag);
1766                 # Process attributes
1767         $self->_processAttributes($aAttr);
1768 }  # start()
1769
1770
1771 #--- HTML::_TokenTocEndParser::text() -----------------------------------------
1772 # function: This function is called every time plain text is encountered.
1773 # args:     - @_: array containing data.
1774
1775 sub text {
1776                 # Get arguments
1777         my ($self, $aText) = @_;
1778
1779                 # Is token already created?
1780         if (defined($self->{_lastAddedTokenType})) {
1781                 # Yes, token is already created;
1782                         # Add tag to existing token
1783                 @${$self->{_token}}[HTML::TocGenerator::TT_TAG_END] .= $aText;
1784         }
1785         else {
1786                 # No, token isn't created;
1787                         # Process token
1788                 $self->_processToken(HTML::TocGenerator::TT_TOKENTYPE_TEXT, $aText);
1789         }
1790 }  # text()
1791
1792
1793 1;