1#--- TocInsertor.pm ----------------------------------------------------------- 2# function: Insert Table of Contents HTML::Toc, generated by 3# HTML::TocGenerator. 4# note: - The term 'propagate' is used as a shortcut for the process of 5# both generating and inserting a ToC at the same time. 6# - 'TIP' is an abbreviation of 'Toc Insertion Point'. 7 8 9package HTML::TocInsertor; 10 11 12use strict; 13use FileHandle; 14use HTML::TocGenerator; 15 16 17BEGIN { 18 use vars qw(@ISA $VERSION); 19 20 $VERSION = '0.91'; 21 22 @ISA = qw(HTML::TocGenerator); 23} 24 25 # TocInsertionPoint (TIP) constants 26 27use constant TIP_PREPOSITION_REPLACE => 'replace'; 28use constant TIP_PREPOSITION_BEFORE => 'before'; 29use constant TIP_PREPOSITION_AFTER => 'after'; 30 31use constant TIP_TOKEN_ID => 0; 32use constant TIP_PREPOSITION => 1; 33use constant TIP_INCLUDE_ATTRIBUTES => 2; 34use constant TIP_EXCLUDE_ATTRIBUTES => 3; 35use constant TIP_TOC => 4; 36 37use constant MODE_DO_NOTHING => 0; # 0b00 38use constant MODE_DO_INSERT => 1; # 0b01 39use constant MODE_DO_PROPAGATE => 3; # 0b11 40 41END {} 42 43 44#--- HTML::TocInsertor::new() ------------------------------------------------- 45# function: Constructor. 46 47sub new { 48 # Get arguments 49 my ($aType) = @_; 50 my $self = $aType->SUPER::new; 51 # TRUE if insertion point token must be output, FALSE if not 52 $self->{_doOutputInsertionPointToken} = 1; 53 # Reset batch variables 54 $self->_resetBatchVariables; 55 # Bias to not insert ToC 56 $self->{hti__Mode} = MODE_DO_NOTHING; 57 58 # TODO: Initialize output 59 60 return $self; 61} # new() 62 63 64#--- HTML::TocInsertor::_deinitializeOutput() --------------------------------- 65# function: Deinitialize output. 66 67sub _deinitializeOutput { 68 # Get arguments 69 my ($self) = @_; 70 # Filehandle is defined? 71 if (defined($self->{_outputFileHandle})) { 72 # Yes, filehandle is defined; 73 # Restore selected filehandle 74 select($self->{_oldFileHandle}); 75 # Undefine filehandle, closing it automatically 76 undef $self->{_outputFileHandle}; 77 } 78} # _deinitializeOutput() 79 80 81#--- HTML::TocInsertor::_initializeOutput() ----------------------------------- 82# function: Initialize output. 83 84sub _initializeOutput { 85 # Get arguments 86 my ($self) = @_; 87 # Bias to write to outputfile 88 my $doOutputToFile = 1; 89 90 # Is output specified? 91 if (defined($self->{options}{'output'})) { 92 # Yes, output is specified; 93 # Indicate to not output to outputfile 94 $doOutputToFile = 0; 95 # Alias output reference 96 $self->{_output} = $self->{options}{'output'}; 97 # Clear output 98 ${$self->{_output}} = ""; 99 } 100 101 # Is output file specified? 102 if (defined($self->{options}{'outputFile'})) { 103 # Yes, output file is specified; 104 # Indicate to output to outputfile 105 $doOutputToFile = 1; 106 # Open file 107 $self->{_outputFileHandle} = 108 new FileHandle ">" . $self->{options}{'outputFile'}; 109 110 # Backup currently selected filehandle 111 $self->{_oldFileHandle} = select; 112 # Set new default filehandle 113 select($self->{_outputFileHandle}); 114 } 115 116 # Alias output-to-file indicator 117 $self->{_doOutputToFile} = $doOutputToFile; 118} # _initializeOutput() 119 120 121#--- HTML::TocInsertor::_deinitializeInsertorBatch() -------------------------- 122# function: Deinitialize insertor batch. 123 124sub _deinitializeInsertorBatch { 125 # Get arguments 126 my ($self) = @_; 127 # Indicate ToC insertion has finished 128 $self->{_isTocInsertionPointPassed} = 0; 129 # Write buffered output 130 $self->_writeBufferedOutput(); 131 # Propagate? 132 if ($self->{hti__Mode} == MODE_DO_PROPAGATE) { 133 # Yes, propagate; 134 # Deinitialize generator batch 135 $self->_deinitializeGeneratorBatch(); 136 } 137 else { 138 # No, insert only; 139 # Do general batch deinitialization 140 $self->_deinitializeBatch(); 141 } 142 # Deinitialize output 143 $self->_deinitializeOutput(); 144 # Indicate end of batch 145 $self->{hti__Mode} = MODE_DO_NOTHING; 146 # Reset batch variables 147 $self->_resetBatchVariables(); 148} # _deinitializeInsertorBatch() 149 150 151#--- HTML::TocInsertor::_initializeInsertorBatch() ---------------------------- 152# function: Initialize insertor batch. 153# args: - $aTocs: Reference to array of tocs. 154# - $aOptions: optional options 155 156sub _initializeInsertorBatch { 157 # Get arguments 158 my ($self, $aTocs, $aOptions) = @_; 159 # Add invocation options 160 $self->setOptions($aOptions); 161 # Option 'doGenerateToc' specified? 162 if (!defined($self->{options}{'doGenerateToc'})) { 163 # No, options 'doGenerateToc' not specified; 164 # Default to 'doGenerateToc' 165 $self->{options}{'doGenerateToc'} = 1; 166 } 167 # Propagate? 168 if ($self->{options}{'doGenerateToc'}) { 169 # Yes, propagate; 170 # Indicate mode 171 $self->{hti__Mode} = MODE_DO_PROPAGATE; 172 # Initialize generator batch 173 # NOTE: This method takes care of calling '_initializeBatch()' 174 $self->_initializeGeneratorBatch($aTocs); 175 } 176 else { 177 # No, insert; 178 # Indicate mode 179 $self->{hti__Mode} = MODE_DO_INSERT; 180 # Do general batch initialization 181 $self->_initializeBatch($aTocs); 182 } 183 # Initialize output 184 $self->_initializeOutput(); 185 # Parse ToC insertion points 186 $self->_parseTocInsertionPoints(); 187} # _initializeInsertorBatch() 188 189 190#--- HTML::TocInsertor::_insert() --------------------------------------------- 191# function: Insert ToC in string. 192# args: - $aString: Reference to string to parse. 193# note: Used internally. 194 195sub _insert { 196 # Get arguments 197 my ($self, $aString) = @_; 198 # Propagate? 199 if ($self->{options}{'doGenerateToc'}) { 200 # Yes, propagate; 201 # Generate & insert ToC 202 $self->_generate($aString); 203 } 204 else { 205 # No, just insert ToC 206 # Insert by parsing file 207 $self->parse($aString); 208 # Flush remaining buffered text 209 $self->eof(); 210 } 211} # _insert() 212 213 214#--- HTML::TocInsertor::_insertIntoFile() ------------------------------------- 215# function: Do insert generated ToCs in file. 216# args: - $aToc: (reference to array of) ToC object(s) to insert. 217# - $aFile: (reference to array of) file(s) to parse for insertion 218# points. 219# - $aOptions: optional insertor options 220# note: Used internally. 221 222sub _insertIntoFile { 223 # Get arguments 224 my ($self, $aFile) = @_; 225 # Local variables; 226 my ($file, @files); 227 # Dereference array reference or make array of file specification 228 @files = (ref($aFile) =~ m/ARRAY/) ? @$aFile : ($aFile); 229 # Loop through files 230 foreach $file (@files) { 231 # Propagate? 232 if ($self->{options}{'doGenerateToc'}) { 233 # Yes, propagate; 234 # Generate and insert ToC 235 $self->_generateFromFile($file); 236 } 237 else { 238 # No, just insert ToC 239 # Insert by parsing file 240 $self->parse_file($file); 241 } 242 } 243} # _insertIntoFile() 244 245 246#--- HTML::TocInsertor::_parseTocInsertionPoints() ---------------------------- 247# function: Parse ToC insertion point specifier. 248 249sub _parseTocInsertionPoints { 250 # Get arguments 251 my ($self) = @_; 252 # Local variables 253 my ($tipPreposition, $tipToken, $toc, $tokenTipParser); 254 # Create parser for TIP tokens 255 $tokenTipParser = HTML::_TokenTipParser->new( 256 $self->{_tokensTip} 257 ); 258 # Loop through ToCs 259 foreach $toc (@{$self->{_tocs}}) { 260 # Split TIP in preposition and token 261 ($tipPreposition, $tipToken) = split( 262 '\s+', $toc->{options}{'insertionPoint'}, 2 263 ); 264 # Known preposition? 265 if ( 266 ($tipPreposition ne TIP_PREPOSITION_REPLACE) && 267 ($tipPreposition ne TIP_PREPOSITION_BEFORE) && 268 ($tipPreposition ne TIP_PREPOSITION_AFTER) 269 ) { 270 # No, unknown preposition; 271 # Use default preposition 272 $tipPreposition = TIP_PREPOSITION_AFTER; 273 # Use entire 'insertionPoint' as token 274 $tipToken = $toc->{options}{'insertionPoint'}; 275 } 276 # Indicate current ToC to parser 277 $tokenTipParser->setToc($toc); 278 # Indicate current preposition to parser 279 $tokenTipParser->setPreposition($tipPreposition); 280 # Parse ToC Insertion Point 281 $tokenTipParser->parse($tipToken); 282 # Flush remaining buffered text 283 $tokenTipParser->eof(); 284 } 285} # _parseTocInsertionPoints() 286 287 288#--- HTML::TocInsertor::_processTokenAsInsertionPoint() ----------------------- 289# function: Check for token being a ToC insertion point (Tip) token and 290# process it accordingly. 291# args: - $aTokenType: type of token: start, end, comment or text. 292# - $aTokenId: token id of currently parsed token 293# - $aTokenAttributes: attributes of currently parsed token 294# - $aOrigText: complete token 295# returns: 1 if successful -- token is processed as insertion point, 0 296# if not. 297 298sub _processTokenAsInsertionPoint { 299 # Get arguments 300 my ($self, $aTokenType, $aTokenId, $aTokenAttributes, $aOrigText) = @_; 301 # Local variables 302 my ($i, $result, $tipToken, $tipTokenId, $tipTokens); 303 # Bias to token not functioning as a ToC insertion point (Tip) token 304 $result = 0; 305 # Alias ToC insertion point (Tip) array of right type 306 $tipTokens = $self->{_tokensTip}[$aTokenType]; 307 # Loop through tipTokens 308 $i = 0; 309 while ($i < scalar @{$tipTokens}) { 310 # Aliases 311 $tipToken = $tipTokens->[$i]; 312 $tipTokenId = $tipToken->[TIP_TOKEN_ID]; 313 # Id & attributes match? 314 if ( 315 ($aTokenId =~ m/$tipTokenId/) && ( 316 HTML::TocGenerator::_doesHashContainHash( 317 $aTokenAttributes, $tipToken->[TIP_INCLUDE_ATTRIBUTES], 0 318 ) && 319 HTML::TocGenerator::_doesHashContainHash( 320 $aTokenAttributes, $tipToken->[TIP_EXCLUDE_ATTRIBUTES], 1 321 ) 322 ) 323 ) { 324 # Yes, id and attributes match; 325 # Process ToC insertion point 326 $self->_processTocInsertionPoint($tipToken); 327 # Indicate token functions as ToC insertion point 328 $result = 1; 329 # Remove Tip token, automatically advancing to next token 330 splice(@$tipTokens, $i, 1); 331 } 332 else { 333 # No, tag doesn't match ToC insertion point 334 # Advance to next start token 335 $i++; 336 } 337 } 338 # Token functions as ToC insertion point? 339 if ($result) { 340 # Yes, token functions as ToC insertion point; 341 # Process insertion point(s) 342 $self->_processTocInsertionPoints($aOrigText); 343 } 344 # Return value 345 return $result; 346} # _processTokenAsInsertionPoint() 347 348 349#--- HTML::TocInsertor::toc() ------------------------------------------------- 350# function: Toc processing method. Add toc reference to scenario. 351# args: - $aScenario: Scenario to add ToC reference to. 352# - $aToc: Reference to ToC to insert. 353# note: The ToC hasn't been build yet; only a reference to the ToC to be 354# build is inserted. 355 356sub toc { 357 # Get arguments 358 my ($self, $aScenario, $aToc) = @_; 359 # Add toc to scenario 360 push(@$aScenario, $aToc); 361} # toc() 362 363 364#--- HTML::TocInsertor::_processTocInsertionPoint() ---------------------------- 365# function: Process ToC insertion point. 366# args: - $aTipToken: Reference to token array item which matches the ToC 367# insertion point. 368 369sub _processTocInsertionPoint { 370 # Get arguments 371 my ($self, $aTipToken) = @_; 372 # Local variables 373 my ($tipToc, $tipPreposition); 374 375 # Aliases 376 $tipToc = $aTipToken->[TIP_TOC]; 377 $tipPreposition = $aTipToken->[TIP_PREPOSITION]; 378 379 SWITCH: { 380 # Replace token with ToC? 381 if ($tipPreposition eq TIP_PREPOSITION_REPLACE) { 382 # Yes, replace token; 383 # Indicate ToC insertion point has been passed 384 $self->{_isTocInsertionPointPassed} = 1; 385 # Add ToC reference to scenario reference by calling 'toc' method 386 $self->toc($self->{_scenarioAfterToken}, $tipToc); 387 #push(@{$self->{_scenarioAfterToken}}, $tipTokenToc); 388 # Indicate token itself must not be output 389 $self->{_doOutputInsertionPointToken} = 0; 390 last SWITCH; 391 } 392 # Output ToC before token? 393 if ($tipPreposition eq TIP_PREPOSITION_BEFORE) { 394 # Yes, output ToC before token; 395 # Indicate ToC insertion point has been passed 396 $self->{_isTocInsertionPointPassed} = 1; 397 # Add ToC reference to scenario reference by calling 'toc' method 398 $self->toc($self->{_scenarioBeforeToken}, $tipToc); 399 #push(@{$self->{_scenarioBeforeToken}}, $tipTokenToc); 400 last SWITCH; 401 } 402 # Output ToC after token? 403 if ($tipPreposition eq TIP_PREPOSITION_AFTER) { 404 # Yes, output ToC after token; 405 # Indicate ToC insertion point has been passed 406 $self->{_isTocInsertionPointPassed} = 1; 407 # Add ToC reference to scenario reference by calling 'toc' method 408 $self->toc($self->{_scenarioAfterToken}, $tipToc); 409 #push(@{$self->{_scenarioAfterToken}}, $tipTokenToc); 410 last SWITCH; 411 } 412 } 413} # _processTocInsertionPoint() 414 415 416#--- HTML::TocInsertor::_processTocInsertionPoints() -------------------------- 417# function: Process ToC insertion points 418# args: - $aTokenText: Text of token which acts as insertion point for one 419# or multiple ToCs. 420 421sub _processTocInsertionPoints { 422 # Get arguments 423 my ($self, $aTokenText) = @_; 424 # Local variables 425 my ($outputPrefix, $outputSuffix); 426 # Extend scenario 427 push(@{$self->{_scenario}}, @{$self->{_scenarioBeforeToken}}); 428 429 if ($outputPrefix = $self->{_outputPrefix}) { 430 push(@{$self->{_scenario}}, \$outputPrefix); 431 $self->{_outputPrefix} = ""; 432 } 433 434 # Must insertion point token be output? 435 if ($self->{_doOutputInsertionPointToken}) { 436 # Yes, output insertion point token; 437 push(@{$self->{_scenario}}, \$aTokenText); 438 } 439 440 if ($outputSuffix = $self->{_outputSuffix}) { 441 push(@{$self->{_scenario}}, \$outputSuffix); 442 $self->{_outputSuffix} = ""; 443 } 444 445 push(@{$self->{_scenario}}, @{$self->{_scenarioAfterToken}}); 446 # Add new act to scenario for output to come 447 my $output = ""; 448 push(@{$self->{_scenario}}, \$output); 449 # Write output, processing possible '_outputSuffix' 450 #$self->_writeOrBufferOutput(""); 451 # Reset helper scenario's 452 $self->{_scenarioBeforeToken} = []; 453 $self->{_scenarioAfterToken} = []; 454 # Reset bias value to output insertion point token 455 $self->{_doOutputInsertionPointToken} = 1; 456 457} # _processTocInsertionPoints() 458 459 460#--- HTML::Toc::_resetBatchVariables() ---------------------------------------- 461# function: Reset batch variables. 462 463sub _resetBatchVariables { 464 my ($self) = @_; 465 # Call ancestor 466 $self->SUPER::_resetBatchVariables(); 467 # Array containing references to scalars. This array depicts the order 468 # in which output must be performed after the first ToC Insertion Point 469 # has been passed. 470 $self->{_scenario} = []; 471 # Helper scenario 472 $self->{_scenarioBeforeToken} = []; 473 # Helper scenario 474 $self->{_scenarioAfterToken} = []; 475 # Arrays containing start, end, comment, text & declaration tokens which 476 # must trigger the ToC insertion. Each array element may contain a 477 # reference to an array containing the following elements: 478 $self->{_tokensTip} = [ 479 [], # TT_TOKENTYPE_START 480 [], # TT_TOKENTYPE_END 481 [], # TT_TOKENTYPE_COMMENT 482 [], # TT_TOKENTYPE_TEXT 483 [] # TT_TOKENTYPE_DECLARATION 484 ]; 485 # 1 if ToC insertion point has been passed, 0 if not 486 $self->{_isTocInsertionPointPassed} = 0; 487 # Tokens after ToC 488 $self->{outputBuffer} = ""; 489 # Trailing text after parsed token 490 $self->{_outputSuffix} = ""; 491 # Preceding text before parsed token 492 $self->{_outputPrefix} = ""; 493} # _resetBatchVariables() 494 495 496#--- HTML::TocInsertor::_writeBufferedOutput() -------------------------------- 497# function: Write buffered output to output device(s). 498 499sub _writeBufferedOutput { 500 # Get arguments 501 my ($self) = @_; 502 # Local variables 503 my ($scene); 504 # Must ToC be parsed? 505 if ($self->{options}{'parseToc'}) { 506 # Yes, ToC must be parsed; 507 # Parse ToC 508 #$self->parse($self->{toc}); 509 # Output tokens after ToC 510 #$self->_writeOrBufferOutput($self->{outputBuffer}); 511 } 512 else { 513 # No, ToC needn't be parsed; 514 # Output scenario 515 foreach $scene (@{$self->{_scenario}}) { 516 # Is scene a reference to a scalar? 517 if (ref($scene) eq "SCALAR") { 518 # Yes, scene is a reference to a scalar; 519 # Output scene 520 $self->_writeOutput($$scene); 521 } 522 else { 523 # No, scene must be reference to HTML::Toc; 524 # Output toc 525 $self->_writeOutput($scene->format()); 526 } 527 } 528 } 529} # _writeBufferedOutput() 530 531 532#--- HTML::TocInsertor::_writeOrBufferOutput() -------------------------------- 533# function: Write processed HTML to output device(s). 534# args: - aOutput: scalar to write 535# note: If '_isTocInsertionPointPassed' text is buffered before being 536# output because the ToC has to be generated before it can be output. 537# Only after the entire data has been parsed, the ToC and the 538# following text will be output. 539 540sub _writeOrBufferOutput { 541 # Get arguments 542 my ($self, $aOutput) = @_; 543 544 # Add possible output prefix and suffix 545 $aOutput = $self->{_outputPrefix} . $aOutput . $self->{_outputSuffix}; 546 # Clear output prefix and suffix 547 $self->{_outputPrefix} = ""; 548 $self->{_outputSuffix} = ""; 549 550 # Has ToC insertion point been passed? 551 if ($self->{_isTocInsertionPointPassed}) { 552 # Yes, ToC insertion point has been passed; 553 # Buffer output; add output to last '_scenario' item 554 my $index = scalar(@{$self->{_scenario}}) - 1; 555 ${$self->{_scenario}[$index]} .= $aOutput; 556 } 557 else { 558 # No, ToC insertion point hasn't been passed; 559 # Write output 560 $self->_writeOutput($aOutput); 561 } 562} # _writeOrBufferOutput() 563 564 565#--- HTML::TocInsertor::_writeOutput() ---------------------------------------- 566# function: Write processed HTML to output device(s). 567# args: - aOutput: scalar to write 568 569sub _writeOutput { 570 # Get arguments 571 my ($self, $aOutput) = @_; 572 # Write output to scalar; 573 ${$self->{_output}} .= $aOutput if (defined($self->{_output})); 574 # Write output to output file 575 print $aOutput if ($self->{_doOutputToFile}) 576} # _writeOutput() 577 578 579#--- HTML::TocGenerator::anchorId() ------------------------------------------- 580# function: Anchor id processing method. 581# args: - $aAnchorId 582 583sub anchorId { 584 # Get arguments 585 my ($self, $aAnchorId) = @_; 586 # Indicate id must be added to start tag 587 $self->{_doAddAnchorIdToStartTag} = 1; 588 $self->{_anchorId} = $aAnchorId; 589} # anchorId() 590 591 592#--- HTML::TocInsertor::anchorNameBegin() ------------------------------------- 593# function: Process anchor name begin, generated by HTML::TocGenerator. 594# args: - $aAnchorNameBegin: Anchor name begin tag to output. 595# - $aToc: Reference to ToC to which anchorname belongs. 596 597sub anchorNameBegin { 598 # Get arguments 599 my ($self, $aAnchorNameBegin, $aToc) = @_; 600 # Is another anchorName active? 601 if (defined($self->{_activeAnchorName})) { 602 # Yes, another anchorName is active; 603 # Show warning 604 print "Warn\n"; 605 $self->_showWarning( 606 HTML::TocGenerator::WARNING_NESTED_ANCHOR_PS_WITHIN_PS, 607 [$aAnchorNameBegin, $self->{_activeAnchorName}] 608 ); 609 } 610 # Store anchor name as output prefix 611 $self->{_outputPrefix} = $aAnchorNameBegin; 612 # Indicate active anchor name 613 $self->{_activeAnchorName} = $aAnchorNameBegin; 614 # Indicate anchor name end must be output 615 $self->{_doOutputAnchorNameEnd} = 1; 616} # anchorNameBegin() 617 618 619#--- HTML::TocInsertor::anchorNameEnd() --------------------------------------- 620# function: Process anchor name end, generated by HTML::TocGenerator. 621# args: - $aAnchorNameEnd: Anchor name end tag to output. 622# - $aToc: Reference to ToC to which anchorname belongs. 623 624sub anchorNameEnd { 625 # Get arguments 626 my ($self, $aAnchorNameEnd) = @_; 627 # Store anchor name as output prefix 628 $self->{_outputSuffix} .= $aAnchorNameEnd; 629 # Indicate deactive anchor name 630 $self->{_activeAnchorName} = undef; 631} # anchorNameEnd() 632 633 634#--- HTML::TocInsertor::comment() --------------------------------------------- 635# function: Process comment. 636# args: - $aComment: comment text with '<!--' and '-->' tags stripped off. 637 638sub comment { 639 # Get arguments 640 my ($self, $aComment) = @_; 641 # Local variables 642 my ($tocInsertionPointToken, $doOutput, $origText); 643 # Allow ancestor to process the comment tag 644 $self->SUPER::comment($aComment); 645 # Assemble original comment 646 $origText = "<!--$aComment-->"; 647 # Must ToCs be inserted? 648 if ($self->{hti__Mode} & MODE_DO_INSERT) { 649 # Yes, ToCs must be inserted; 650 # Processing comment as ToC insertion point is successful? 651 if (! $self->_processTokenAsInsertionPoint( 652 HTML::TocGenerator::TT_TOKENTYPE_COMMENT, $aComment, undef, $origText 653 )) { 654 # No, comment isn't a ToC insertion point; 655 # Output comment normally 656 $self->_writeOrBufferOutput($origText); 657 } 658 } 659} # comment() 660 661 662#--- HTML::TocInsertor::declaration() ----------------------------------------- 663# function: This function is called every time a declaration is encountered 664# by HTML::Parser. 665 666sub declaration { 667 # Get arguments 668 my ($self, $aDeclaration) = @_; 669 # Allow ancestor to process the declaration tag 670 $self->SUPER::declaration($aDeclaration); 671 # Must ToCs be inserted? 672 if ($self->{hti__Mode} & MODE_DO_INSERT) { 673 # Yes, ToCs must be inserted; 674 # Processing declaration as ToC insertion point is successful? 675 if (! $self->_processTokenAsInsertionPoint( 676 HTML::TocGenerator::TT_TOKENTYPE_DECLARATION, $aDeclaration, undef, 677 "<!$aDeclaration>" 678 )) { 679 # No, declaration isn't a ToC insertion point; 680 # Output declaration normally 681 $self->_writeOrBufferOutput("<!$aDeclaration>"); 682 } 683 } 684} # declaration() 685 686 687#--- HTML::TocInsertor::end() ------------------------------------------------- 688# function: This function is called every time a closing tag is encountered 689# by HTML::Parser. 690# args: - $aTag: tag name (in lower case). 691 692sub end { 693 # Get arguments 694 my ($self, $aTag, $aOrigText) = @_; 695 # Allow ancestor to process the end tag 696 $self->SUPER::end($aTag, $aOrigText); 697 # Must ToCs be inserted? 698 if ($self->{hti__Mode} & MODE_DO_INSERT) { 699 # Yes, ToCs must be inserted; 700 # Processing end tag as ToC insertion point is successful? 701 if (! $self->_processTokenAsInsertionPoint( 702 HTML::TocGenerator::TT_TOKENTYPE_END, $aTag, undef, $aOrigText 703 )) { 704 # No, end tag isn't a ToC insertion point; 705 # Output end tag normally 706 $self->_writeOrBufferOutput($aOrigText); 707 } 708 } 709} # end() 710 711 712#--- HTML::TocInsertor::insert() ---------------------------------------------- 713# function: Insert ToC in string. 714# args: - $aToc: (reference to array of) ToC object to insert 715# - $aString: string to insert ToC in 716# - $aOptions: hash reference with optional insertor options 717 718sub insert { 719 # Get arguments 720 my ($self, $aToc, $aString, $aOptions) = @_; 721 # Initialize TocInsertor batch 722 $self->_initializeInsertorBatch($aToc, $aOptions); 723 # Do insert Toc 724 $self->_insert($aString); 725 # Deinitialize TocInsertor batch 726 $self->_deinitializeInsertorBatch(); 727} # insert() 728 729 730#--- HTML::TocInsertor::insertIntoFile() -------------------------------------- 731# function: Insert ToCs in file. 732# args: - $aToc: (reference to array of) ToC object(s) to insert. 733# - $aFile: (reference to array of) file(s) to parse for insertion 734# points. 735# - $aOptions: optional insertor options 736 737sub insertIntoFile { 738 # Get arguments 739 my ($self, $aToc, $aFile, $aOptions) = @_; 740 # Initialize TocInsertor batch 741 $self->_initializeInsertorBatch($aToc, $aOptions); 742 # Do insert ToCs into file 743 $self->_insertIntoFile($aFile); 744 # Deinitialize TocInsertor batch 745 $self->_deinitializeInsertorBatch(); 746} # insertIntoFile() 747 748 749#--- HTML::TocInsertor::number() ---------------------------------------------- 750# function: Process heading number generated by HTML::Toc. 751# args: - $aNumber 752 753sub number { 754 # Get arguments 755 my ($self, $aNumber) = @_; 756 # Store heading number as output suffix 757 $self->{_outputSuffix} .= $aNumber; 758} # number() 759 760 761#--- HTML::TocInsertor::propagateFile() --------------------------------------- 762# function: Propagate ToC; generate & insert ToC, using file as input. 763# args: - $aToc: (reference to array of) ToC object to insert 764# - $aFile: (reference to array of) file to parse for insertion 765# points. 766# - $aOptions: optional insertor options 767 768sub propagateFile { 769 # Get arguments 770 my ($self, $aToc, $aFile, $aOptions) = @_; 771 # Local variables; 772 my ($file, @files); 773 # Initialize TocInsertor batch 774 $self->_initializeInsertorBatch($aToc, $aOptions); 775 # Dereference array reference or make array of file specification 776 @files = (ref($aFile) =~ m/ARRAY/) ? @$aFile : ($aFile); 777 # Loop through files 778 foreach $file (@files) { 779 # Generate and insert ToC 780 $self->_generateFromFile($file); 781 } 782 # Deinitialize TocInsertor batch 783 $self->_deinitializeInsertorBatch(); 784} # propagateFile() 785 786 787#--- HTML::TocInsertor::start() ----------------------------------------------- 788# function: This function is called every time an opening tag is encountered. 789# args: - $aTag: tag name (in lower case). 790# - $aAttr: reference to hash containing all tag attributes (in lower 791# case). 792# - $aAttrSeq: reference to array containing all tag attributes (in 793# lower case) in the original order 794# - $aOrigText: the original HTML text 795 796sub start { 797 # Get arguments 798 my ($self, $aTag, $aAttr, $aAttrSeq, $aOrigText) = @_; 799 # Local variables 800 my ($doOutput, $i, $tocToken, $tag, $anchorId); 801 # Let ancestor process the start tag 802 $self->SUPER::start($aTag, $aAttr, $aAttrSeq, $aOrigText); 803 # Must ToC be inserted? 804 if ($self->{hti__Mode} & MODE_DO_INSERT) { 805 # Yes, ToC must be inserted; 806 # Processing start tag as ToC insertion point is successful? 807 if (! $self->_processTokenAsInsertionPoint( 808 HTML::TocGenerator::TT_TOKENTYPE_START, $aTag, $aAttr, $aOrigText 809 )) { 810 # No, start tag isn't a ToC insertion point; 811 # Add anchor id? 812 if ($self->{_doAddAnchorIdToStartTag}) { 813 # Yes, anchor id must be added; 814 # Reset indicator; 815 $self->{_doAddAnchorIdToStartTag} = 0; 816 # Alias anchor id 817 $anchorId = $self->{_anchorId}; 818 # Attribute 'id' already exists? 819 if (defined($aAttr->{id})) { 820 # Yes, attribute 'id' already exists; 821 # Show warning 822 print STDERR "WARNING: Overwriting existing id attribute '" . 823 $aAttr->{id} . "' of tag $aOrigText\n"; 824 825 # Add anchor id to start tag 826 $aOrigText =~ s/(id)=\S*([\s>])/$1=$anchorId$2/i; 827 } 828 else { 829 # No, attribute 'id' doesn't exist; 830 # Add anchor id to start tag 831 $aOrigText =~ s/>/ id=$anchorId>/; 832 } 833 } 834 # Output start tag normally 835 $self->_writeOrBufferOutput($aOrigText); 836 } 837 } 838} # start() 839 840 841#--- HTML::TocInsertor::text() ------------------------------------------------ 842# function: This function is called every time plain text is encountered. 843# args: - @_: array containing data. 844 845sub text { 846 # Get arguments 847 my ($self, $aText) = @_; 848 # Let ancestor process the text 849 $self->SUPER::text($aText); 850 # Must ToC be inserted? 851 if ($self->{hti__Mode} & MODE_DO_INSERT) { 852 # Yes, ToC must be inserted; 853 # Processing text as ToC insertion point is successful? 854 if (! $self->_processTokenAsInsertionPoint( 855 HTML::TocGenerator::TT_TOKENTYPE_TEXT, $aText, undef, $aText 856 )) { 857 # No, text isn't a ToC insertion point; 858 # Output text normally 859 $self->_writeOrBufferOutput($aText); 860 } 861 } 862} # text() 863 864 865 866 867#=== HTML::_TokenTipParser ==================================================== 868# function: Parse 'TIP tokens'. 'TIP tokens' mark HTML code which is to be 869# used as the ToC Insertion Point. 870# note: Used internally. 871 872package HTML::_TokenTipParser; 873 874 875BEGIN { 876 use vars qw(@ISA); 877 878 @ISA = qw(HTML::_TokenTocParser); 879} 880 881 882END {} 883 884 885#--- HTML::_TokenTipParser::new() --------------------------------------------- 886# function: Constructor 887 888sub new { 889 # Get arguments 890 my ($aType, $aTokenArray) = @_; 891 # Create instance 892 my $self = $aType->SUPER::new; 893 # Reference token array 894 $self->{tokens} = $aTokenArray; 895 # Reference to last added token 896 $self->{_lastAddedToken} = undef; 897 $self->{_lastAddedTokenType} = undef; 898 # Return instance 899 return $self; 900} # new() 901 902 903#--- HTML::_TokenTipParser::_processAttributes() ------------------------------ 904# function: Process attributes. 905# args: - $aAttributes: Attributes to parse. 906 907sub _processAttributes { 908 # Get arguments 909 my ($self, $aAttributes) = @_; 910 # Local variables 911 my (%includeAttributes, %excludeAttributes); 912 913 # Parse attributes 914 $self->_parseAttributes( 915 $aAttributes, \%includeAttributes, \%excludeAttributes 916 ); 917 # Include attributes are specified? 918 if (keys(%includeAttributes) > 0) { 919 # Yes, include attributes are specified; 920 # Store include attributes 921 @${$self->{_lastAddedToken}}[ 922 HTML::TocInsertor::TIP_INCLUDE_ATTRIBUTES 923 ] = \%includeAttributes; 924 } 925 # Exclude attributes are specified? 926 if (keys(%excludeAttributes) > 0) { 927 # Yes, exclude attributes are specified; 928 # Store exclude attributes 929 @${$self->{_lastAddedToken}}[ 930 HTML::TocInsertor::TIP_EXCLUDE_ATTRIBUTES 931 ] = \%excludeAttributes; 932 } 933} # _processAttributes() 934 935 936#--- HTML::_TokenTipParser::_processToken() ----------------------------------- 937# function: Process token. 938# args: - $aTokenType: Type of token to process. 939# - $aTag: Tag of token. 940 941sub _processToken { 942 # Get arguments 943 my ($self, $aTokenType, $aTag) = @_; 944 # Local variables 945 my ($tokenArray, $index); 946 # Push element on array of update tokens 947 $index = push(@{$self->{tokens}[$aTokenType]}, []) - 1; 948 # Alias token array to add element to 949 $tokenArray = $self->{tokens}[$aTokenType]; 950 # Indicate last updated token array element 951 $self->{_lastAddedTokenType} = $aTokenType; 952 $self->{_lastAddedToken} = \$$tokenArray[$index]; 953 # Add fields 954 $$tokenArray[$index][HTML::TocInsertor::TIP_TOC] = $self->{_toc}; 955 $$tokenArray[$index][HTML::TocInsertor::TIP_TOKEN_ID] = $aTag; 956 $$tokenArray[$index][HTML::TocInsertor::TIP_PREPOSITION] = 957 $self->{_preposition}; 958} # _processToken() 959 960 961#--- HTML::_TokenTipParser::comment() ----------------------------------------- 962# function: Process comment. 963# args: - $aComment: comment text with '<!--' and '-->' tags stripped off. 964 965sub comment { 966 # Get arguments 967 my ($self, $aComment) = @_; 968 # Process token 969 $self->_processToken(HTML::TocGenerator::TT_TOKENTYPE_COMMENT, $aComment); 970} # comment() 971 972 973#--- HTML::_TokenTipParser::declaration() -------------------------------- 974# function: This function is called every time a markup declaration is 975# encountered by HTML::Parser. 976# args: - $aDeclaration: Markup declaration. 977 978sub declaration { 979 # Get arguments 980 my ($self, $aDeclaration) = @_; 981 # Process token 982 $self->_processToken( 983 HTML::TocGenerator::TT_TOKENTYPE_DECLARATION, $aDeclaration 984 ); 985} # declaration() 986 987 988#--- HTML::_TokenTipParser::end() ---------------------------------------- 989# function: This function is called every time a closing tag is encountered 990# by HTML::Parser. 991# args: - $aTag: tag name (in lower case). 992 993sub end { 994 # Get arguments 995 my ($self, $aTag, $aOrigText) = @_; 996 # Process token 997 $self->_processToken(HTML::TocGenerator::TT_TOKENTYPE_END, $aTag); 998} # end() 999 1000 1001#--- HTML::_TokenTipParser->setPreposition() ---------------------------------- 1002# function: Set current preposition. 1003 1004sub setPreposition { 1005 # Get arguments 1006 my ($self, $aPreposition) = @_; 1007 # Set current ToC 1008 $self->{_preposition} = $aPreposition; 1009} # setPreposition() 1010 1011 1012#--- HTML::_TokenTipParser->setToc() ------------------------------------------ 1013# function: Set current ToC. 1014 1015sub setToc { 1016 # Get arguments 1017 my ($self, $aToc) = @_; 1018 # Set current ToC 1019 $self->{_toc} = $aToc; 1020} # setToc() 1021 1022 1023#--- HTML::_TokenTipParser::start() -------------------------------------- 1024# function: This function is called every time an opening tag is encountered. 1025# args: - $aTag: tag name (in lower case). 1026# - $aAttr: reference to hash containing all tag attributes (in lower 1027# case). 1028# - $aAttrSeq: reference to array containing all attribute keys (in 1029# lower case) in the original order 1030# - $aOrigText: the original HTML text 1031 1032sub start { 1033 # Get arguments 1034 my ($self, $aTag, $aAttr, $aAttrSeq, $aOrigText) = @_; 1035 # Process token 1036 $self->_processToken(HTML::TocGenerator::TT_TOKENTYPE_START, $aTag); 1037 # Process attributes 1038 $self->_processAttributes($aAttr); 1039} # start() 1040 1041 1042#--- HTML::_TokenTipParser::text() --------------------------------------- 1043# function: This function is called every time plain text is encountered. 1044# args: - @_: array containing data. 1045 1046sub text { 1047 # Get arguments 1048 my ($self, $aText) = @_; 1049 # Was token already created and is last added token of type 'text'? 1050 if ( 1051 defined($self->{_lastAddedToken}) && 1052 $self->{_lastAddedTokenType} == HTML::TocGenerator::TT_TOKENTYPE_TEXT 1053 ) { 1054 # Yes, token is already created; 1055 # Add tag to existing token 1056 @${$self->{_lastAddedToken}}[HTML::TocGenerator::TT_TAG_BEGIN] .= $aText; 1057 } 1058 else { 1059 # No, token isn't created; 1060 # Process token 1061 $self->_processToken(HTML::TocGenerator::TT_TOKENTYPE_TEXT, $aText); 1062 } 1063} # text() 1064 1065 10661; 1067