Home | History | Annotate | Download | only in HTML-Toc-0.91
      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;
   1067