ref: e4e58ac4008728a657ee0a46d0a15aa645e47ddc
dir: /examples/includes/HTML-Toc-0.91/Toc.pm/
#=== 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;