1#=== HTML::TocGenerator =======================================================
2# function: Generate 'HTML::Toc' table of contents.
3# note:     - 'TT' is an abbrevation of 'TocToken'.
4
5
6package HTML::TocGenerator;
7
8
9use strict;
10use HTML::Parser;
11
12
13BEGIN {
14	use vars qw(@ISA $VERSION);
15
16	$VERSION = '0.91';
17
18	@ISA = qw(HTML::Parser);
19}
20
21
22	# Warnings
23use constant WARNING_NESTED_ANCHOR_PS_WITHIN_PS               => 1;
24use constant WARNING_TOC_ATTRIBUTE_PS_NOT_AVAILABLE_WITHIN_PS => 2;
25
26
27use constant TOC_TOKEN_ID       => 0;
28use constant TOC_TOKEN_INCLUDE  => 1;
29use constant TOC_TOKEN_EXCLUDE  => 2;
30use constant TOC_TOKEN_TOKENS   => 3;
31use constant TOC_TOKEN_GROUP    => 4;
32use constant TOC_TOKEN_TOC      => 5;
33
34	# Token types
35use constant TT_TAG_BEGIN                => 0;
36use constant TT_TAG_END                  => 1;
37use constant TT_TAG_TYPE_END             => 2;
38use constant TT_INCLUDE_ATTRIBUTES_BEGIN => 3;
39use constant TT_EXCLUDE_ATTRIBUTES_BEGIN => 4;
40use constant TT_INCLUDE_ATTRIBUTES_END   => 5;
41use constant TT_EXCLUDE_ATTRIBUTES_END   => 6;
42use constant TT_GROUP                    => 7;
43use constant TT_TOC                      => 8;
44use constant TT_ATTRIBUTES_TOC           => 9;
45
46
47use constant CONTAINMENT_INCLUDE => 0;
48use constant CONTAINMENT_EXCLUDE => 1;
49
50use constant TEMPLATE_ANCHOR            => '$groupId."-".$node';
51use constant TEMPLATE_ANCHOR_HREF       =>
52					'"<a href=#".' . TEMPLATE_ANCHOR . '.">"';
53use constant TEMPLATE_ANCHOR_HREF_FILE  =>
54					'"<a href=".$file."#".' . TEMPLATE_ANCHOR . '.">"';
55use constant TEMPLATE_ANCHOR_NAME       =>
56					'"<a name=".' . TEMPLATE_ANCHOR . '.">"';
57
58use constant TEMPLATE_TOKEN_NUMBER      => '"$node &nbsp"';
59
60
61use constant TT_TOKENTYPE_START        => 0;
62use constant TT_TOKENTYPE_END          => 1;
63use constant TT_TOKENTYPE_TEXT         => 2;
64use constant TT_TOKENTYPE_COMMENT      => 3;
65use constant TT_TOKENTYPE_DECLARATION  => 4;
66
67
68END {}
69
70
71#--- HTML::TocGenerator::new() ------------------------------------------------
72# function: Constructor
73
74sub new {
75		# Get arguments
76	my ($aType) = @_;
77	my $self = $aType->SUPER::new;
78		# Bias to not generate ToC
79	$self->{_doGenerateToc} = 0;
80		# Bias to not use global groups
81	$self->{_doUseGroupsGlobal} = 0;
82		# Output
83	$self->{output} = "";
84		# Reset internal variables
85	$self->_resetBatchVariables();
86
87	$self->{options} = {};
88
89	return $self;
90}  # new()
91
92
93#--- HTML::TocGenerator::_deinitializeBatch() ---------------------------------
94
95sub _deinitializeBatch() {
96		# Get arguments
97	my ($self) = @_;
98}  # _deinitializeBatch()
99
100
101#--- HTML::TocGenerator::_deinitializeExtenderBatch() -------------------------
102
103sub _deinitializeExtenderBatch() {
104		# Get arguments
105	my ($self) = @_;
106		# Do general batch deinitialization
107	$self->_deinitializeBatch();
108		# Indicate end of ToC generation
109	$self->{_doGenerateToc} = 0;
110		# Reset batch variables
111	$self->_resetBatchVariables();
112}  # _deinitializeExtenderBatch()
113
114
115#--- HTML::TocGenerator::_deinitializeGeneratorBatch() ------------------------
116
117sub _deinitializeGeneratorBatch() {
118		# Get arguments
119	my ($self) = @_;
120		# Do 'extender' batch deinitialization
121	$self->_deinitializeExtenderBatch();
122}  # _deinitializeBatchGenerator()
123
124
125#--- HTML::TocGenerator::_doesHashContainHash() -------------------------------
126# function: Determines whether hash1 matches regular expressions of hash2.
127# args:     - $aHash1
128#           - $aHash2
129#           - $aContainmentType: 0 (include) or 1 (exclude)
130# returns:  True (1) if hash1 satisfies hash2, 0 if not.  For example, with the
131#           following hashes:
132#
133#              %hash1 = {							%hash2 = {
134#                 'class' => 'header'				'class' => '^h'
135#                 'id'    => 'intro'         }
136#              }
137#
138#           the routine will return 1 if 'aContainmentType' equals 0, cause
139#           'hash1' satisfies the conditions of 'hash2'.  The routine will
140#           return 0 if 'aContainmentType' equals 1, cause 'hash1' doesn't
141#           exclude the conditions of 'hash2'.
142# note:     Class function.
143
144sub _doesHashContainHash {
145		# Get arguments
146	my ($aHash1, $aHash2, $aContainmentType) = @_;
147		# Local variables
148	my ($key1, $value1, $key2, $value2, $result);
149		# Bias to success
150	$result = 1;
151		# Loop through hash2
152	HASH2: while (($key2, $value2) = each %$aHash2) {
153		# Yes, values are available;
154			# Get value1
155		$value1 = $aHash1->{$key2};
156			# Does value1 match criteria of value2?
157		if (defined($value1) && $value1 =~ m/$value2/) {
158			# Yes, value1 matches criteria of value2;
159				# Containment type was exclude?
160			if ($aContainmentType == CONTAINMENT_EXCLUDE) {
161				# Yes, containment type was exclude;
162					# Indicate condition fails
163				$result = 0;
164					# Reset 'each' iterator which we're going to break
165				keys %$aHash2;
166					# Break loop
167				last HASH2;
168			}
169		}
170		else {
171			# No, value1 didn't match criteria of value2;
172				# Containment type was include?
173			if ($aContainmentType == CONTAINMENT_INCLUDE) {
174				# Yes, containment type was include;
175					# Indicate condition fails
176				$result = 0;
177					# Reset 'each' iterator which we're going to break
178				keys %$aHash2;
179					# Break loop
180				last HASH2;
181			}
182		}
183	}
184		# Return value
185	return $result;
186}  # _doesHashContainHash()
187
188
189#--- HTML::TocGenerator::_extend() --------------------------------------------
190# function: Extend ToC.
191#           - $aString: String to parse.
192
193sub _extend {
194		# Get arguments
195	my ($self, $aFile) = @_;
196		# Local variables
197	my ($file);
198		# Parse string
199	$self->parse($aFile);
200		# Flush remaining buffered text
201	$self->eof();
202}  # _extend()
203
204
205#--- HTML::TocGenerator::_extendFromFile() ------------------------------------
206# function: Extend ToC.
207#           - $aFile: (reference to array of) file to parse.
208
209sub _extendFromFile {
210		# Get arguments
211	my ($self, $aFile) = @_;
212		# Local variables
213	my ($file, @files);
214		# Dereference array reference or make array of file specification
215	@files = (ref($aFile) =~ m/ARRAY/) ? @$aFile : ($aFile);
216		# Loop through files
217	foreach $file (@files) {
218			# Store filename
219		$self->{_currentFile} = $file;
220			# Parse file
221		$self->parse_file($file);
222			# Flush remaining buffered text
223		$self->eof();
224	}
225}  # _extendFromFile()
226
227
228#--- HTML::TocGenerator::_formatHeadingLevel() --------------------------------
229# function: Format heading level.
230# args:     - $aLevel: Level of current heading
231#           - $aClass: Class of current heading
232#           - $aGroup: Group of current heading
233#           - $aToc: Toc of current heading
234
235sub _formatHeadingLevel {
236		# Get arguments
237	my ($self, $aLevel, $aClass, $aGroup, $aToc) = @_;
238		# Local variables
239	my ($result, $headingNumber, $numberingStyle);
240
241	$headingNumber = $self->_getGroupIdManager($aToc)->
242		{levels}{$aClass}[$aLevel - 1] || 0;
243
244		# Alias numbering style of current group
245	$numberingStyle = $aGroup->{numberingStyle};
246
247	SWITCH: {
248		if ($numberingStyle eq "decimal") {
249			$result = $headingNumber;
250			last SWITCH;
251		}
252		if ($numberingStyle eq "lower-alpha") {
253			$result = chr($headingNumber + ord('a') - 1);
254			last SWITCH;
255		}
256		if ($numberingStyle eq "upper-alpha") {
257			$result = chr($headingNumber + ord('A') - 1);
258			last SWITCH;
259		}
260		if ($numberingStyle eq "lower-roman") {
261			require Roman;
262			$result = Roman::roman($headingNumber);
263			last SWITCH;
264		}
265		if ($numberingStyle eq "upper-roman") {
266			require Roman;
267			$result = Roman::Roman($headingNumber);
268			last SWITCH;
269		}
270		die "Unknown case: $numberingStyle";
271	}
272		# Return value
273	return $result;
274}	# _formatHeadingLevel()
275
276
277#--- HTML::TocGenerator::_formatTocNode() -------------------------------------
278# function: Format heading node.
279# args:     - $aLevel: Level of current heading
280#           - $aClass: Class of current heading
281#           - $aGroup: Group of current heading
282#           - $aToc: Toc of current heading
283
284sub _formatTocNode {
285		# Get arguments
286	my ($self, $aLevel, $aClass, $aGroup, $aToc) = @_;
287		# Local variables
288	my ($result, $level, $levelGroups);
289
290		# Alias 'levelGroups' of right 'groupId'
291	$levelGroups = $aToc->{_levelGroups}{$aGroup->{'groupId'}};
292		# Loop through levels
293	for ($level = 1; $level <= $aLevel; $level++) {
294			# If not first level, add dot
295		$result = ($result ? $result . "." : $result);
296			# Format heading level using argument group
297		$result .= $self->_formatHeadingLevel(
298			$level, $aClass, @{$levelGroups}[$level - 1], $aToc
299		);
300	}
301		# Return value
302	return $result;
303}  # _formatTocNode()
304
305
306#--- HTML::TocGenerator::_generate() ------------------------------------------
307# function: Generate ToC.
308# args:     - $aString: Reference to string to parse
309
310sub _generate {
311		# Get arguments
312	my ($self, $aString) = @_;
313		# Local variables
314	my ($toc);
315		# Loop through ToCs
316	foreach $toc (@{$self->{_tocs}}) {
317			# Clear ToC
318		$toc->clear();
319	}
320		# Extend ToCs
321	$self->_extend($aString);
322}  # _generate()
323
324
325#--- HTML::TocGenerator::_generateFromFile() ----------------------------------
326# function: Generate ToC.
327# args:     - $aFile: (reference to array of) file to parse.
328
329sub _generateFromFile {
330		# Get arguments
331	my ($self, $aFile) = @_;
332		# Local variables
333	my ($toc);
334		# Loop through ToCs
335	foreach $toc (@{$self->{_tocs}}) {
336			# Clear ToC
337		$toc->clear();
338	}
339		# Extend ToCs
340	$self->_extendFromFile($aFile);
341}  # _generateFromFile()
342
343
344#--- HTML::TocGenerator::_getGroupIdManager() ---------------------------------
345# function: Get group id manager.
346# args:     - $aToc: Active ToC.
347# returns:  Group id levels.
348
349sub _getGroupIdManager {
350		# Get arguments
351	my ($self, $aToc) = @_;
352		# Local variables
353	my ($result);
354		# Global groups?
355	if ($self->{options}{'doUseGroupsGlobal'}) {
356		# Yes, global groups;
357		$result = $self;
358	}
359	else {
360		# No, local groups;
361		$result = $aToc;
362	}
363		# Return value
364	return $result;
365}  # _getGroupIdManager()
366
367
368#--- HTML::TocGenerator::_initializeBatch() -----------------------------------
369# function: Initialize batch.  This function is called once when a parse batch
370#           is started.
371# args:     - $aTocs: Reference to array of tocs.
372
373sub _initializeBatch {
374		# Get arguments
375	my ($self, $aTocs) = @_;
376		# Local variables
377	my ($toc);
378
379		# Store reference to tocs
380
381		# Is ToC specification reference to array?
382	if (ref($aTocs) =~ m/ARRAY/) {
383		# Yes, ToC specification is reference to array;
384			# Store array reference
385		$self->{_tocs} = $aTocs;
386	}
387	else {
388		# No, ToC specification is reference to ToC object;
389			# Wrap reference in array reference, containing only one element
390		$self->{_tocs} = [$aTocs];
391	}
392		# Loop through ToCs
393	foreach $toc (@{$self->{_tocs}}) {
394			# Parse ToC options
395		$toc->parseOptions();
396	}
397}  # _initializeBatch()
398
399
400#--- HTML::TocGenerator::_initializeExtenderBatch() --------------------------
401# function: Initialize 'extender' batch.  This function is called once when a
402#           parse batch is started.
403# args:     - $aTocs: Reference to array of tocs.
404
405sub _initializeExtenderBatch {
406		# Get arguments
407	my ($self, $aTocs) = @_;
408		# Do general batch initialization
409	$self->_initializeBatch($aTocs);
410		# Parse ToC options
411	$self->_parseTocOptions();
412		# Indicate start of batch
413	$self->{_doGenerateToc} = 1;
414}  # _initializeExtenderBatch()
415
416
417#--- HTML::TocGenerator::_initializeGeneratorBatch() --------------------------
418# function: Initialize generator batch.  This function is called once when a
419#           parse batch is started.
420# args:     - $aTocs: Reference to array of tocs.
421#           - $aOptions: optional options
422
423sub _initializeGeneratorBatch {
424		# Get arguments
425	my ($self, $aTocs, $aOptions) = @_;
426		# Add invocation options
427	$self->setOptions($aOptions);
428		# Option 'doUseGroupsGlobal' specified?
429	if (!defined($self->{options}{'doUseGroupsGlobal'})) {
430		# No, options 'doUseGroupsGlobal' not specified;
431			# Default to no 'doUseGroupsGlobal'
432		$self->{options}{'doUseGroupsGlobal'} = 0;
433	}
434		# Global groups?
435	if ($self->{options}{'doUseGroupsGlobal'}) {
436		# Yes, global groups;
437			# Reset groups and levels
438		$self->_resetStackVariables();
439	}
440		# Do 'extender' batch initialization
441	$self->_initializeExtenderBatch($aTocs);
442}  # _initializeGeneratorBatch()
443
444
445#--- HTML::TocGenerator::_linkTocToToken() ------------------------------------
446# function: Link ToC to token.
447# args:     - $aToc: ToC to add token to.
448#           - $aFile
449#           - $aGroupId
450#           - $aLevel
451#           - $aNode
452#           - $aGroupLevel
453#           - $aLinkType
454#           - $aTokenAttributes: reference to hash containing attributes of
455#                currently parsed token
456
457sub _linkTocToToken {
458		# Get arguments
459	my (
460		$self, $aToc, $aFile, $aGroupId, $aLevel, $aNode, $aGroupLevel,
461		$aDoLinkToId, $aTokenAttributes
462	) = @_;
463		# Local variables
464	my ($file, $groupId, $level, $node, $anchorName);
465	my ($doInsertAnchor, $doInsertId);
466
467		# Fill local arguments to be used by templates
468	$file    = $aFile;
469	$groupId = $aGroupId;
470	$level   = $aLevel;
471	$node    = $aNode;
472
473		# Assemble anchor name
474	$anchorName =
475		ref($aToc->{_templateAnchorName}) eq "CODE" ?
476			&{$aToc->{_templateAnchorName}}(
477				$aFile, $aGroupId, $aLevel, $aNode
478			) :
479			eval($aToc->{_templateAnchorName});
480
481		# Bias to insert anchor name
482	$doInsertAnchor = 1;
483	$doInsertId     = 0;
484		# Link to 'id'?
485	if ($aDoLinkToId) {
486		# Yes, link to 'id';
487			# Indicate to insert anchor id
488		$doInsertAnchor = 0;
489		$doInsertId     = 1;
490			# Id attribute is available?
491		if (defined($aTokenAttributes->{id})) {
492			# Yes, id attribute is available;
493				# Use existing ids?
494			if ($aToc->{options}{'doUseExistingIds'}) {
495				# Yes, use existing ids;
496					# Use existing id
497				$anchorName = $aTokenAttributes->{id};
498					# Indicate to not insert id
499				$doInsertId = 0;
500			}
501		}
502
503	}
504	else {
505		# No, link to 'name';
506			# Anchor name is currently active?
507		if (defined($self->{_activeAnchorName})) {
508			# Yes, anchor name is currently active;
509				# Use existing anchors?
510			if ($aToc->{options}{'doUseExistingAnchors'}) {
511				# Yes, use existing anchors;
512					# Use existing anchor name
513				$anchorName = $self->{_activeAnchorName};
514					# Indicate to not insert anchor name
515				$doInsertAnchor = 0;
516			}
517			else {
518				# No, don't use existing anchors; insert new anchor;
519					#
520			}
521		}
522	}
523
524		# Add reference to ToC
525	$aToc->{_toc} .=
526		ref($aToc->{_templateAnchorHrefBegin}) eq "CODE" ?
527			&{$aToc->{_templateAnchorHrefBegin}}(
528				$aFile, $aGroupId, $aLevel, $aNode, $anchorName
529			) :
530			eval($aToc->{_templateAnchorHrefBegin});
531
532		# Bias to not output anchor name end
533	$self->{_doOutputAnchorNameEnd} = 0;
534		# Must anchor be inserted?
535	if ($doInsertAnchor) {
536		# Yes, anchor must be inserted;
537			# Allow adding of anchor name begin token to text by calling
538			# 'anchorNameBegin' method
539		$self->anchorNameBegin(
540			ref($aToc->{_templateAnchorNameBegin}) eq "CODE" ?
541				&{$aToc->{_templateAnchorNameBegin}}(
542					$aFile, $aGroupId, $aLevel, $aNode, $anchorName
543				) :
544				eval($aToc->{_templateAnchorNameBegin}),
545			$aToc
546		);
547	}
548
549		# Must anchorId attribute be inserted?
550	if ($doInsertId) {
551		# Yes, anchorId attribute must be inserted;
552			# Allow adding of anchorId attribute to text by calling 'anchorId'
553			# method
554		$self->anchorId($anchorName);
555	}
556}  # _linkTocToToken()
557
558
559#--- HTML::TocGenerator::_outputAnchorNameEndConditionally() ------------------
560# function: Output 'anchor name end' if necessary
561# args:     - $aToc: ToC of which 'anchor name end' must be output.
562
563sub _outputAnchorNameEndConditionally {
564		# Get arguments
565	my ($self, $aToc) = @_;
566		# Must anchor name end be output?
567	if ($self->{_doOutputAnchorNameEnd}) {
568		# Yes, output anchor name end;
569			# Allow adding of anchor to text by calling 'anchorNameEnd'
570			# method
571		$self->anchorNameEnd(
572			ref($aToc->{_templateAnchorNameEnd}) eq "CODE" ?
573				&{$aToc->{_templateAnchorNameEnd}} :
574				eval($aToc->{_templateAnchorNameEnd}),
575			$aToc
576		);
577	}
578}  # _outputAnchorNameEndConditionally()
579
580
581#--- HTML::TocGenerator::_parseTocOptions() -----------------------------------
582# function: Parse ToC options.
583
584sub _parseTocOptions {
585		# Get arguments
586	my ($self) = @_;
587		# Local variables
588	my ($toc, $group, $tokens, $tokenType, $i);
589		# Create parsers for ToC tokens
590	$self->{_tokensTocBegin} = [];
591	my $tokenTocBeginParser = HTML::_TokenTocBeginParser->new(
592		$self->{_tokensTocBegin}
593	);
594	my $tokenTocEndParser = HTML::_TokenTocEndParser->new();
595		# Loop through ToCs
596	foreach $toc (@{$self->{_tocs}}) {
597			# Reference parser ToC to current ToC
598		$tokenTocBeginParser->setToc($toc);
599			# Loop through 'tokenToToc' groups
600		foreach $group (@{$toc->{options}{'tokenToToc'}}) {
601				# Reference parser group to current group
602			$tokenTocBeginParser->setGroup($group);
603				# Parse 'tokenToToc' group
604			$tokenTocBeginParser->parse($group->{'tokenBegin'});
605				# Flush remaining buffered text
606			$tokenTocBeginParser->eof();
607			$tokenTocEndParser->parse(
608				$group->{'tokenEnd'},
609				$tokenTocBeginParser->{_lastAddedToken},
610				$tokenTocBeginParser->{_lastAddedTokenType}
611			);
612				# Flush remaining buffered text
613			$tokenTocEndParser->eof();
614		}
615	}
616}  # _parseTocOptions()
617
618
619#--- HTML::TocGenerator::_processTocEndingToken() -----------------------------
620# function: Process ToC-ending-token.
621# args:     - $aTocToken: token which acts as ToC-ending-token.
622
623sub _processTocEndingToken {
624		# Get arguments
625	my ($self, $aTocToken) = @_;
626		# Local variables
627	my ($toc);
628		# Aliases
629	$toc = $aTocToken->[TT_TOC];
630		# Link ToC to tokens?
631	if ($toc->{options}{'doLinkToToken'}) {
632		# Yes, link ToC to tokens;
633			# Add anchor href end
634		$toc->{_toc} .=
635			(ref($toc->{_templateAnchorHrefEnd}) eq "CODE") ?
636				&{$toc->{_templateAnchorHrefEnd}} :
637				eval($toc->{_templateAnchorHrefEnd});
638
639			# Output anchor name end only if necessary
640		$self->_outputAnchorNameEndConditionally($toc);
641	}
642}  # _processTocEndingToken()
643
644
645#--- HTML::TocGenerator::_processTocStartingToken() ---------------------------
646# function: Process ToC-starting-token.
647# args:     - $aTocToken: token which acts as ToC-starting-token.
648#           - $aTokenType: type of token.  Can be either TT_TOKENTYPE_START,
649#                _END, _TEXT, _COMMENT or _DECLARATION.
650#           - $aTokenAttributes: reference to hash containing attributes of
651#                currently parsed token
652#           - $aTokenOrigText: reference to original token text
653
654sub _processTocStartingToken {
655		# Get arguments
656	my ($self, $aTocToken, $aTokenType, $aTokenAttributes, $aTokenOrigText) = @_;
657		# Local variables
658	my ($i, $level, $doLinkToId, $node, $groupLevel);
659	my ($file, $tocTokenId, $groupId, $toc, $attribute);
660		# Aliases
661	$file        = $self->{_currentFile};
662	$toc		    = $aTocToken->[TT_TOC];
663	$level	    = $aTocToken->[TT_GROUP]{'level'};
664	$groupId	    = $aTocToken->[TT_GROUP]{'groupId'};
665
666		# Retrieve 'doLinkToId' setting from either group options or toc options
667	$doLinkToId = (defined($aTocToken->[TT_GROUP]{'doLinkToId'})) ?
668		$aTocToken->[TT_GROUP]{'doLinkToId'} : $toc->{options}{'doLinkToId'};
669
670		# Link to 'id' and tokenType isn't 'start'?
671	if (($doLinkToId) && ($aTokenType != TT_TOKENTYPE_START)) {
672		# Yes, link to 'id' and tokenType isn't 'start';
673			# Indicate to *not* link to 'id'
674		$doLinkToId = 0;
675	}
676
677	if (ref($level) eq "CODE") {
678		$level = &$level($self->{_currentFile}, $node);
679	}
680	if (ref($groupId) eq "CODE") {
681		$groupId = &$groupId($self->{_currentFile}, $node);
682	}
683
684		# Determine class level
685
686	my $groupIdManager = $self->_getGroupIdManager($toc);
687		# Known group?
688	if (!exists($groupIdManager->{groupIdLevels}{$groupId})) {
689		# No, unknown group;
690			# Add group
691		$groupIdManager->{groupIdLevels}{$groupId} = keys(
692			%{$groupIdManager->{groupIdLevels}}
693		) + 1;
694	}
695	$groupLevel = $groupIdManager->{groupIdLevels}{$groupId};
696
697		# Temporarily allow symbolic references
698	#no strict qw(refs);
699		# Increase level
700	$groupIdManager->{levels}{$groupId}[$level - 1] += 1;
701		# Reset remaining levels of same group
702	for ($i = $level; $i < @{$groupIdManager->{levels}{$groupId}}; $i++) {
703		$groupIdManager->{levels}{$groupId}[$i] = 0;
704	}
705
706		# Assemble numeric string indicating current level
707	$node = $self->_formatTocNode(
708		$level, $groupId, $aTocToken->[TT_GROUP], $toc
709	);
710
711		# Add newline if _toc not empty
712	if ($toc->{_toc}) {
713		$toc->{_toc} .= "\n";
714	}
715
716		# Add toc item info
717	$toc->{_toc} .= "$level $groupLevel $groupId $node " .
718		$groupIdManager->{levels}{$groupId}[$level - 1] . " ";
719
720		# Add value of 'id' attribute if available
721	if (defined($aTokenAttributes->{id})) {
722		$toc->{_toc} .= $aTokenAttributes->{id};
723	}
724	$toc->{_toc} .= " ";
725		# Link ToC to tokens?
726	if ($toc->{options}{'doLinkToToken'}) {
727		# Yes, link ToC to tokens;
728			# Link ToC to token
729		$self->_linkTocToToken(
730			$toc, $file, $groupId, $level, $node, $groupLevel, $doLinkToId,
731			$aTokenAttributes
732		);
733	}
734
735		# Number tokens?
736	if (
737		$aTocToken->[TT_GROUP]{'doNumberToken'} ||
738		(
739			! defined($aTocToken->[TT_GROUP]{'doNumberToken'}) &&
740			$toc->{options}{'doNumberToken'}
741		)
742	) {
743		# Yes, number tokens;
744			# Add number by calling 'number' method
745		$self->number(
746			ref($toc->{_templateTokenNumber}) eq "CODE" ?
747				&{$toc->{_templateTokenNumber}}(
748					$node, $groupId, $file, $groupLevel, $level, $toc
749				) :
750				eval($toc->{_templateTokenNumber}),
751			$toc
752		);
753	}
754
755		# Must attribute be used as ToC text?
756	if (defined($aTocToken->[TT_ATTRIBUTES_TOC])) {
757		# Yes, attribute must be used as ToC text;
758			# Loop through attributes
759		foreach $attribute (@{$aTocToken->[TT_ATTRIBUTES_TOC]}) {
760				# Attribute is available?
761			if (defined($$aTokenAttributes{$attribute})) {
762				# Yes, attribute is available;
763					# Add attribute value to ToC
764				$self->_processTocText($$aTokenAttributes{$attribute}, $toc);
765			}
766			else {
767				# No, attribute isn't available;
768					# Show warning
769				$self->_showWarning(
770					WARNING_TOC_ATTRIBUTE_PS_NOT_AVAILABLE_WITHIN_PS,
771					[$attribute, $$aTokenOrigText]
772				);
773			}
774				# Output anchor name end only if necessary
775			#$self->_outputAnchorNameEndConditionally($toc);
776				# End attribute
777			$self->_processTocEndingToken($aTocToken);
778		}
779	}
780	else {
781		# No, attribute mustn't be used as ToC text;
782			# Add end token to 'end token array'
783		push(
784			@{$self->{_tokensTocEnd}[$aTocToken->[TT_TAG_TYPE_END]]}, $aTocToken
785		);
786	}
787}  # _processTocStartingToken()
788
789
790#--- HTML::TocGenerator::_processTocText() ------------------------------------
791# function: This function processes text which must be added to the preliminary
792#           ToC.
793# args:     - $aText: Text to add to ToC.
794#           - $aToc: ToC to add text to.
795
796sub _processTocText {
797		# Get arguments
798	my ($self, $aText, $aToc) = @_;
799		# Add text to ToC
800	$aToc->{_toc} .= $aText;
801}  # _processTocText()
802
803
804#--- HTML::TocGenerator::_processTokenAsTocEndingToken() ----------------------
805# function: Check for token being a token to use for triggering the end of
806#           a ToC line and process it accordingly.
807# args:     - $aTokenType: type of token: 'start', 'end', 'comment' or 'text'.
808#           - $aTokenId: token id of currently parsed token
809
810sub _processTokenAsTocEndingToken {
811		# Get arguments
812	my ($self, $aTokenType, $aTokenId) = @_;
813		# Local variables
814	my ($i, $tokenId, $toc, $tokens);
815		# Loop through dirty start tokens
816	$i = 0;
817
818		# Alias token array of right type
819	$tokens = $self->{_tokensTocEnd}[$aTokenType];
820		# Loop through token array
821	while ($i < scalar @$tokens) {
822			# Aliases
823		$tokenId = $tokens->[$i][TT_TAG_END];
824			# Does current end tag equals dirty tag?
825		if ($aTokenId eq $tokenId) {
826			# Yes, current end tag equals dirty tag;
827				# Process ToC-ending-token
828			$self->_processTocEndingToken($tokens->[$i]);
829				# Remove dirty tag from array, automatically advancing to
830				# next token
831			splice(@$tokens, $i, 1);
832		}
833		else {
834			# No, current end tag doesn't equal dirty tag;
835				# Advance to next token
836			$i++;
837		}
838	}
839}  # _processTokenAsTocEndingToken()
840
841
842#--- HTML::TocGenerator::_processTokenAsTocStartingToken() --------------------
843# function: Check for token being a ToC-starting-token and process it
844#           accordingly.
845# args:     - $aTokenType: type of token.  Can be either TT_TOKENTYPE_START,
846#                _END, _TEXT, _COMMENT or _DECLARATION.
847#           - $aTokenId: token id of currently parsed token
848#           - $aTokenAttributes: reference to hash containing attributes of
849#                currently parsed token
850#           - $aTokenOrigText: reference to original text of token
851# returns:  1 if successful, i.e. token is processed as ToC-starting-token, 0
852#           if not.
853
854sub _processTokenAsTocStartingToken {
855		# Get arguments
856	my ($self, $aTokenType, $aTokenId, $aTokenAttributes, $aTokenOrigText) = @_;
857		# Local variables
858	my ($level, $levelToToc, $groupId, $groupToToc);
859	my ($result, $tocToken, $tagBegin, @tokensTocBegin, $fileSpec);
860		# Bias to token not functioning as ToC-starting-token
861	$result = 0;
862		# Loop through start tokens of right type
863	foreach $tocToken (@{$self->{_tokensTocBegin}[$aTokenType]}) {
864			# Alias file filter
865		$fileSpec = $tocToken->[TT_GROUP]{'fileSpec'};
866			# File matches?
867		if (!defined($fileSpec) || (
868			defined($fileSpec) &&
869			($self->{_currentFile} =~ m/$fileSpec/)
870		)) {
871			# Yes, file matches;
872				# Alias tag begin
873			$tagBegin = $tocToken->[TT_TAG_BEGIN];
874				# Tag and attributes match?
875			if (
876				defined($tagBegin) &&
877				($aTokenId =~ m/$tagBegin/) &&
878				HTML::TocGenerator::_doesHashContainHash(
879					$aTokenAttributes, $tocToken->[TT_INCLUDE_ATTRIBUTES_BEGIN], 0
880				) &&
881				HTML::TocGenerator::_doesHashContainHash(
882					$aTokenAttributes, $tocToken->[TT_EXCLUDE_ATTRIBUTES_BEGIN], 1
883				)
884			) {
885				# Yes, tag and attributes match;
886					# Aliases
887				$level	    = $tocToken->[TT_GROUP]{'level'};
888				$levelToToc = $tocToken->[TT_TOC]{options}{'levelToToc'};
889				$groupId     = $tocToken->[TT_GROUP]{'groupId'};
890				$groupToToc = $tocToken->[TT_TOC]{options}{'groupToToc'};
891					# Must level and group be processed?
892				if (
893					($level =~ m/$levelToToc/) &&
894					($groupId =~ m/$groupToToc/)
895				) {
896					# Yes, level and group must be processed;
897						# Indicate token acts as ToC-starting-token
898					$result = 1;
899						# Process ToC-starting-token
900					$self->_processTocStartingToken(
901						$tocToken, $aTokenType, $aTokenAttributes, $aTokenOrigText
902					);
903				}
904			}
905		}
906	}
907		# Return value
908	return $result;
909}  # _processTokenAsTocStartingToken()
910
911
912#--- HTML::TocGenerator::_resetBatchVariables() -------------------------------
913# function: Reset variables which are set because of batch invocation.
914
915sub _resetBatchVariables {
916		# Get arguments
917	my ($self) = @_;
918
919		# Filename of current file being parsed, empty string if not available
920	$self->{_currentFile} = "";
921		# Arrays containing start, end, comment, text & declaration tokens which
922		# must trigger the ToC assembling.  Each array element may contain a
923		# reference to an array containing the following elements:
924		#
925      #    TT_TAG_BEGIN                => 0;
926      #    TT_TAG_END                  => 1;
927      #    TT_TAG_TYPE_END             => 2;
928      #    TT_INCLUDE_ATTRIBUTES_BEGIN => 3;
929      #    TT_EXCLUDE_ATTRIBUTES_BEGIN => 4;
930      #    TT_INCLUDE_ATTRIBUTES_END   => 5;
931      #    TT_EXCLUDE_ATTRIBUTES_END   => 6;
932      #    TT_GROUP                    => 7;
933      #    TT_TOC                      => 8;
934		#    TT_ATTRIBUTES_TOC           => 9;
935		#
936	$self->{_tokensTocBegin} = [
937		[],  # TT_TOKENTYPE_START
938		[],  # TT_TOKENTYPE_END
939		[],  # TT_TOKENTYPE_COMMENT
940		[],  # TT_TOKENTYPE_TEXT
941		[]   # TT_TOKENTYPE_DECLARATION
942	];
943	$self->{_tokensTocEnd} = [
944		[],  # TT_TOKENTYPE_START
945		[],  # TT_TOKENTYPE_END
946		[],  # TT_TOKENTYPE_COMMENT
947		[],  # TT_TOKENTYPE_TEXT
948		[]   # TT_TOKENTYPE_DECLARATION
949	];
950		# TRUE if ToCs have been initialized, FALSE if not.
951	$self->{_doneInitializeTocs} = 0;
952		# Array of ToCs to process
953	$self->{_tocs} = [];
954		# Active anchor name
955	$self->{_activeAnchorName} = undef;
956}  # _resetBatchVariables()
957
958
959#--- HTML::TocGenerator::_resetStackVariables() -------------------------------
960# function: Reset variables which cumulate during ToC generation.
961
962sub _resetStackVariables {
963		# Get arguments
964	my ($self) = @_;
965		# Reset variables
966	$self->{levels}        = undef;
967	$self->{groupIdLevels} = undef;
968}  # _resetStackVariables()
969
970
971#--- HTML::TocGenerator::_setActiveAnchorName() -------------------------------
972# function: Set active anchor name.
973# args:     - aAnchorName: Name of anchor name to set active.
974
975sub _setActiveAnchorName {
976		# Get arguments
977	my ($self, $aAnchorName) = @_;
978		# Set active anchor name
979	$self->{_activeAnchorName} = $aAnchorName;
980}  # _setActiveAnchorName()
981
982
983#--- HTML::TocGenerator::_showWarning() ---------------------------------------
984# function: Show warning.
985# args:     - aWarningNr: Number of warning to show.
986#           - aWarningArgs: Arguments to display within the warning.
987
988sub _showWarning {
989		# Get arguments
990	my ($self, $aWarningNr, $aWarningArgs) = @_;
991		# Local variables
992	my (%warnings);
993		# Set warnings
994	%warnings = (
995		WARNING_NESTED_ANCHOR_PS_WITHIN_PS()               =>
996			"Nested anchor '%s' within anchor '%s'.",
997		WARNING_TOC_ATTRIBUTE_PS_NOT_AVAILABLE_WITHIN_PS() =>
998			"ToC attribute '%s' not available within token '%s'.",
999	);
1000		# Show warning
1001	print STDERR "warning ($aWarningNr): " . sprintf($warnings{"$aWarningNr"}, @$aWarningArgs) . "\n";
1002}  # _showWarning()
1003
1004
1005#--- HTML::TocGenerator::anchorId() -------------------------------------------
1006# function: Anchor id processing method.  Leave it up to the descendant to do
1007#           something useful with it.
1008# args:     - $aAnchorId
1009#           - $aToc: Reference to ToC to which anchorId belongs.
1010
1011sub anchorId {
1012}  # anchorId()
1013
1014
1015#--- HTML::TocGenerator::anchorNameBegin() ------------------------------------
1016# function: Anchor name begin processing method.  Leave it up to the descendant
1017#           to do something useful with it.
1018# args:     - $aAnchorName
1019#           - $aToc: Reference to ToC to which anchorname belongs.
1020
1021sub anchorNameBegin {
1022}  # anchorNameBegin()
1023
1024
1025#--- HTML::TocGenerator::anchorNameEnd() --------------------------------------
1026# function: Anchor name end processing method.  Leave it up to the descendant
1027#           to do something useful with it.
1028# args:     - $aAnchorName
1029#           - $aToc: Reference to ToC to which anchorname belongs.
1030
1031sub anchorNameEnd {
1032}  # anchorNameEnd()
1033
1034
1035#--- HTML::TocGenerator::comment() --------------------------------------------
1036# function: Process comment.
1037# args:     - $aComment: comment text with '<!--' and '-->' tags stripped off.
1038
1039sub comment {
1040		# Get arguments
1041	my ($self, $aComment) = @_;
1042		# Must a ToC be generated?
1043	if ($self->{_doGenerateToc}) {
1044		# Yes, a ToC must be generated
1045			# Process end tag as ToC-starting-token
1046		$self->_processTokenAsTocStartingToken(
1047			TT_TOKENTYPE_COMMENT, $aComment, undef, \$aComment
1048		);
1049			# Process end tag as token which ends ToC registration
1050		$self->_processTokenAsTocEndingToken(
1051			TT_TOKENTYPE_COMMENT, $aComment
1052		);
1053	}
1054}  # comment()
1055
1056
1057#--- HTML::TocGenerator::end() ------------------------------------------------
1058# function: This function is called every time a closing tag is encountered.
1059# args:     - $aTag: tag name (in lower case).
1060#           - $aOrigText: tag name including brackets.
1061
1062sub end {
1063		# Get arguments
1064	my ($self, $aTag, $aOrigText) = @_;
1065		# Local variables
1066	my ($tag, $toc, $i);
1067		# Must a ToC be generated?
1068	if ($self->{_doGenerateToc}) {
1069		# Yes, a ToC must be generated
1070			# Process end tag as ToC-starting-token
1071		$self->_processTokenAsTocStartingToken(
1072			TT_TOKENTYPE_END, $aTag, undef, \$aOrigText
1073		);
1074			# Process end tag as ToC-ending-token
1075		$self->_processTokenAsTocEndingToken(
1076			TT_TOKENTYPE_END, $aTag
1077		);
1078			# Tag is of type 'anchor'?
1079		if (defined($self->{_activeAnchorName}) && ($aTag eq "a")) {
1080			# Yes, tag is of type 'anchor';
1081				# Reset dirty anchor
1082			$self->{_activeAnchorName} = undef;
1083		}
1084	}
1085}  # end()
1086
1087
1088#--- HTML::TocGenerator::extend() ---------------------------------------------
1089# function: Extend ToCs.
1090# args:     - $aTocs: Reference to array of ToC objects
1091#           - $aString: String to parse.
1092
1093sub extend {
1094		# Get arguments
1095	my ($self, $aTocs, $aString) = @_;
1096		# Initialize TocGenerator batch
1097	$self->_initializeExtenderBatch($aTocs);
1098		# Extend ToCs
1099	$self->_extend($aString);
1100		# Deinitialize TocGenerator batch
1101	$self->_deinitializeExtenderBatch();
1102}  # extend()
1103
1104
1105#--- HTML::TocGenerator::extendFromFile() -------------------------------------
1106# function: Extend ToCs.
1107# args:     - @aTocs: Reference to array of ToC objects
1108#           - @aFiles: Reference to array of files to parse.
1109
1110sub extendFromFile {
1111		# Get arguments
1112	my ($self, $aTocs, $aFiles) = @_;
1113		# Initialize TocGenerator batch
1114	$self->_initializeExtenderBatch($aTocs);
1115		# Extend ToCs
1116	$self->_extendFromFile($aFiles);
1117		# Deinitialize TocGenerator batch
1118	$self->_deinitializeExtenderBatch();
1119}  # extendFromFile()
1120
1121
1122#--- HTML::TocGenerator::generate() -------------------------------------------
1123# function: Generate ToC.
1124# args:     - $aToc: Reference to (array of) ToC object(s)
1125#           - $aString: Reference to string to parse
1126#           - $aOptions: optional options
1127
1128sub generate {
1129		# Get arguments
1130	my ($self, $aToc, $aString, $aOptions) = @_;
1131		# Initialize TocGenerator batch
1132	$self->_initializeGeneratorBatch($aToc, $aOptions);
1133		# Do generate ToC
1134	$self->_generate($aString);
1135		# Deinitialize TocGenerator batch
1136	$self->_deinitializeGeneratorBatch();
1137}  # generate()
1138
1139
1140#--- HTML::TocGenerator::generateFromFile() -----------------------------------
1141# function: Generate ToC.
1142# args:     - $aToc: Reference to (array of) ToC object(s)
1143#           - $aFile: (reference to array of) file to parse.
1144#           - $aOptions: optional options
1145
1146sub generateFromFile {
1147		# Get arguments
1148	my ($self, $aToc, $aFile, $aOptions) = @_;
1149		# Initialize TocGenerator batch
1150	$self->_initializeGeneratorBatch($aToc, $aOptions);
1151		# Do generate ToC
1152	$self->_generateFromFile($aFile);
1153		# Deinitialize TocGenerator batch
1154	$self->_deinitializeGeneratorBatch();
1155}  # generateFromFile()
1156
1157
1158#--- HTML::TocGenerator::number() ---------------------------------------------
1159# function: Heading number processing method.  Leave it up to the descendant
1160#           to do something useful with it.
1161# args:     - $aNumber
1162#           - $aToc: Reference to ToC to which anchorname belongs.
1163
1164sub number {
1165		# Get arguments
1166	my ($self, $aNumber, $aToc) = @_;
1167}  # number()
1168
1169
1170#--- HTML::TocGenerator::parse() ----------------------------------------------
1171# function: Parse scalar.
1172# args:     - $aString: string to parse
1173
1174sub parse {
1175		# Get arguments
1176	my ($self, $aString) = @_;
1177		# Call ancestor
1178	$self->SUPER::parse($aString);
1179}  # parse()
1180
1181
1182#--- HTML::TocGenerator::parse_file() -----------------------------------------
1183# function: Parse file.
1184
1185sub parse_file {
1186		# Get arguments
1187	my ($self, $aFile) = @_;
1188		# Call ancestor
1189	$self->SUPER::parse_file($aFile);
1190}  # parse_file()
1191
1192
1193#--- HTML::TocGenerator::setOptions() -----------------------------------------
1194# function: Set options.
1195# args:     - aOptions: Reference to hash containing options.
1196
1197sub setOptions {
1198		# Get arguments
1199	my ($self, $aOptions) = @_;
1200		# Options are defined?
1201	if (defined($aOptions)) {
1202		# Yes, options are defined; add to options
1203		%{$self->{options}} = (%{$self->{options}}, %$aOptions);
1204	}
1205}  # setOptions()
1206
1207
1208#--- HTML::TocGenerator::start() ----------------------------------------------
1209# function: This function is called every time an opening tag is encountered.
1210# args:     - $aTag: tag name (in lower case).
1211#           - $aAttr: reference to hash containing all tag attributes (in lower
1212#                case).
1213#           - $aAttrSeq: reference to array containing all tag attributes (in
1214#                lower case) in the original order
1215#           - $aOrigText: the original HTML text
1216
1217sub start {
1218		# Get arguments
1219	my ($self, $aTag, $aAttr, $aAttrSeq, $aOrigText) = @_;
1220	$self->{isTocToken} = 0;
1221		# Start tag is of type 'anchor name'?
1222	if ($aTag eq "a" && defined($aAttr->{name})) {
1223		# Yes, start tag is of type 'anchor name';
1224			# Is another anchor already active?
1225		if (defined($self->{_activeAnchorName})) {
1226			# Yes, another anchor is already active;
1227				# Is the first anchor inserted by 'TocGenerator'?
1228			if ($self->{_doOutputAnchorNameEnd}) {
1229				# Yes, the first anchor is inserted by 'TocGenerator';
1230					# Show warning
1231				$self->_showWarning(
1232					WARNING_NESTED_ANCHOR_PS_WITHIN_PS,
1233					[$aOrigText, $self->{_activeAnchorName}]
1234				);
1235			}
1236		}
1237			# Set active anchor name
1238		$self->_setActiveAnchorName($aAttr->{name});
1239	}
1240		# Must a ToC be generated?
1241	if ($self->{_doGenerateToc}) {
1242		# Yes, a ToC must be generated
1243			# Process start tag as ToC token
1244		$self->{isTocToken} = $self->_processTokenAsTocStartingToken(
1245			TT_TOKENTYPE_START, $aTag, $aAttr, \$aOrigText
1246		);
1247			# Process end tag as ToC-ending-token
1248		$self->_processTokenAsTocEndingToken(
1249			TT_TOKENTYPE_START, $aTag
1250		);
1251	}
1252}  # start()
1253
1254
1255#--- HTML::TocGenerator::text() -----------------------------------------------
1256# function: This function is called every time plain text is encountered.
1257# args:     - @_: array containing data.
1258
1259sub text {
1260		# Get arguments
1261	my ($self, $aText) = @_;
1262		# Local variables
1263	my ($text, $toc, $i, $token, $tokens);
1264		# Must a ToC be generated?
1265	if ($self->{_doGenerateToc}) {
1266		# Yes, a ToC must be generated
1267			# Are there dirty start tags?
1268
1269			# Loop through token types
1270		foreach $tokens (@{$self->{_tokensTocEnd}}) {
1271				# Loop though tokens
1272			foreach $token (@$tokens) {
1273					# Add text to toc
1274
1275					# Alias
1276				$toc = $token->[TT_TOC];
1277					# Remove possible newlines from text
1278				($text = $aText) =~ s/\s*\n\s*/ /g;
1279					# Add text to toc
1280				$self->_processTocText($text, $toc);
1281			}
1282		}
1283	}
1284}  # text()
1285
1286
1287
1288
1289#=== HTML::_TokenTocParser ====================================================
1290# function: Parse 'toc tokens'.  'Toc tokens' mark HTML code which is to be
1291#           inserted into the ToC.
1292# note:     Used internally.
1293
1294package HTML::_TokenTocParser;
1295
1296
1297BEGIN {
1298	use vars qw(@ISA);
1299
1300	@ISA = qw(HTML::Parser);
1301}
1302
1303
1304END {}
1305
1306
1307#--- HTML::_TokenTocParser::new() ---------------------------------------------
1308# function: Constructor
1309
1310sub new {
1311		# Get arguments
1312	my ($aType) = @_;
1313		# Create instance
1314	my $self = $aType->SUPER::new;
1315
1316		# Return instance
1317	return $self;
1318}  # new()
1319
1320
1321#--- HTML::_TokenTocParser::_parseAttributes() --------------------------------
1322# function: Parse attributes.
1323# args:     - $aAttr: Reference to hash containing all tag attributes (in lower
1324#                case).
1325#           - $aIncludeAttributes: Reference to hash to which 'include
1326#                attributes' must be added.
1327#           - $aExcludeAttributes: Reference to hash to which 'exclude
1328#                attributes' must be added.
1329#           - $aTocAttributes: Reference to hash to which 'ToC attributes'
1330#                must be added.
1331
1332sub _parseAttributes {
1333		# Get arguments
1334	my (
1335		$self, $aAttr, $aIncludeAttributes, $aExcludeAttributes,
1336		$aTocAttributes
1337	) = @_;
1338		# Local variables
1339	my ($key, $value);
1340	my ($attributeToExcludeToken, $attributeToTocToken);
1341		# Get token which marks attributes which must be excluded
1342	$attributeToExcludeToken = $self->{_toc}{options}{'attributeToExcludeToken'};
1343	$attributeToTocToken     = $self->{_toc}{options}{'attributeToTocToken'};
1344		# Loop through attributes
1345	while (($key, $value) = each %$aAttr) {
1346			# Attribute value equals 'ToC token'?
1347		if ($value =~ m/$attributeToTocToken/) {
1348			# Yes, attribute value equals 'ToC token';
1349				# Add attribute to 'ToC attributes'
1350			push @$aTocAttributes, $key;
1351		}
1352		else {
1353			# No, attribute isn't 'ToC' token;
1354				# Attribute value starts with 'exclude token'?
1355			if ($value =~ m/^$attributeToExcludeToken(.*)/) {
1356				# Yes, attribute value starts with 'exclude token';
1357					# Add attribute to 'exclude attributes'
1358				$$aExcludeAttributes{$key} = "$1";
1359			}
1360			else {
1361				# No, attribute key doesn't start with '-';
1362					# Add attribute to 'include attributes'
1363				$$aIncludeAttributes{$key} = $value;
1364			}
1365		}
1366	}
1367}  # _parseAttributes()
1368
1369
1370
1371
1372#=== HTML::_TokenTocBeginParser ===============================================
1373# function: Parse 'toc tokens'.  'Toc tokens' mark HTML code which is to be
1374#           inserted into the ToC.
1375# note:     Used internally.
1376
1377package HTML::_TokenTocBeginParser;
1378
1379
1380BEGIN {
1381	use vars qw(@ISA);
1382
1383	@ISA = qw(HTML::_TokenTocParser);
1384}
1385
1386END {}
1387
1388
1389#--- HTML::_TokenTocBeginParser::new() ----------------------------------------
1390# function: Constructor
1391
1392sub new {
1393		# Get arguments
1394	my ($aType, $aTokenArray) = @_;
1395		# Create instance
1396	my $self = $aType->SUPER::new;
1397		# Reference token array
1398	$self->{tokens} = $aTokenArray;
1399		# Reference to last added token
1400	$self->{_lastAddedToken}     = undef;
1401	$self->{_lastAddedTokenType} = undef;
1402		# Return instance
1403	return $self;
1404}  # new()
1405
1406
1407#--- HTML::_TokenTocBeginParser::_processAttributes() -------------------------
1408# function: Process attributes.
1409# args:     - $aAttributes: Attributes to parse.
1410
1411sub _processAttributes {
1412		# Get arguments
1413	my ($self, $aAttributes) = @_;
1414		# Local variables
1415	my (%includeAttributes, %excludeAttributes, @tocAttributes);
1416
1417		# Parse attributes
1418	$self->_parseAttributes(
1419		$aAttributes, \%includeAttributes, \%excludeAttributes, \@tocAttributes
1420	);
1421		# Include attributes are specified?
1422	if (keys(%includeAttributes) > 0) {
1423		# Yes, include attributes are specified;
1424			# Store include attributes
1425		@${$self->{_lastAddedToken}}[
1426			HTML::TocGenerator::TT_INCLUDE_ATTRIBUTES_BEGIN
1427		] = \%includeAttributes;
1428	}
1429		# Exclude attributes are specified?
1430	if (keys(%excludeAttributes) > 0) {
1431		# Yes, exclude attributes are specified;
1432			# Store exclude attributes
1433		@${$self->{_lastAddedToken}}[
1434			HTML::TocGenerator::TT_EXCLUDE_ATTRIBUTES_BEGIN
1435		] = \%excludeAttributes;
1436	}
1437		# Toc attributes are specified?
1438	if (@tocAttributes > 0) {
1439		# Yes, toc attributes are specified;
1440			# Store toc attributes
1441		@${$self->{_lastAddedToken}}[
1442			HTML::TocGenerator::TT_ATTRIBUTES_TOC
1443		] = \@tocAttributes;
1444	}
1445}  # _processAttributes()
1446
1447
1448#--- HTML::_TokenTocBeginParser::_processToken() ------------------------------
1449# function: Process token.
1450# args:     - $aTokenType: Type of token to process.
1451#           - $aTag: Tag of token.
1452
1453sub _processToken {
1454		# Get arguments
1455	my ($self, $aTokenType, $aTag) = @_;
1456		# Local variables
1457	my ($tokenArray, $index);
1458		# Push element on array of update tokens
1459	$index = push(@{$self->{tokens}[$aTokenType]}, []) - 1;
1460		# Alias token array to add element to
1461	$tokenArray = $self->{tokens}[$aTokenType];
1462		# Indicate last updated token array element
1463	$self->{_lastAddedTokenType} = $aTokenType;
1464	$self->{_lastAddedToken}     = \$$tokenArray[$index];
1465		# Add fields
1466	$$tokenArray[$index][HTML::TocGenerator::TT_TAG_BEGIN] = $aTag;
1467	$$tokenArray[$index][HTML::TocGenerator::TT_GROUP]     = $self->{_group};
1468	$$tokenArray[$index][HTML::TocGenerator::TT_TOC]       = $self->{_toc};
1469}  # _processToken()
1470
1471
1472#--- HTML::_TokenTocBeginParser::comment() ------------------------------------
1473# function: Process comment.
1474# args:     - $aComment: comment text with '<!--' and '-->' tags stripped off.
1475
1476sub comment {
1477		# Get arguments
1478	my ($self, $aComment) = @_;
1479		# Process token
1480	$self->_processToken(HTML::TocGenerator::TT_TOKENTYPE_COMMENT, $aComment);
1481}  # comment()
1482
1483
1484#--- HTML::_TokenTocBeginParser::declaration() --------------------------------
1485# function: This function is called every time a markup declaration is
1486#           encountered by HTML::Parser.
1487# args:     - $aDeclaration: Markup declaration.
1488
1489sub declaration {
1490		# Get arguments
1491	my ($self, $aDeclaration) = @_;
1492		# Process token
1493	$self->_processToken(
1494		HTML::TocGenerator::TT_TOKENTYPE_DECLARATION, $aDeclaration
1495	);
1496}  # declaration()
1497
1498
1499#--- HTML::_TokenTocBeginParser::end() ----------------------------------------
1500# function: This function is called every time a closing tag is encountered
1501#           by HTML::Parser.
1502# args:     - $aTag: tag name (in lower case).
1503
1504sub end {
1505		# Get arguments
1506	my ($self, $aTag, $aOrigText) = @_;
1507		# Process token
1508	$self->_processToken(HTML::TocGenerator::TT_TOKENTYPE_END, $aTag);
1509}  # end()
1510
1511
1512#--- HTML::_TokenTocBeginParser::parse() --------------------------------------
1513# function: Parse begin token.
1514# args:     - $aToken: 'toc token' to parse
1515
1516sub parse {
1517		# Get arguments
1518	my ($self, $aString) = @_;
1519		# Call ancestor
1520	$self->SUPER::parse($aString);
1521}  # parse()
1522
1523
1524#--- HTML::_TokenTocBeginParser->setGroup() -----------------------------------
1525# function: Set current 'tokenToToc' group.
1526
1527sub setGroup {
1528		# Get arguments
1529	my ($self, $aGroup) = @_;
1530		# Set current 'tokenToToc' group
1531	$self->{_group} = $aGroup;
1532}  # setGroup()
1533
1534
1535#--- HTML::_TokenTocBeginParser->setToc() -------------------------------------
1536# function: Set current ToC.
1537
1538sub setToc {
1539		# Get arguments
1540	my ($self, $aToc) = @_;
1541		# Set current ToC
1542	$self->{_toc} = $aToc;
1543}  # setToc()
1544
1545
1546#--- HTML::_TokenTocBeginParser::start() --------------------------------------
1547# function: This function is called every time an opening tag is encountered.
1548# args:     - $aTag: tag name (in lower case).
1549#           - $aAttr: reference to hash containing all tag attributes (in lower
1550#                case).
1551#           - $aAttrSeq: reference to array containing all attribute keys (in
1552#                lower case) in the original order
1553#           - $aOrigText: the original HTML text
1554
1555sub start {
1556		# Get arguments
1557	my ($self, $aTag, $aAttr, $aAttrSeq, $aOrigText) = @_;
1558		# Process token
1559	$self->_processToken(HTML::TocGenerator::TT_TOKENTYPE_START, $aTag);
1560		# Process attributes
1561	$self->_processAttributes($aAttr);
1562}  # start()
1563
1564
1565#--- HTML::_TokenTocBeginParser::text() ---------------------------------------
1566# function: This function is called every time plain text is encountered.
1567# args:     - @_: array containing data.
1568
1569sub text {
1570		# Get arguments
1571	my ($self, $aText) = @_;
1572		# Was token already created and is last added token of type 'text'?
1573	if (
1574		defined($self->{_lastAddedToken}) &&
1575		$self->{_lastAddedTokenType} == HTML::TocGenerator::TT_TOKENTYPE_TEXT
1576	) {
1577		# Yes, token is already created;
1578			# Add tag to existing token
1579		@${$self->{_lastAddedToken}}[HTML::TocGenerator::TT_TAG_BEGIN] .= $aText;
1580	}
1581	else {
1582		# No, token isn't created;
1583			# Process token
1584		$self->_processToken(HTML::TocGenerator::TT_TOKENTYPE_TEXT, $aText);
1585	}
1586}  # text()
1587
1588
1589
1590
1591#=== HTML::_TokenTocEndParser =================================================
1592# function: Parse 'toc tokens'.  'Toc tokens' mark HTML code which is to be
1593#           inserted into the ToC.
1594# note:     Used internally.
1595
1596package HTML::_TokenTocEndParser;
1597
1598
1599BEGIN {
1600	use vars qw(@ISA);
1601
1602	@ISA = qw(HTML::_TokenTocParser);
1603}
1604
1605
1606END {}
1607
1608
1609#--- HTML::_TokenTocEndParser::new() ------------------------------------------
1610# function: Constructor
1611# args:     - $aType: Class type.
1612
1613sub new {
1614		# Get arguments
1615	my ($aType) = @_;
1616		# Create instance
1617	my $self = $aType->SUPER::new;
1618		# Reference to last added token
1619	$self->{_lastAddedToken} = undef;
1620		# Return instance
1621	return $self;
1622}  # new()
1623
1624
1625#--- HTML::_TokenTocEndParser::_processAttributes() ---------------------------
1626# function: Process attributes.
1627# args:     - $aAttributes: Attributes to parse.
1628
1629sub _processAttributes {
1630		# Get arguments
1631	my ($self, $aAttributes) = @_;
1632		# Local variables
1633	my (%includeAttributes, %excludeAttributes);
1634
1635		# Parse attributes
1636	$self->_parseAttributes(
1637		$aAttributes, \%includeAttributes, \%excludeAttributes
1638	);
1639		# Include attributes are specified?
1640	if (keys(%includeAttributes) > 0) {
1641		# Yes, include attributes are specified;
1642			# Store include attributes
1643		@${$self->{_Token}}[
1644			HTML::TocGenerator::TT_INCLUDE_ATTRIBUTES_END
1645		] = \%includeAttributes;
1646	}
1647		# Exclude attributes are specified?
1648	if (keys(%excludeAttributes) > 0) {
1649		# Yes, exclude attributes are specified;
1650			# Store exclude attributes
1651		@${$self->{_Token}}[
1652			HTML::TocGenerator::TT_EXCLUDE_ATTRIBUTES_END
1653		] = \%excludeAttributes;
1654	}
1655}  # _processAttributes()
1656
1657
1658#--- HTML::_TokenTocEndParser::_processToken() --------------------------------
1659# function: Process token.
1660# args:     - $aTokenType: Type of token to process.
1661#           - $aTag: Tag of token.
1662
1663sub _processToken {
1664		# Get arguments
1665	my ($self, $aTokenType, $aTag) = @_;
1666		# Update token
1667	@${$self->{_token}}[HTML::TocGenerator::TT_TAG_TYPE_END] = $aTokenType;
1668	@${$self->{_token}}[HTML::TocGenerator::TT_TAG_END]      = $aTag;
1669		# Indicate token type which has been processed
1670	$self->{_lastAddedTokenType} = $aTokenType;
1671}  # _processToken()
1672
1673
1674#--- HTML::_TokenTocEndParser::comment() --------------------------------------
1675# function: Process comment.
1676# args:     - $aComment: comment text with '<!--' and '-->' tags stripped off.
1677
1678sub comment {
1679		# Get arguments
1680	my ($self, $aComment) = @_;
1681		# Process token
1682	$self->_processToken(HTML::TocGenerator::TT_TOKENTYPE_COMMENT, $aComment);
1683}  # comment()
1684
1685
1686#--- HTML::_TokenTocDeclarationParser::declaration() --------------------------
1687# function: This function is called every time a markup declaration is
1688#           encountered by HTML::Parser.
1689# args:     - $aDeclaration: Markup declaration.
1690
1691sub declaration {
1692		# Get arguments
1693	my ($self, $aDeclaration) = @_;
1694		# Process token
1695	$self->_processToken(
1696		HTML::TocGenerator::TT_TOKENTYPE_DECLARATION, $aDeclaration
1697	);
1698}  # declaration()
1699
1700
1701#--- HTML::_TokenTocEndParser::end() ------------------------------------------
1702# function: This function is called every time a closing tag is encountered
1703#           by HTML::Parser.
1704# args:     - $aTag: tag name (in lower case).
1705
1706sub end {
1707		# Get arguments
1708	my ($self, $aTag, $aOrigText) = @_;
1709		# Process token
1710	$self->_processToken(HTML::TocGenerator::TT_TOKENTYPE_END, $aTag);
1711}  # end()
1712
1713
1714#--- HTML::_TokenTocEndParser::parse() ----------------------------------------
1715# function: Parse token.
1716# args:     - $aString: 'toc token' to parse
1717#           - $aToken: Reference to token
1718#           - $aTokenTypeBegin: Type of begin token
1719
1720sub parse {
1721		# Get arguments
1722	my ($self, $aString, $aToken, $aTokenTypeBegin) = @_;
1723		# Token argument specified?
1724	if (defined($aToken)) {
1725		# Yes, token argument is specified;
1726			# Store token reference
1727		$self->{_token} = $aToken;
1728	}
1729		# End tag defined?
1730	if (! defined($aString)) {
1731		# No, end tag isn't defined;
1732			# Last added tokentype was of type 'start'?
1733		if (
1734			(defined($aTokenTypeBegin)) &&
1735			($aTokenTypeBegin == HTML::TocGenerator::TT_TOKENTYPE_START)
1736		) {
1737			# Yes, last added tokentype was of type 'start';
1738				# Assume end tag
1739			$self->_processToken(
1740				HTML::TocGenerator::TT_TAG_END,
1741				@${$self->{_token}}[HTML::TocGenerator::TT_TAG_BEGIN]
1742			);
1743		}
1744	}
1745	else {
1746			# Call ancestor
1747		$self->SUPER::parse($aString);
1748	}
1749}  # parse()
1750
1751
1752#--- HTML::_TokenTocEndParser::start() ----------------------------------------
1753# function: This function is called every time an opening tag is encountered.
1754# args:     - $aTag: tag name (in lower case).
1755#           - $aAttr: reference to hash containing all tag attributes (in lower
1756#                case).
1757#           - $aAttrSeq: reference to array containing all attribute keys (in
1758#                lower case) in the original order
1759#           - $aOrigText: the original HTML text
1760
1761sub start {
1762		# Get arguments
1763	my ($self, $aTag, $aAttr, $aAttrSeq, $aOrigText) = @_;
1764		# Process token
1765	$self->_processToken(HTML::TocGenerator::TT_TOKENTYPE_START, $aTag);
1766		# Process attributes
1767	$self->_processAttributes($aAttr);
1768}  # start()
1769
1770
1771#--- HTML::_TokenTocEndParser::text() -----------------------------------------
1772# function: This function is called every time plain text is encountered.
1773# args:     - @_: array containing data.
1774
1775sub text {
1776		# Get arguments
1777	my ($self, $aText) = @_;
1778
1779		# Is token already created?
1780	if (defined($self->{_lastAddedTokenType})) {
1781		# Yes, token is already created;
1782			# Add tag to existing token
1783		@${$self->{_token}}[HTML::TocGenerator::TT_TAG_END] .= $aText;
1784	}
1785	else {
1786		# No, token isn't created;
1787			# Process token
1788		$self->_processToken(HTML::TocGenerator::TT_TOKENTYPE_TEXT, $aText);
1789	}
1790}  # text()
1791
1792
17931;
1794