1#=== HTML::Toc ================================================================
2# function: HTML Table of Contents
3
4
5package HTML::Toc;
6
7
8use strict;
9
10
11BEGIN {
12	use vars qw($VERSION);
13
14	$VERSION = '0.91';
15}
16
17
18use constant FILE_FILTER             => '.*';
19use constant GROUP_ID_H              => 'h';
20use constant LEVEL_1                 => 1;
21use constant NUMBERING_STYLE_DECIMAL => 'decimal';
22
23	# Templates
24
25	# Anchor templates
26use constant TEMPLATE_ANCHOR_NAME       => '$groupId."-".$node';
27use constant TEMPLATE_ANCHOR_HREF_BEGIN       =>
28					'"<a href=#$anchorName>"';
29use constant TEMPLATE_ANCHOR_HREF_BEGIN_FILE  =>
30					'"<a href=$file#$anchorName>"';
31use constant TEMPLATE_ANCHOR_HREF_END         => '"</a>"';
32use constant TEMPLATE_ANCHOR_NAME_BEGIN =>
33					'"<a name=$anchorName>"';
34use constant TEMPLATE_ANCHOR_NAME_END   => '"</a>"';
35use constant TOKEN_UPDATE_BEGIN_OF_ANCHOR_NAME_BEGIN =>
36					'<!-- #BeginTocAnchorNameBegin -->';
37use constant TOKEN_UPDATE_END_OF_ANCHOR_NAME_BEGIN   =>
38					'<!-- #EndTocAnchorNameBegin -->';
39use constant TOKEN_UPDATE_BEGIN_OF_ANCHOR_NAME_END =>
40					'<!-- #BeginTocAnchorNameEnd -->';
41use constant TOKEN_UPDATE_END_OF_ANCHOR_NAME_END   =>
42					'<!-- #EndTocAnchorNameEnd -->';
43use constant TOKEN_UPDATE_BEGIN_NUMBER      =>
44					'<!-- #BeginTocNumber -->';
45use constant TOKEN_UPDATE_END_NUMBER        =>
46					'<!-- #EndTocNumber -->';
47use constant TOKEN_UPDATE_BEGIN_TOC         =>
48					'<!-- #BeginToc -->';
49use constant TOKEN_UPDATE_END_TOC           =>
50					'<!-- #EndToc -->';
51
52use constant TEMPLATE_TOKEN_NUMBER      => '"$node &nbsp;"';
53
54	# Level templates
55use constant TEMPLATE_LEVEL             => '"<li>$text\n"';
56use constant TEMPLATE_LEVEL_BEGIN       => '"<ul>\n"';
57use constant TEMPLATE_LEVEL_END         => '"</ul>\n"';
58
59
60END {}
61
62
63#--- HTML::Toc::new() ---------------------------------------------------------
64# function: Constructor
65
66sub new {
67		# Get arguments
68	my ($aType) = @_;
69		# Local variables
70	my $self;
71
72	$self = bless({}, $aType);
73		# Default to empty 'options' array
74	$self->{options} = {};
75		# Empty toc
76	$self->{_toc} = "";
77		# Hash reference to array for each groupId, each array element
78		# referring to the group of the level indicated by the array index.
79		# For example, with the default 'tokenGroups', '_levelGroups' would
80		# look like:
81		#
82		# {'h'} => [\$group1, \$group2, \$group3, \$group4, \$group5, \$group6];
83		#
84	$self->{_levelGroups} = undef;
85		# Set default options
86	$self->_setDefaults();
87	return $self;
88}  # new()
89
90
91#--- HTML::Toc::_compareLevels() ----------------------------------------------
92# function: Compare levels.
93# args:     - $aLevel: pointer to level
94#           - $aGroupLevel
95#           - $aPreviousLevel
96#           - $aPreviousGroupLevel
97# returns:  0 if new level equals previous level, 1 if new level exceeds
98#           previous level, -1 if new level is smaller then previous level.
99
100sub _compareLevels {
101		# Get arguments
102	my (
103		$self, $aLevel, $aPreviousLevel, $aGroupLevel, $aPreviousGroupLevel
104	) = @_;
105		# Local variables
106	my ($result);
107		# Levels equals?
108	if (
109		($aLevel == $aPreviousLevel) &&
110		($aGroupLevel == $aPreviousGroupLevel)
111	) {
112		# Yes, levels are equals;
113			# Indicate so
114		$result = 0;
115	}
116	else {
117		# No, levels differ;
118			# Bias to new level being smaller than previous level;
119		$result = -1;
120			# Must groups not be nested and do group levels differ?
121		if (
122			($self->{options}{'doNestGroup'} == 0) &&
123			($aGroupLevel != $aPreviousGroupLevel)
124		) {
125			# Yes, groups must be kept apart and the group levels differ;
126				# Level is greater than previous level?
127			if (
128				($aLevel > $aPreviousLevel)
129			) {
130				# Yes, level is greater than previous level;
131					# Indicate so
132				$result = 1;
133			}
134		}
135		else {
136			# No, group must be nested;
137				# Level is greater than previous level?
138			if (
139				($aLevel > $aPreviousLevel) ||
140				($aGroupLevel > $aPreviousGroupLevel)
141			) {
142				# Yes, level is greater than previous level;
143					# Indicate so
144				$result = 1;
145			}
146		}
147	}
148		# Return value
149	return $result;
150}  # _compareLevels()
151
152
153#--- HTML::TocGenerator::_formatLevelIndent() ---------------------------------
154# function: Format indent.
155# args:     - $aText: text to indent
156#           - $aLevel: Level.
157#           - $aGroupLevel: Group level.
158#           - $aAdd
159#           - $aGlobalLevel
160
161sub _formatLevelIndent {
162		# Get arguments
163	my ($self, $aText, $aAdd, $aGlobalLevel) = @_;
164		# Local variables
165	my ($levelIndent, $indent, $nrOfIndents);
166		# Alias indentation option
167	$levelIndent = $self->{options}{'levelIndent'}; #=~ s/[0-9]+/&/;
168		# Calculate number of indents
169	$nrOfIndents = ($aGlobalLevel + $aAdd) * $levelIndent;
170		# Assemble indents
171	$indent = pack("A$nrOfIndents");
172		# Return value
173	return $indent . $aText;
174}  # _formatLevelIndent()
175
176
177#--- HTML::Toc::_formatToc() --------------------------------------------------
178# function: Format ToC.
179# args:     - aPreviousLevel
180#           - aPreviousGroupLevel
181#           - aToc: ToC to format.
182#           - aHeaderLines
183# note:     Recursive function this is.
184
185sub _formatToc {
186		# Get arguments
187	my (
188		$self, $aPreviousLevel, $aPreviousGroupLevel, $aToc, $aHeaderLines,
189		$aGlobalLevel
190	) = @_;
191		# Local variables
192	my ($level, $groupLevel, $line, $groupId, $text, $compareStatus);
193	my ($anchorName, $globalLevel, $node, $sequenceNr);
194
195	LOOP: {
196			# Lines need processing?
197		while (scalar(@$aHeaderLines) > 0) {
198			# Yes, lines need processing;
199				# Get line
200			$line = shift @$aHeaderLines;
201
202				# Determine levels
203			($level, $groupLevel, $groupId, $node, $sequenceNr,
204			$anchorName, $text) = split(
205				/ /, $line, 7
206			);
207				# Must level and group be processed?
208			if (
209				($level =~ m/$self->{options}{'levelToToc'}/) &&
210				($groupId =~ m/$self->{options}{'groupToToc'}/)
211			) {
212				# Yes, level must be processed;
213					# Compare levels
214				$compareStatus = $self->_compareLevels(
215					$level, $aPreviousLevel, $groupLevel, $aPreviousGroupLevel
216				);
217
218				COMPARE_LEVELS: {
219
220						# Equals?
221					if ($compareStatus == 0) {
222						# Yes, levels are equal;
223							# Format level
224						$$aToc .= $self->_formatLevelIndent(
225							ref($self->{_templateLevel}) eq "CODE" ?
226								&{$self->{_templateLevel}}(
227									$level, $groupId, $node, $sequenceNr, $text
228								) :
229								eval($self->{_templateLevel}),
230							0, $aGlobalLevel
231						);
232					}
233
234						# Greater?
235					if ($compareStatus > 0) {
236						# Yes, new level is greater than previous level;
237							# Must level be single-stepped?
238						if (
239							$self->{options}{'doSingleStepLevel'} &&
240							($aPreviousLevel) &&
241							($level > $aPreviousLevel)
242						) {
243							# Yes, level must be single-stepped;
244								# Make sure, new level is increased one step only
245							$level = $aPreviousLevel + 1;
246						}
247							# Increase global level
248						$aGlobalLevel++;
249							# Format begin of level
250						$$aToc .= $self->_formatLevelIndent(
251							eval($self->{_templateLevelBegin}), -1, $aGlobalLevel
252						);
253							# Process line again
254						unshift @$aHeaderLines, $line;
255							# Assemble TOC (recursive) for next level
256						$self->_formatToc(
257							$level, $groupLevel, $aToc, $aHeaderLines, $aGlobalLevel
258						);
259							# Format end of level
260						$$aToc .= $self->_formatLevelIndent(
261							eval($self->{_templateLevelEnd}), -1, $aGlobalLevel
262						);
263							# Decrease global level
264						$aGlobalLevel--;
265							# Exit loop
266						last COMPARE_LEVELS;
267					}
268
269						# Smaller?
270					if ($compareStatus < 0) {
271						# Yes, new level is smaller than previous level;
272							# Process line again
273						unshift @$aHeaderLines, $line;
274							# End loop
275						last LOOP;
276					}
277				}
278			}
279		}
280	}
281}	# _formatToc()
282
283
284#--- HTML::Toc::_parseTokenGroups() -------------------------------------------
285# function: Parse token groups
286
287sub _parseTokenGroups {
288		# Get arguments
289	my ($self) = @_;
290		# Local variables
291	my ($group, $levelGroups, $numberingStyle);
292
293		# Clear any previous 'levelGroups'
294	$self->{_levelGroups} = undef;
295		# Determine default 'numberingStyle'
296	$numberingStyle = defined($self->{options}{'numberingStyle'}) ?
297		$self->{options}{'numberingStyle'} : NUMBERING_STYLE_DECIMAL;
298
299		# Loop through groups
300	foreach $group (@{$self->{options}{'tokenToToc'}}) {
301			# 'groupId' is specified?
302		if (! defined($group->{'groupId'})) {
303			# No, 'groupId' isn't specified;
304				# Set default groupId
305			$group->{'groupId'} = GROUP_ID_H;
306		}
307			# 'level' is specified?
308		if (! defined($group->{'level'})) {
309			# No, 'level' isn't specified;
310				# Set default level
311			$group->{'level'} = LEVEL_1;
312		}
313			# 'numberingStyle' is specified?
314		if (! defined($group->{'numberingStyle'})) {
315			# No, 'numberingStyle' isn't specified;
316				# Set default numberingStyle
317			$group->{'numberingStyle'} = $numberingStyle;
318		}
319			# Add group to '_levelGroups' variabele
320		$self->{_levelGroups}{$group->{'groupId'}}[$group->{'level'} - 1] =
321			$group;
322	}
323}  # _parseTokenGroups()
324
325
326#--- HTML::Toc::_setDefaults() ------------------------------------------------
327# function: Set default options.
328
329sub _setDefaults {
330		# Get arguments
331	my ($self) = @_;
332		# Set default options
333	$self->setOptions(
334		{
335			'attributeToExcludeToken' => '-',
336			'attributeToTocToken'     => '@',
337			'insertionPoint'          => 'after <body>',
338			'levelToToc'              => '.*',
339			'groupToToc'              => '.*',
340			'doNumberToken'           => 0,
341			'doLinkToFile'            => 0,
342			'doLinkToToken'           => 1,
343			'doLinkToId'              => 0,
344			'doSingleStepLevel'       => 1,
345			'linkUri'                 => '',
346			'levelIndent'             => 3,
347			'doNestGroup'             => 0,
348			'doUseExistingAnchors'    => 1,
349			'doUseExistingIds'        => 1,
350			'tokenToToc'              => [
351				{
352					'level'  => 1,
353					'tokenBegin' => '<h1>'
354				}, {
355					'level'  => 2,
356					'tokenBegin' => '<h2>'
357				}, {
358					'level'  => 3,
359					'tokenBegin' => '<h3>'
360				}, {
361					'level'  => 4,
362					'tokenBegin' => '<h4>'
363				}, {
364					'level'  => 5,
365					'tokenBegin' => '<h5>'
366				}, {
367					'level'  => 6,
368					'tokenBegin' => '<h6>'
369				}
370			],
371			'header'            =>
372				"\n<!-- Table of Contents generated by Perl - HTML::Toc -->\n",
373			'footer'            =>
374				"\n<!-- End of generated Table of Contents -->\n",
375		}
376	);
377}  # _setDefaults()
378
379
380#--- HTML::Toc::clear() -------------------------------------------------------
381# function: Clear ToC.
382
383sub clear {
384		# Get arguments
385	my ($self) = @_;
386		# Clear ToC
387	$self->{_toc}          = "";
388	$self->{toc}           = "";
389	$self->{groupIdLevels} = undef;
390	$self->{levels}        = undef;
391}   # clear()
392
393
394#--- HTML::Toc::format() ------------------------------------------------------
395# function: Format ToC.
396# returns:  Formatted ToC.
397
398sub format {
399		# Get arguments
400	my ($self) = @_;
401		# Local variables;
402	my $toc = "";
403	my @tocLines = split(/\r\n|\n/, $self->{_toc});
404		# Format table of contents
405	$self->_formatToc("0", "0", \$toc, \@tocLines, 0);
406		# Remove last newline
407	$toc =~ s/\n$//m;
408		# Add header & footer
409	$toc = $self->{options}{'header'} . $toc . $self->{options}{'footer'};
410		# Return value
411	return $toc;
412}	# format()
413
414
415#--- HTML::Toc::parseOptions() ------------------------------------------------
416# function: Parse options.
417
418sub parseOptions {
419		# Get arguments
420	my ($self) = @_;
421		# Alias options
422	my $options = $self->{options};
423
424		# Parse token groups
425	$self->_parseTokenGroups();
426
427		# Link ToC to tokens?
428	if ($self->{options}{'doLinkToToken'}) {
429		# Yes, link ToC to tokens;
430			# Determine anchor href template begin
431		$self->{_templateAnchorHrefBegin} =
432			defined($options->{'templateAnchorHrefBegin'}) ?
433				$options->{'templateAnchorHrefBegin'} :
434				$options->{'doLinkToFile'} ?
435					TEMPLATE_ANCHOR_HREF_BEGIN_FILE : TEMPLATE_ANCHOR_HREF_BEGIN;
436
437			# Determine anchor href template end
438		$self->{_templateAnchorHrefEnd} =
439			defined($options->{'templateAnchorHrefEnd'}) ?
440				$options->{'templateAnchorHrefEnd'} :
441				TEMPLATE_ANCHOR_HREF_END;
442
443			# Determine anchor name template
444		$self->{_templateAnchorName} =
445			defined($options->{'templateAnchorName'}) ?
446				$options->{'templateAnchorName'} :
447				TEMPLATE_ANCHOR_NAME;
448
449			# Determine anchor name template begin
450		$self->{_templateAnchorNameBegin} =
451			defined($options->{'templateAnchorNameBegin'}) ?
452				$options->{'templateAnchorNameBegin'} :
453				TEMPLATE_ANCHOR_NAME_BEGIN;
454
455			# Determine anchor name template end
456		$self->{_templateAnchorNameEnd} =
457			defined($options->{'templateAnchorNameEnd'}) ?
458				$options->{'templateAnchorNameEnd'} :
459				TEMPLATE_ANCHOR_NAME_END;
460	}
461
462		# Determine token number template
463	$self->{_templateTokenNumber} =
464		defined($options->{'templateTokenNumber'}) ?
465			$options->{'templateTokenNumber'} :
466			TEMPLATE_TOKEN_NUMBER;
467
468		# Determine level template
469	$self->{_templateLevel} =
470		defined($options->{'templateLevel'}) ?
471			$options->{'templateLevel'} :
472			TEMPLATE_LEVEL;
473
474		# Determine level begin template
475	$self->{_templateLevelBegin} =
476		defined($options->{'templateLevelBegin'}) ?
477			$options->{'templateLevelBegin'} :
478			TEMPLATE_LEVEL_BEGIN;
479
480		# Determine level end template
481	$self->{_templateLevelEnd} =
482		defined($options->{'templateLevelEnd'}) ?
483			$options->{'templateLevelEnd'} :
484			TEMPLATE_LEVEL_END;
485
486		# Determine 'anchor name begin' begin update token
487	$self->{_tokenUpdateBeginOfAnchorNameBegin} =
488		defined($options->{'tokenUpdateBeginOfAnchorNameBegin'}) ?
489			$options->{'tokenUpdateBeginOfAnchorNameBegin'} :
490			TOKEN_UPDATE_BEGIN_OF_ANCHOR_NAME_BEGIN;
491
492		# Determine 'anchor name begin' end update token
493	$self->{_tokenUpdateEndOfAnchorNameBegin} =
494		defined($options->{'tokenUpdateEndOfAnchorNameBegin'}) ?
495			$options->{'tokenUpdateEndOfAnchorNameBegin'} :
496			TOKEN_UPDATE_END_OF_ANCHOR_NAME_BEGIN;
497
498		# Determine 'anchor name end' begin update token
499	$self->{_tokenUpdateBeginOfAnchorNameEnd} =
500		defined($options->{'tokenUpdateBeginOfAnchorNameEnd'}) ?
501			$options->{'tokenUpdateBeginOfAnchorNameEnd'} :
502			TOKEN_UPDATE_BEGIN_OF_ANCHOR_NAME_END;
503
504		# Determine 'anchor name end' end update token
505	$self->{_tokenUpdateEndOfAnchorNameEnd} =
506		defined($options->{'tokenUpdateEndOfAnchorNameEnd'}) ?
507			$options->{'tokenUpdateEndOfAnchorNameEnd'} :
508			TOKEN_UPDATE_END_OF_ANCHOR_NAME_END;
509
510		# Determine number begin update token
511	$self->{_tokenUpdateBeginNumber} =
512		defined($options->{'tokenUpdateBeginNumber'}) ?
513			$options->{'tokenUpdateBeginNumber'} :
514			TOKEN_UPDATE_BEGIN_NUMBER;
515
516		# Determine number end update token
517	$self->{_tokenUpdateEndNumber} =
518		defined($options->{'tokenUpdateEndNumber'}) ?
519			$options->{'tokenUpdateEndNumber'} :
520			TOKEN_UPDATE_END_NUMBER;
521
522		# Determine toc begin update token
523	$self->{_tokenUpdateBeginToc} =
524		defined($options->{'tokenUpdateBeginToc'}) ?
525			$options->{'tokenUpdateBeginToc'} :
526			TOKEN_UPDATE_BEGIN_TOC;
527
528		# Determine toc end update token
529	$self->{_tokenUpdateEndToc} =
530		defined($options->{'tokenUpdateEndToc'}) ?
531			$options->{'tokenUpdateEndToc'} :
532			TOKEN_UPDATE_END_TOC;
533
534}  # parseOptions()
535
536
537#--- HTML::Toc::setOptions() --------------------------------------------------
538# function: Set options.
539# args:     - aOptions: Reference to hash containing options.
540
541sub setOptions {
542		# Get arguments
543	my ($self, $aOptions) = @_;
544		# Add options
545	%{$self->{options}} = (%{$self->{options}}, %$aOptions);
546}  # setOptions()
547
548
5491;
550