• Home
  • Line#
  • Scopes#
  • Navigate#
  • Raw
  • Download
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