550 lines
15 KiB
Perl
550 lines
15 KiB
Perl
#=== HTML::Toc ================================================================
|
|
# function: HTML Table of Contents
|
|
|
|
|
|
package HTML::Toc;
|
|
|
|
|
|
use strict;
|
|
|
|
|
|
BEGIN {
|
|
use vars qw($VERSION);
|
|
|
|
$VERSION = '0.91';
|
|
}
|
|
|
|
|
|
use constant FILE_FILTER => '.*';
|
|
use constant GROUP_ID_H => 'h';
|
|
use constant LEVEL_1 => 1;
|
|
use constant NUMBERING_STYLE_DECIMAL => 'decimal';
|
|
|
|
# Templates
|
|
|
|
# Anchor templates
|
|
use constant TEMPLATE_ANCHOR_NAME => '$groupId."-".$node';
|
|
use constant TEMPLATE_ANCHOR_HREF_BEGIN =>
|
|
'"<a href=#$anchorName>"';
|
|
use constant TEMPLATE_ANCHOR_HREF_BEGIN_FILE =>
|
|
'"<a href=$file#$anchorName>"';
|
|
use constant TEMPLATE_ANCHOR_HREF_END => '"</a>"';
|
|
use constant TEMPLATE_ANCHOR_NAME_BEGIN =>
|
|
'"<a name=$anchorName>"';
|
|
use constant TEMPLATE_ANCHOR_NAME_END => '"</a>"';
|
|
use constant TOKEN_UPDATE_BEGIN_OF_ANCHOR_NAME_BEGIN =>
|
|
'<!-- #BeginTocAnchorNameBegin -->';
|
|
use constant TOKEN_UPDATE_END_OF_ANCHOR_NAME_BEGIN =>
|
|
'<!-- #EndTocAnchorNameBegin -->';
|
|
use constant TOKEN_UPDATE_BEGIN_OF_ANCHOR_NAME_END =>
|
|
'<!-- #BeginTocAnchorNameEnd -->';
|
|
use constant TOKEN_UPDATE_END_OF_ANCHOR_NAME_END =>
|
|
'<!-- #EndTocAnchorNameEnd -->';
|
|
use constant TOKEN_UPDATE_BEGIN_NUMBER =>
|
|
'<!-- #BeginTocNumber -->';
|
|
use constant TOKEN_UPDATE_END_NUMBER =>
|
|
'<!-- #EndTocNumber -->';
|
|
use constant TOKEN_UPDATE_BEGIN_TOC =>
|
|
'<!-- #BeginToc -->';
|
|
use constant TOKEN_UPDATE_END_TOC =>
|
|
'<!-- #EndToc -->';
|
|
|
|
use constant TEMPLATE_TOKEN_NUMBER => '"$node "';
|
|
|
|
# Level templates
|
|
use constant TEMPLATE_LEVEL => '"<li>$text\n"';
|
|
use constant TEMPLATE_LEVEL_BEGIN => '"<ul>\n"';
|
|
use constant TEMPLATE_LEVEL_END => '"</ul>\n"';
|
|
|
|
|
|
END {}
|
|
|
|
|
|
#--- HTML::Toc::new() ---------------------------------------------------------
|
|
# function: Constructor
|
|
|
|
sub new {
|
|
# Get arguments
|
|
my ($aType) = @_;
|
|
# Local variables
|
|
my $self;
|
|
|
|
$self = bless({}, $aType);
|
|
# Default to empty 'options' array
|
|
$self->{options} = {};
|
|
# Empty toc
|
|
$self->{_toc} = "";
|
|
# Hash reference to array for each groupId, each array element
|
|
# referring to the group of the level indicated by the array index.
|
|
# For example, with the default 'tokenGroups', '_levelGroups' would
|
|
# look like:
|
|
#
|
|
# {'h'} => [\$group1, \$group2, \$group3, \$group4, \$group5, \$group6];
|
|
#
|
|
$self->{_levelGroups} = undef;
|
|
# Set default options
|
|
$self->_setDefaults();
|
|
return $self;
|
|
} # new()
|
|
|
|
|
|
#--- HTML::Toc::_compareLevels() ----------------------------------------------
|
|
# function: Compare levels.
|
|
# args: - $aLevel: pointer to level
|
|
# - $aGroupLevel
|
|
# - $aPreviousLevel
|
|
# - $aPreviousGroupLevel
|
|
# returns: 0 if new level equals previous level, 1 if new level exceeds
|
|
# previous level, -1 if new level is smaller then previous level.
|
|
|
|
sub _compareLevels {
|
|
# Get arguments
|
|
my (
|
|
$self, $aLevel, $aPreviousLevel, $aGroupLevel, $aPreviousGroupLevel
|
|
) = @_;
|
|
# Local variables
|
|
my ($result);
|
|
# Levels equals?
|
|
if (
|
|
($aLevel == $aPreviousLevel) &&
|
|
($aGroupLevel == $aPreviousGroupLevel)
|
|
) {
|
|
# Yes, levels are equals;
|
|
# Indicate so
|
|
$result = 0;
|
|
}
|
|
else {
|
|
# No, levels differ;
|
|
# Bias to new level being smaller than previous level;
|
|
$result = -1;
|
|
# Must groups not be nested and do group levels differ?
|
|
if (
|
|
($self->{options}{'doNestGroup'} == 0) &&
|
|
($aGroupLevel != $aPreviousGroupLevel)
|
|
) {
|
|
# Yes, groups must be kept apart and the group levels differ;
|
|
# Level is greater than previous level?
|
|
if (
|
|
($aLevel > $aPreviousLevel)
|
|
) {
|
|
# Yes, level is greater than previous level;
|
|
# Indicate so
|
|
$result = 1;
|
|
}
|
|
}
|
|
else {
|
|
# No, group must be nested;
|
|
# Level is greater than previous level?
|
|
if (
|
|
($aLevel > $aPreviousLevel) ||
|
|
($aGroupLevel > $aPreviousGroupLevel)
|
|
) {
|
|
# Yes, level is greater than previous level;
|
|
# Indicate so
|
|
$result = 1;
|
|
}
|
|
}
|
|
}
|
|
# Return value
|
|
return $result;
|
|
} # _compareLevels()
|
|
|
|
|
|
#--- HTML::TocGenerator::_formatLevelIndent() ---------------------------------
|
|
# function: Format indent.
|
|
# args: - $aText: text to indent
|
|
# - $aLevel: Level.
|
|
# - $aGroupLevel: Group level.
|
|
# - $aAdd
|
|
# - $aGlobalLevel
|
|
|
|
sub _formatLevelIndent {
|
|
# Get arguments
|
|
my ($self, $aText, $aAdd, $aGlobalLevel) = @_;
|
|
# Local variables
|
|
my ($levelIndent, $indent, $nrOfIndents);
|
|
# Alias indentation option
|
|
$levelIndent = $self->{options}{'levelIndent'}; #=~ s/[0-9]+/&/;
|
|
# Calculate number of indents
|
|
$nrOfIndents = ($aGlobalLevel + $aAdd) * $levelIndent;
|
|
# Assemble indents
|
|
$indent = pack("A$nrOfIndents");
|
|
# Return value
|
|
return $indent . $aText;
|
|
} # _formatLevelIndent()
|
|
|
|
|
|
#--- HTML::Toc::_formatToc() --------------------------------------------------
|
|
# function: Format ToC.
|
|
# args: - aPreviousLevel
|
|
# - aPreviousGroupLevel
|
|
# - aToc: ToC to format.
|
|
# - aHeaderLines
|
|
# note: Recursive function this is.
|
|
|
|
sub _formatToc {
|
|
# Get arguments
|
|
my (
|
|
$self, $aPreviousLevel, $aPreviousGroupLevel, $aToc, $aHeaderLines,
|
|
$aGlobalLevel
|
|
) = @_;
|
|
# Local variables
|
|
my ($level, $groupLevel, $line, $groupId, $text, $compareStatus);
|
|
my ($anchorName, $globalLevel, $node, $sequenceNr);
|
|
|
|
LOOP: {
|
|
# Lines need processing?
|
|
while (scalar(@$aHeaderLines) > 0) {
|
|
# Yes, lines need processing;
|
|
# Get line
|
|
$line = shift @$aHeaderLines;
|
|
|
|
# Determine levels
|
|
($level, $groupLevel, $groupId, $node, $sequenceNr,
|
|
$anchorName, $text) = split(
|
|
/ /, $line, 7
|
|
);
|
|
# Must level and group be processed?
|
|
if (
|
|
($level =~ m/$self->{options}{'levelToToc'}/) &&
|
|
($groupId =~ m/$self->{options}{'groupToToc'}/)
|
|
) {
|
|
# Yes, level must be processed;
|
|
# Compare levels
|
|
$compareStatus = $self->_compareLevels(
|
|
$level, $aPreviousLevel, $groupLevel, $aPreviousGroupLevel
|
|
);
|
|
|
|
COMPARE_LEVELS: {
|
|
|
|
# Equals?
|
|
if ($compareStatus == 0) {
|
|
# Yes, levels are equal;
|
|
# Format level
|
|
$$aToc .= $self->_formatLevelIndent(
|
|
ref($self->{_templateLevel}) eq "CODE" ?
|
|
&{$self->{_templateLevel}}(
|
|
$level, $groupId, $node, $sequenceNr, $text
|
|
) :
|
|
eval($self->{_templateLevel}),
|
|
0, $aGlobalLevel
|
|
);
|
|
}
|
|
|
|
# Greater?
|
|
if ($compareStatus > 0) {
|
|
# Yes, new level is greater than previous level;
|
|
# Must level be single-stepped?
|
|
if (
|
|
$self->{options}{'doSingleStepLevel'} &&
|
|
($aPreviousLevel) &&
|
|
($level > $aPreviousLevel)
|
|
) {
|
|
# Yes, level must be single-stepped;
|
|
# Make sure, new level is increased one step only
|
|
$level = $aPreviousLevel + 1;
|
|
}
|
|
# Increase global level
|
|
$aGlobalLevel++;
|
|
# Format begin of level
|
|
$$aToc .= $self->_formatLevelIndent(
|
|
eval($self->{_templateLevelBegin}), -1, $aGlobalLevel
|
|
);
|
|
# Process line again
|
|
unshift @$aHeaderLines, $line;
|
|
# Assemble TOC (recursive) for next level
|
|
$self->_formatToc(
|
|
$level, $groupLevel, $aToc, $aHeaderLines, $aGlobalLevel
|
|
);
|
|
# Format end of level
|
|
$$aToc .= $self->_formatLevelIndent(
|
|
eval($self->{_templateLevelEnd}), -1, $aGlobalLevel
|
|
);
|
|
# Decrease global level
|
|
$aGlobalLevel--;
|
|
# Exit loop
|
|
last COMPARE_LEVELS;
|
|
}
|
|
|
|
# Smaller?
|
|
if ($compareStatus < 0) {
|
|
# Yes, new level is smaller than previous level;
|
|
# Process line again
|
|
unshift @$aHeaderLines, $line;
|
|
# End loop
|
|
last LOOP;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
} # _formatToc()
|
|
|
|
|
|
#--- HTML::Toc::_parseTokenGroups() -------------------------------------------
|
|
# function: Parse token groups
|
|
|
|
sub _parseTokenGroups {
|
|
# Get arguments
|
|
my ($self) = @_;
|
|
# Local variables
|
|
my ($group, $levelGroups, $numberingStyle);
|
|
|
|
# Clear any previous 'levelGroups'
|
|
$self->{_levelGroups} = undef;
|
|
# Determine default 'numberingStyle'
|
|
$numberingStyle = defined($self->{options}{'numberingStyle'}) ?
|
|
$self->{options}{'numberingStyle'} : NUMBERING_STYLE_DECIMAL;
|
|
|
|
# Loop through groups
|
|
foreach $group (@{$self->{options}{'tokenToToc'}}) {
|
|
# 'groupId' is specified?
|
|
if (! defined($group->{'groupId'})) {
|
|
# No, 'groupId' isn't specified;
|
|
# Set default groupId
|
|
$group->{'groupId'} = GROUP_ID_H;
|
|
}
|
|
# 'level' is specified?
|
|
if (! defined($group->{'level'})) {
|
|
# No, 'level' isn't specified;
|
|
# Set default level
|
|
$group->{'level'} = LEVEL_1;
|
|
}
|
|
# 'numberingStyle' is specified?
|
|
if (! defined($group->{'numberingStyle'})) {
|
|
# No, 'numberingStyle' isn't specified;
|
|
# Set default numberingStyle
|
|
$group->{'numberingStyle'} = $numberingStyle;
|
|
}
|
|
# Add group to '_levelGroups' variabele
|
|
$self->{_levelGroups}{$group->{'groupId'}}[$group->{'level'} - 1] =
|
|
$group;
|
|
}
|
|
} # _parseTokenGroups()
|
|
|
|
|
|
#--- HTML::Toc::_setDefaults() ------------------------------------------------
|
|
# function: Set default options.
|
|
|
|
sub _setDefaults {
|
|
# Get arguments
|
|
my ($self) = @_;
|
|
# Set default options
|
|
$self->setOptions(
|
|
{
|
|
'attributeToExcludeToken' => '-',
|
|
'attributeToTocToken' => '@',
|
|
'insertionPoint' => 'after <body>',
|
|
'levelToToc' => '.*',
|
|
'groupToToc' => '.*',
|
|
'doNumberToken' => 0,
|
|
'doLinkToFile' => 0,
|
|
'doLinkToToken' => 1,
|
|
'doLinkToId' => 0,
|
|
'doSingleStepLevel' => 1,
|
|
'linkUri' => '',
|
|
'levelIndent' => 3,
|
|
'doNestGroup' => 0,
|
|
'doUseExistingAnchors' => 1,
|
|
'doUseExistingIds' => 1,
|
|
'tokenToToc' => [
|
|
{
|
|
'level' => 1,
|
|
'tokenBegin' => '<h1>'
|
|
}, {
|
|
'level' => 2,
|
|
'tokenBegin' => '<h2>'
|
|
}, {
|
|
'level' => 3,
|
|
'tokenBegin' => '<h3>'
|
|
}, {
|
|
'level' => 4,
|
|
'tokenBegin' => '<h4>'
|
|
}, {
|
|
'level' => 5,
|
|
'tokenBegin' => '<h5>'
|
|
}, {
|
|
'level' => 6,
|
|
'tokenBegin' => '<h6>'
|
|
}
|
|
],
|
|
'header' =>
|
|
"\n<!-- Table of Contents generated by Perl - HTML::Toc -->\n",
|
|
'footer' =>
|
|
"\n<!-- End of generated Table of Contents -->\n",
|
|
}
|
|
);
|
|
} # _setDefaults()
|
|
|
|
|
|
#--- HTML::Toc::clear() -------------------------------------------------------
|
|
# function: Clear ToC.
|
|
|
|
sub clear {
|
|
# Get arguments
|
|
my ($self) = @_;
|
|
# Clear ToC
|
|
$self->{_toc} = "";
|
|
$self->{toc} = "";
|
|
$self->{groupIdLevels} = undef;
|
|
$self->{levels} = undef;
|
|
} # clear()
|
|
|
|
|
|
#--- HTML::Toc::format() ------------------------------------------------------
|
|
# function: Format ToC.
|
|
# returns: Formatted ToC.
|
|
|
|
sub format {
|
|
# Get arguments
|
|
my ($self) = @_;
|
|
# Local variables;
|
|
my $toc = "";
|
|
my @tocLines = split(/\r\n|\n/, $self->{_toc});
|
|
# Format table of contents
|
|
$self->_formatToc("0", "0", \$toc, \@tocLines, 0);
|
|
# Remove last newline
|
|
$toc =~ s/\n$//m;
|
|
# Add header & footer
|
|
$toc = $self->{options}{'header'} . $toc . $self->{options}{'footer'};
|
|
# Return value
|
|
return $toc;
|
|
} # format()
|
|
|
|
|
|
#--- HTML::Toc::parseOptions() ------------------------------------------------
|
|
# function: Parse options.
|
|
|
|
sub parseOptions {
|
|
# Get arguments
|
|
my ($self) = @_;
|
|
# Alias options
|
|
my $options = $self->{options};
|
|
|
|
# Parse token groups
|
|
$self->_parseTokenGroups();
|
|
|
|
# Link ToC to tokens?
|
|
if ($self->{options}{'doLinkToToken'}) {
|
|
# Yes, link ToC to tokens;
|
|
# Determine anchor href template begin
|
|
$self->{_templateAnchorHrefBegin} =
|
|
defined($options->{'templateAnchorHrefBegin'}) ?
|
|
$options->{'templateAnchorHrefBegin'} :
|
|
$options->{'doLinkToFile'} ?
|
|
TEMPLATE_ANCHOR_HREF_BEGIN_FILE : TEMPLATE_ANCHOR_HREF_BEGIN;
|
|
|
|
# Determine anchor href template end
|
|
$self->{_templateAnchorHrefEnd} =
|
|
defined($options->{'templateAnchorHrefEnd'}) ?
|
|
$options->{'templateAnchorHrefEnd'} :
|
|
TEMPLATE_ANCHOR_HREF_END;
|
|
|
|
# Determine anchor name template
|
|
$self->{_templateAnchorName} =
|
|
defined($options->{'templateAnchorName'}) ?
|
|
$options->{'templateAnchorName'} :
|
|
TEMPLATE_ANCHOR_NAME;
|
|
|
|
# Determine anchor name template begin
|
|
$self->{_templateAnchorNameBegin} =
|
|
defined($options->{'templateAnchorNameBegin'}) ?
|
|
$options->{'templateAnchorNameBegin'} :
|
|
TEMPLATE_ANCHOR_NAME_BEGIN;
|
|
|
|
# Determine anchor name template end
|
|
$self->{_templateAnchorNameEnd} =
|
|
defined($options->{'templateAnchorNameEnd'}) ?
|
|
$options->{'templateAnchorNameEnd'} :
|
|
TEMPLATE_ANCHOR_NAME_END;
|
|
}
|
|
|
|
# Determine token number template
|
|
$self->{_templateTokenNumber} =
|
|
defined($options->{'templateTokenNumber'}) ?
|
|
$options->{'templateTokenNumber'} :
|
|
TEMPLATE_TOKEN_NUMBER;
|
|
|
|
# Determine level template
|
|
$self->{_templateLevel} =
|
|
defined($options->{'templateLevel'}) ?
|
|
$options->{'templateLevel'} :
|
|
TEMPLATE_LEVEL;
|
|
|
|
# Determine level begin template
|
|
$self->{_templateLevelBegin} =
|
|
defined($options->{'templateLevelBegin'}) ?
|
|
$options->{'templateLevelBegin'} :
|
|
TEMPLATE_LEVEL_BEGIN;
|
|
|
|
# Determine level end template
|
|
$self->{_templateLevelEnd} =
|
|
defined($options->{'templateLevelEnd'}) ?
|
|
$options->{'templateLevelEnd'} :
|
|
TEMPLATE_LEVEL_END;
|
|
|
|
# Determine 'anchor name begin' begin update token
|
|
$self->{_tokenUpdateBeginOfAnchorNameBegin} =
|
|
defined($options->{'tokenUpdateBeginOfAnchorNameBegin'}) ?
|
|
$options->{'tokenUpdateBeginOfAnchorNameBegin'} :
|
|
TOKEN_UPDATE_BEGIN_OF_ANCHOR_NAME_BEGIN;
|
|
|
|
# Determine 'anchor name begin' end update token
|
|
$self->{_tokenUpdateEndOfAnchorNameBegin} =
|
|
defined($options->{'tokenUpdateEndOfAnchorNameBegin'}) ?
|
|
$options->{'tokenUpdateEndOfAnchorNameBegin'} :
|
|
TOKEN_UPDATE_END_OF_ANCHOR_NAME_BEGIN;
|
|
|
|
# Determine 'anchor name end' begin update token
|
|
$self->{_tokenUpdateBeginOfAnchorNameEnd} =
|
|
defined($options->{'tokenUpdateBeginOfAnchorNameEnd'}) ?
|
|
$options->{'tokenUpdateBeginOfAnchorNameEnd'} :
|
|
TOKEN_UPDATE_BEGIN_OF_ANCHOR_NAME_END;
|
|
|
|
# Determine 'anchor name end' end update token
|
|
$self->{_tokenUpdateEndOfAnchorNameEnd} =
|
|
defined($options->{'tokenUpdateEndOfAnchorNameEnd'}) ?
|
|
$options->{'tokenUpdateEndOfAnchorNameEnd'} :
|
|
TOKEN_UPDATE_END_OF_ANCHOR_NAME_END;
|
|
|
|
# Determine number begin update token
|
|
$self->{_tokenUpdateBeginNumber} =
|
|
defined($options->{'tokenUpdateBeginNumber'}) ?
|
|
$options->{'tokenUpdateBeginNumber'} :
|
|
TOKEN_UPDATE_BEGIN_NUMBER;
|
|
|
|
# Determine number end update token
|
|
$self->{_tokenUpdateEndNumber} =
|
|
defined($options->{'tokenUpdateEndNumber'}) ?
|
|
$options->{'tokenUpdateEndNumber'} :
|
|
TOKEN_UPDATE_END_NUMBER;
|
|
|
|
# Determine toc begin update token
|
|
$self->{_tokenUpdateBeginToc} =
|
|
defined($options->{'tokenUpdateBeginToc'}) ?
|
|
$options->{'tokenUpdateBeginToc'} :
|
|
TOKEN_UPDATE_BEGIN_TOC;
|
|
|
|
# Determine toc end update token
|
|
$self->{_tokenUpdateEndToc} =
|
|
defined($options->{'tokenUpdateEndToc'}) ?
|
|
$options->{'tokenUpdateEndToc'} :
|
|
TOKEN_UPDATE_END_TOC;
|
|
|
|
} # parseOptions()
|
|
|
|
|
|
#--- HTML::Toc::setOptions() --------------------------------------------------
|
|
# function: Set options.
|
|
# args: - aOptions: Reference to hash containing options.
|
|
|
|
sub setOptions {
|
|
# Get arguments
|
|
my ($self, $aOptions) = @_;
|
|
# Add options
|
|
%{$self->{options}} = (%{$self->{options}}, %$aOptions);
|
|
} # setOptions()
|
|
|
|
|
|
1;
|