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

   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
   9 package HTML::TocInsertor;
  10
  11
  12 use strict;
  13 use FileHandle;
  14 use HTML::TocGenerator;
  15
  16
  17 BEGIN {
  18         use vars qw(@ISA $VERSION);
  19
  20         $VERSION = '0.91';
  21
  22         @ISA = qw(HTML::TocGenerator);
  23 }
  24
  25         # TocInsertionPoint (TIP) constants
  26
  27 use constant TIP_PREPOSITION_REPLACE => 'replace';
  28 use constant TIP_PREPOSITION_BEFORE  => 'before';
  29 use constant TIP_PREPOSITION_AFTER   => 'after';
  30
  31 use constant TIP_TOKEN_ID           => 0;
  32 use constant TIP_PREPOSITION        => 1;
  33 use constant TIP_INCLUDE_ATTRIBUTES => 2;
  34 use constant TIP_EXCLUDE_ATTRIBUTES => 3;
  35 use constant TIP_TOC                => 4;
  36
  37 use constant MODE_DO_NOTHING   => 0;    # 0b00
  38 use constant MODE_DO_INSERT    => 1;    # 0b01
  39 use constant MODE_DO_PROPAGATE => 3;    # 0b11
  40
  41 END {}
  42
  43
  44 #--- HTML::TocInsertor::new() -------------------------------------------------
  45 # function: Constructor.
  46
  47 sub 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
  67 sub _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
  84 sub _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
 124 sub _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
 156 sub _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
 195 sub _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
 222 sub _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
 249 sub _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
 298 sub _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
 356 sub 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
 369 sub _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
 421 sub _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
 463 sub _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
 499 sub _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
 540 sub _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
 569 sub _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
 583 sub 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
 597 sub 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
 624 sub 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
 638 sub 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
 666 sub 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
 692 sub 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
 718 sub 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
 737 sub 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
 753 sub 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
 768 sub 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
 796 sub 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
 845 sub 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
 872 package HTML::_TokenTipParser;
 873
 874
 875 BEGIN {
 876         use vars qw(@ISA);
 877
 878         @ISA = qw(HTML::_TokenTocParser);
 879 }
 880
 881
 882 END {}
 883
 884
 885 #--- HTML::_TokenTipParser::new() ---------------------------------------------
 886 # function: Constructor
 887
 888 sub 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
 907 sub _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
 941 sub _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
 965 sub 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
 978 sub 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
 993 sub 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
1004 sub 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
1015 sub 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
1032 sub 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
1046 sub 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
1066 1;