1#=== HTML::TocGenerator ======================================================= 2# function: Generate 'HTML::Toc' table of contents. 3# note: - 'TT' is an abbrevation of 'TocToken'. 4 5 6package HTML::TocGenerator; 7 8 9use strict; 10use HTML::Parser; 11 12 13BEGIN { 14 use vars qw(@ISA $VERSION); 15 16 $VERSION = '0.91'; 17 18 @ISA = qw(HTML::Parser); 19} 20 21 22 # Warnings 23use constant WARNING_NESTED_ANCHOR_PS_WITHIN_PS => 1; 24use constant WARNING_TOC_ATTRIBUTE_PS_NOT_AVAILABLE_WITHIN_PS => 2; 25 26 27use constant TOC_TOKEN_ID => 0; 28use constant TOC_TOKEN_INCLUDE => 1; 29use constant TOC_TOKEN_EXCLUDE => 2; 30use constant TOC_TOKEN_TOKENS => 3; 31use constant TOC_TOKEN_GROUP => 4; 32use constant TOC_TOKEN_TOC => 5; 33 34 # Token types 35use constant TT_TAG_BEGIN => 0; 36use constant TT_TAG_END => 1; 37use constant TT_TAG_TYPE_END => 2; 38use constant TT_INCLUDE_ATTRIBUTES_BEGIN => 3; 39use constant TT_EXCLUDE_ATTRIBUTES_BEGIN => 4; 40use constant TT_INCLUDE_ATTRIBUTES_END => 5; 41use constant TT_EXCLUDE_ATTRIBUTES_END => 6; 42use constant TT_GROUP => 7; 43use constant TT_TOC => 8; 44use constant TT_ATTRIBUTES_TOC => 9; 45 46 47use constant CONTAINMENT_INCLUDE => 0; 48use constant CONTAINMENT_EXCLUDE => 1; 49 50use constant TEMPLATE_ANCHOR => '$groupId."-".$node'; 51use constant TEMPLATE_ANCHOR_HREF => 52 '"<a href=#".' . TEMPLATE_ANCHOR . '.">"'; 53use constant TEMPLATE_ANCHOR_HREF_FILE => 54 '"<a href=".$file."#".' . TEMPLATE_ANCHOR . '.">"'; 55use constant TEMPLATE_ANCHOR_NAME => 56 '"<a name=".' . TEMPLATE_ANCHOR . '.">"'; 57 58use constant TEMPLATE_TOKEN_NUMBER => '"$node  "'; 59 60 61use constant TT_TOKENTYPE_START => 0; 62use constant TT_TOKENTYPE_END => 1; 63use constant TT_TOKENTYPE_TEXT => 2; 64use constant TT_TOKENTYPE_COMMENT => 3; 65use constant TT_TOKENTYPE_DECLARATION => 4; 66 67 68END {} 69 70 71#--- HTML::TocGenerator::new() ------------------------------------------------ 72# function: Constructor 73 74sub 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 95sub _deinitializeBatch() { 96 # Get arguments 97 my ($self) = @_; 98} # _deinitializeBatch() 99 100 101#--- HTML::TocGenerator::_deinitializeExtenderBatch() ------------------------- 102 103sub _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 117sub _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 144sub _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 193sub _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 209sub _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 235sub _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 284sub _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 310sub _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 329sub _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 349sub _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 373sub _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 405sub _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 423sub _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 457sub _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 563sub _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 584sub _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 623sub _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 654sub _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 796sub _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 810sub _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 854sub _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 915sub _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 962sub _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 975sub _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 988sub _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 1011sub 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 1021sub 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 1031sub anchorNameEnd { 1032} # anchorNameEnd() 1033 1034 1035#--- HTML::TocGenerator::comment() -------------------------------------------- 1036# function: Process comment. 1037# args: - $aComment: comment text with '<!--' and '-->' tags stripped off. 1038 1039sub 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 1062sub 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 1093sub 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 1110sub 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 1128sub 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 1146sub 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 1164sub 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 1174sub 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 1185sub 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 1197sub 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 1217sub 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 1259sub 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 1294package HTML::_TokenTocParser; 1295 1296 1297BEGIN { 1298 use vars qw(@ISA); 1299 1300 @ISA = qw(HTML::Parser); 1301} 1302 1303 1304END {} 1305 1306 1307#--- HTML::_TokenTocParser::new() --------------------------------------------- 1308# function: Constructor 1309 1310sub 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 1332sub _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 1377package HTML::_TokenTocBeginParser; 1378 1379 1380BEGIN { 1381 use vars qw(@ISA); 1382 1383 @ISA = qw(HTML::_TokenTocParser); 1384} 1385 1386END {} 1387 1388 1389#--- HTML::_TokenTocBeginParser::new() ---------------------------------------- 1390# function: Constructor 1391 1392sub 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 1411sub _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 1453sub _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 1476sub 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 1489sub 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 1504sub 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 1516sub 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 1527sub 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 1538sub 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 1555sub 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 1569sub 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 1596package HTML::_TokenTocEndParser; 1597 1598 1599BEGIN { 1600 use vars qw(@ISA); 1601 1602 @ISA = qw(HTML::_TokenTocParser); 1603} 1604 1605 1606END {} 1607 1608 1609#--- HTML::_TokenTocEndParser::new() ------------------------------------------ 1610# function: Constructor 1611# args: - $aType: Class type. 1612 1613sub 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 1629sub _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 1663sub _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 1678sub 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 1691sub 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 1706sub 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 1720sub 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 1761sub 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 1775sub 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 17931; 1794