ref: 1b27e93cd13ff60798e31634ddb362fa7aa9749d
dir: /examples/includes/HTML-Toc-0.91/TocGenerator.pm/
#=== HTML::TocGenerator =======================================================
# function: Generate 'HTML::Toc' table of contents.
# note: - 'TT' is an abbrevation of 'TocToken'.
package HTML::TocGenerator;
use strict;
use HTML::Parser;
BEGIN {
use vars qw(@ISA $VERSION);
$VERSION = '0.91';
@ISA = qw(HTML::Parser);
}
# Warnings
use constant WARNING_NESTED_ANCHOR_PS_WITHIN_PS => 1;
use constant WARNING_TOC_ATTRIBUTE_PS_NOT_AVAILABLE_WITHIN_PS => 2;
use constant TOC_TOKEN_ID => 0;
use constant TOC_TOKEN_INCLUDE => 1;
use constant TOC_TOKEN_EXCLUDE => 2;
use constant TOC_TOKEN_TOKENS => 3;
use constant TOC_TOKEN_GROUP => 4;
use constant TOC_TOKEN_TOC => 5;
# Token types
use constant TT_TAG_BEGIN => 0;
use constant TT_TAG_END => 1;
use constant TT_TAG_TYPE_END => 2;
use constant TT_INCLUDE_ATTRIBUTES_BEGIN => 3;
use constant TT_EXCLUDE_ATTRIBUTES_BEGIN => 4;
use constant TT_INCLUDE_ATTRIBUTES_END => 5;
use constant TT_EXCLUDE_ATTRIBUTES_END => 6;
use constant TT_GROUP => 7;
use constant TT_TOC => 8;
use constant TT_ATTRIBUTES_TOC => 9;
use constant CONTAINMENT_INCLUDE => 0;
use constant CONTAINMENT_EXCLUDE => 1;
use constant TEMPLATE_ANCHOR => '$groupId."-".$node';
use constant TEMPLATE_ANCHOR_HREF =>
'"<a href=#".' . TEMPLATE_ANCHOR . '.">"';
use constant TEMPLATE_ANCHOR_HREF_FILE =>
'"<a href=".$file."#".' . TEMPLATE_ANCHOR . '.">"';
use constant TEMPLATE_ANCHOR_NAME =>
'"<a name=".' . TEMPLATE_ANCHOR . '.">"';
use constant TEMPLATE_TOKEN_NUMBER => '"$node  "';
use constant TT_TOKENTYPE_START => 0;
use constant TT_TOKENTYPE_END => 1;
use constant TT_TOKENTYPE_TEXT => 2;
use constant TT_TOKENTYPE_COMMENT => 3;
use constant TT_TOKENTYPE_DECLARATION => 4;
END {}
#--- HTML::TocGenerator::new() ------------------------------------------------
# function: Constructor
sub new {
# Get arguments
my ($aType) = @_;
my $self = $aType->SUPER::new;
# Bias to not generate ToC
$self->{_doGenerateToc} = 0;
# Bias to not use global groups
$self->{_doUseGroupsGlobal} = 0;
# Output
$self->{output} = "";
# Reset internal variables
$self->_resetBatchVariables();
$self->{options} = {};
return $self;
} # new()
#--- HTML::TocGenerator::_deinitializeBatch() ---------------------------------
sub _deinitializeBatch() {
# Get arguments
my ($self) = @_;
} # _deinitializeBatch()
#--- HTML::TocGenerator::_deinitializeExtenderBatch() -------------------------
sub _deinitializeExtenderBatch() {
# Get arguments
my ($self) = @_;
# Do general batch deinitialization
$self->_deinitializeBatch();
# Indicate end of ToC generation
$self->{_doGenerateToc} = 0;
# Reset batch variables
$self->_resetBatchVariables();
} # _deinitializeExtenderBatch()
#--- HTML::TocGenerator::_deinitializeGeneratorBatch() ------------------------
sub _deinitializeGeneratorBatch() {
# Get arguments
my ($self) = @_;
# Do 'extender' batch deinitialization
$self->_deinitializeExtenderBatch();
} # _deinitializeBatchGenerator()
#--- HTML::TocGenerator::_doesHashContainHash() -------------------------------
# function: Determines whether hash1 matches regular expressions of hash2.
# args: - $aHash1
# - $aHash2
# - $aContainmentType: 0 (include) or 1 (exclude)
# returns: True (1) if hash1 satisfies hash2, 0 if not. For example, with the
# following hashes:
#
# %hash1 = { %hash2 = {
# 'class' => 'header' 'class' => '^h'
# 'id' => 'intro' }
# }
#
# the routine will return 1 if 'aContainmentType' equals 0, cause
# 'hash1' satisfies the conditions of 'hash2'. The routine will
# return 0 if 'aContainmentType' equals 1, cause 'hash1' doesn't
# exclude the conditions of 'hash2'.
# note: Class function.
sub _doesHashContainHash {
# Get arguments
my ($aHash1, $aHash2, $aContainmentType) = @_;
# Local variables
my ($key1, $value1, $key2, $value2, $result);
# Bias to success
$result = 1;
# Loop through hash2
HASH2: while (($key2, $value2) = each %$aHash2) {
# Yes, values are available;
# Get value1
$value1 = $aHash1->{$key2};
# Does value1 match criteria of value2?
if (defined($value1) && $value1 =~ m/$value2/) {
# Yes, value1 matches criteria of value2;
# Containment type was exclude?
if ($aContainmentType == CONTAINMENT_EXCLUDE) {
# Yes, containment type was exclude;
# Indicate condition fails
$result = 0;
# Reset 'each' iterator which we're going to break
keys %$aHash2;
# Break loop
last HASH2;
}
}
else {
# No, value1 didn't match criteria of value2;
# Containment type was include?
if ($aContainmentType == CONTAINMENT_INCLUDE) {
# Yes, containment type was include;
# Indicate condition fails
$result = 0;
# Reset 'each' iterator which we're going to break
keys %$aHash2;
# Break loop
last HASH2;
}
}
}
# Return value
return $result;
} # _doesHashContainHash()
#--- HTML::TocGenerator::_extend() --------------------------------------------
# function: Extend ToC.
# - $aString: String to parse.
sub _extend {
# Get arguments
my ($self, $aFile) = @_;
# Local variables
my ($file);
# Parse string
$self->parse($aFile);
# Flush remaining buffered text
$self->eof();
} # _extend()
#--- HTML::TocGenerator::_extendFromFile() ------------------------------------
# function: Extend ToC.
# - $aFile: (reference to array of) file to parse.
sub _extendFromFile {
# Get arguments
my ($self, $aFile) = @_;
# Local variables
my ($file, @files);
# Dereference array reference or make array of file specification
@files = (ref($aFile) =~ m/ARRAY/) ? @$aFile : ($aFile);
# Loop through files
foreach $file (@files) {
# Store filename
$self->{_currentFile} = $file;
# Parse file
$self->parse_file($file);
# Flush remaining buffered text
$self->eof();
}
} # _extendFromFile()
#--- HTML::TocGenerator::_formatHeadingLevel() --------------------------------
# function: Format heading level.
# args: - $aLevel: Level of current heading
# - $aClass: Class of current heading
# - $aGroup: Group of current heading
# - $aToc: Toc of current heading
sub _formatHeadingLevel {
# Get arguments
my ($self, $aLevel, $aClass, $aGroup, $aToc) = @_;
# Local variables
my ($result, $headingNumber, $numberingStyle);
$headingNumber = $self->_getGroupIdManager($aToc)->
{levels}{$aClass}[$aLevel - 1] || 0;
# Alias numbering style of current group
$numberingStyle = $aGroup->{numberingStyle};
SWITCH: {
if ($numberingStyle eq "decimal") {
$result = $headingNumber;
last SWITCH;
}
if ($numberingStyle eq "lower-alpha") {
$result = chr($headingNumber + ord('a') - 1);
last SWITCH;
}
if ($numberingStyle eq "upper-alpha") {
$result = chr($headingNumber + ord('A') - 1);
last SWITCH;
}
if ($numberingStyle eq "lower-roman") {
require Roman;
$result = Roman::roman($headingNumber);
last SWITCH;
}
if ($numberingStyle eq "upper-roman") {
require Roman;
$result = Roman::Roman($headingNumber);
last SWITCH;
}
die "Unknown case: $numberingStyle";
}
# Return value
return $result;
} # _formatHeadingLevel()
#--- HTML::TocGenerator::_formatTocNode() -------------------------------------
# function: Format heading node.
# args: - $aLevel: Level of current heading
# - $aClass: Class of current heading
# - $aGroup: Group of current heading
# - $aToc: Toc of current heading
sub _formatTocNode {
# Get arguments
my ($self, $aLevel, $aClass, $aGroup, $aToc) = @_;
# Local variables
my ($result, $level, $levelGroups);
# Alias 'levelGroups' of right 'groupId'
$levelGroups = $aToc->{_levelGroups}{$aGroup->{'groupId'}};
# Loop through levels
for ($level = 1; $level <= $aLevel; $level++) {
# If not first level, add dot
$result = ($result ? $result . "." : $result);
# Format heading level using argument group
$result .= $self->_formatHeadingLevel(
$level, $aClass, @{$levelGroups}[$level - 1], $aToc
);
}
# Return value
return $result;
} # _formatTocNode()
#--- HTML::TocGenerator::_generate() ------------------------------------------
# function: Generate ToC.
# args: - $aString: Reference to string to parse
sub _generate {
# Get arguments
my ($self, $aString) = @_;
# Local variables
my ($toc);
# Loop through ToCs
foreach $toc (@{$self->{_tocs}}) {
# Clear ToC
$toc->clear();
}
# Extend ToCs
$self->_extend($aString);
} # _generate()
#--- HTML::TocGenerator::_generateFromFile() ----------------------------------
# function: Generate ToC.
# args: - $aFile: (reference to array of) file to parse.
sub _generateFromFile {
# Get arguments
my ($self, $aFile) = @_;
# Local variables
my ($toc);
# Loop through ToCs
foreach $toc (@{$self->{_tocs}}) {
# Clear ToC
$toc->clear();
}
# Extend ToCs
$self->_extendFromFile($aFile);
} # _generateFromFile()
#--- HTML::TocGenerator::_getGroupIdManager() ---------------------------------
# function: Get group id manager.
# args: - $aToc: Active ToC.
# returns: Group id levels.
sub _getGroupIdManager {
# Get arguments
my ($self, $aToc) = @_;
# Local variables
my ($result);
# Global groups?
if ($self->{options}{'doUseGroupsGlobal'}) {
# Yes, global groups;
$result = $self;
}
else {
# No, local groups;
$result = $aToc;
}
# Return value
return $result;
} # _getGroupIdManager()
#--- HTML::TocGenerator::_initializeBatch() -----------------------------------
# function: Initialize batch. This function is called once when a parse batch
# is started.
# args: - $aTocs: Reference to array of tocs.
sub _initializeBatch {
# Get arguments
my ($self, $aTocs) = @_;
# Local variables
my ($toc);
# Store reference to tocs
# Is ToC specification reference to array?
if (ref($aTocs) =~ m/ARRAY/) {
# Yes, ToC specification is reference to array;
# Store array reference
$self->{_tocs} = $aTocs;
}
else {
# No, ToC specification is reference to ToC object;
# Wrap reference in array reference, containing only one element
$self->{_tocs} = [$aTocs];
}
# Loop through ToCs
foreach $toc (@{$self->{_tocs}}) {
# Parse ToC options
$toc->parseOptions();
}
} # _initializeBatch()
#--- HTML::TocGenerator::_initializeExtenderBatch() --------------------------
# function: Initialize 'extender' batch. This function is called once when a
# parse batch is started.
# args: - $aTocs: Reference to array of tocs.
sub _initializeExtenderBatch {
# Get arguments
my ($self, $aTocs) = @_;
# Do general batch initialization
$self->_initializeBatch($aTocs);
# Parse ToC options
$self->_parseTocOptions();
# Indicate start of batch
$self->{_doGenerateToc} = 1;
} # _initializeExtenderBatch()
#--- HTML::TocGenerator::_initializeGeneratorBatch() --------------------------
# function: Initialize generator batch. This function is called once when a
# parse batch is started.
# args: - $aTocs: Reference to array of tocs.
# - $aOptions: optional options
sub _initializeGeneratorBatch {
# Get arguments
my ($self, $aTocs, $aOptions) = @_;
# Add invocation options
$self->setOptions($aOptions);
# Option 'doUseGroupsGlobal' specified?
if (!defined($self->{options}{'doUseGroupsGlobal'})) {
# No, options 'doUseGroupsGlobal' not specified;
# Default to no 'doUseGroupsGlobal'
$self->{options}{'doUseGroupsGlobal'} = 0;
}
# Global groups?
if ($self->{options}{'doUseGroupsGlobal'}) {
# Yes, global groups;
# Reset groups and levels
$self->_resetStackVariables();
}
# Do 'extender' batch initialization
$self->_initializeExtenderBatch($aTocs);
} # _initializeGeneratorBatch()
#--- HTML::TocGenerator::_linkTocToToken() ------------------------------------
# function: Link ToC to token.
# args: - $aToc: ToC to add token to.
# - $aFile
# - $aGroupId
# - $aLevel
# - $aNode
# - $aGroupLevel
# - $aLinkType
# - $aTokenAttributes: reference to hash containing attributes of
# currently parsed token
sub _linkTocToToken {
# Get arguments
my (
$self, $aToc, $aFile, $aGroupId, $aLevel, $aNode, $aGroupLevel,
$aDoLinkToId, $aTokenAttributes
) = @_;
# Local variables
my ($file, $groupId, $level, $node, $anchorName);
my ($doInsertAnchor, $doInsertId);
# Fill local arguments to be used by templates
$file = $aFile;
$groupId = $aGroupId;
$level = $aLevel;
$node = $aNode;
# Assemble anchor name
$anchorName =
ref($aToc->{_templateAnchorName}) eq "CODE" ?
&{$aToc->{_templateAnchorName}}(
$aFile, $aGroupId, $aLevel, $aNode
) :
eval($aToc->{_templateAnchorName});
# Bias to insert anchor name
$doInsertAnchor = 1;
$doInsertId = 0;
# Link to 'id'?
if ($aDoLinkToId) {
# Yes, link to 'id';
# Indicate to insert anchor id
$doInsertAnchor = 0;
$doInsertId = 1;
# Id attribute is available?
if (defined($aTokenAttributes->{id})) {
# Yes, id attribute is available;
# Use existing ids?
if ($aToc->{options}{'doUseExistingIds'}) {
# Yes, use existing ids;
# Use existing id
$anchorName = $aTokenAttributes->{id};
# Indicate to not insert id
$doInsertId = 0;
}
}
}
else {
# No, link to 'name';
# Anchor name is currently active?
if (defined($self->{_activeAnchorName})) {
# Yes, anchor name is currently active;
# Use existing anchors?
if ($aToc->{options}{'doUseExistingAnchors'}) {
# Yes, use existing anchors;
# Use existing anchor name
$anchorName = $self->{_activeAnchorName};
# Indicate to not insert anchor name
$doInsertAnchor = 0;
}
else {
# No, don't use existing anchors; insert new anchor;
#
}
}
}
# Add reference to ToC
$aToc->{_toc} .=
ref($aToc->{_templateAnchorHrefBegin}) eq "CODE" ?
&{$aToc->{_templateAnchorHrefBegin}}(
$aFile, $aGroupId, $aLevel, $aNode, $anchorName
) :
eval($aToc->{_templateAnchorHrefBegin});
# Bias to not output anchor name end
$self->{_doOutputAnchorNameEnd} = 0;
# Must anchor be inserted?
if ($doInsertAnchor) {
# Yes, anchor must be inserted;
# Allow adding of anchor name begin token to text by calling
# 'anchorNameBegin' method
$self->anchorNameBegin(
ref($aToc->{_templateAnchorNameBegin}) eq "CODE" ?
&{$aToc->{_templateAnchorNameBegin}}(
$aFile, $aGroupId, $aLevel, $aNode, $anchorName
) :
eval($aToc->{_templateAnchorNameBegin}),
$aToc
);
}
# Must anchorId attribute be inserted?
if ($doInsertId) {
# Yes, anchorId attribute must be inserted;
# Allow adding of anchorId attribute to text by calling 'anchorId'
# method
$self->anchorId($anchorName);
}
} # _linkTocToToken()
#--- HTML::TocGenerator::_outputAnchorNameEndConditionally() ------------------
# function: Output 'anchor name end' if necessary
# args: - $aToc: ToC of which 'anchor name end' must be output.
sub _outputAnchorNameEndConditionally {
# Get arguments
my ($self, $aToc) = @_;
# Must anchor name end be output?
if ($self->{_doOutputAnchorNameEnd}) {
# Yes, output anchor name end;
# Allow adding of anchor to text by calling 'anchorNameEnd'
# method
$self->anchorNameEnd(
ref($aToc->{_templateAnchorNameEnd}) eq "CODE" ?
&{$aToc->{_templateAnchorNameEnd}} :
eval($aToc->{_templateAnchorNameEnd}),
$aToc
);
}
} # _outputAnchorNameEndConditionally()
#--- HTML::TocGenerator::_parseTocOptions() -----------------------------------
# function: Parse ToC options.
sub _parseTocOptions {
# Get arguments
my ($self) = @_;
# Local variables
my ($toc, $group, $tokens, $tokenType, $i);
# Create parsers for ToC tokens
$self->{_tokensTocBegin} = [];
my $tokenTocBeginParser = HTML::_TokenTocBeginParser->new(
$self->{_tokensTocBegin}
);
my $tokenTocEndParser = HTML::_TokenTocEndParser->new();
# Loop through ToCs
foreach $toc (@{$self->{_tocs}}) {
# Reference parser ToC to current ToC
$tokenTocBeginParser->setToc($toc);
# Loop through 'tokenToToc' groups
foreach $group (@{$toc->{options}{'tokenToToc'}}) {
# Reference parser group to current group
$tokenTocBeginParser->setGroup($group);
# Parse 'tokenToToc' group
$tokenTocBeginParser->parse($group->{'tokenBegin'});
# Flush remaining buffered text
$tokenTocBeginParser->eof();
$tokenTocEndParser->parse(
$group->{'tokenEnd'},
$tokenTocBeginParser->{_lastAddedToken},
$tokenTocBeginParser->{_lastAddedTokenType}
);
# Flush remaining buffered text
$tokenTocEndParser->eof();
}
}
} # _parseTocOptions()
#--- HTML::TocGenerator::_processTocEndingToken() -----------------------------
# function: Process ToC-ending-token.
# args: - $aTocToken: token which acts as ToC-ending-token.
sub _processTocEndingToken {
# Get arguments
my ($self, $aTocToken) = @_;
# Local variables
my ($toc);
# Aliases
$toc = $aTocToken->[TT_TOC];
# Link ToC to tokens?
if ($toc->{options}{'doLinkToToken'}) {
# Yes, link ToC to tokens;
# Add anchor href end
$toc->{_toc} .=
(ref($toc->{_templateAnchorHrefEnd}) eq "CODE") ?
&{$toc->{_templateAnchorHrefEnd}} :
eval($toc->{_templateAnchorHrefEnd});
# Output anchor name end only if necessary
$self->_outputAnchorNameEndConditionally($toc);
}
} # _processTocEndingToken()
#--- HTML::TocGenerator::_processTocStartingToken() ---------------------------
# function: Process ToC-starting-token.
# args: - $aTocToken: token which acts as ToC-starting-token.
# - $aTokenType: type of token. Can be either TT_TOKENTYPE_START,
# _END, _TEXT, _COMMENT or _DECLARATION.
# - $aTokenAttributes: reference to hash containing attributes of
# currently parsed token
# - $aTokenOrigText: reference to original token text
sub _processTocStartingToken {
# Get arguments
my ($self, $aTocToken, $aTokenType, $aTokenAttributes, $aTokenOrigText) = @_;
# Local variables
my ($i, $level, $doLinkToId, $node, $groupLevel);
my ($file, $tocTokenId, $groupId, $toc, $attribute);
# Aliases
$file = $self->{_currentFile};
$toc = $aTocToken->[TT_TOC];
$level = $aTocToken->[TT_GROUP]{'level'};
$groupId = $aTocToken->[TT_GROUP]{'groupId'};
# Retrieve 'doLinkToId' setting from either group options or toc options
$doLinkToId = (defined($aTocToken->[TT_GROUP]{'doLinkToId'})) ?
$aTocToken->[TT_GROUP]{'doLinkToId'} : $toc->{options}{'doLinkToId'};
# Link to 'id' and tokenType isn't 'start'?
if (($doLinkToId) && ($aTokenType != TT_TOKENTYPE_START)) {
# Yes, link to 'id' and tokenType isn't 'start';
# Indicate to *not* link to 'id'
$doLinkToId = 0;
}
if (ref($level) eq "CODE") {
$level = &$level($self->{_currentFile}, $node);
}
if (ref($groupId) eq "CODE") {
$groupId = &$groupId($self->{_currentFile}, $node);
}
# Determine class level
my $groupIdManager = $self->_getGroupIdManager($toc);
# Known group?
if (!exists($groupIdManager->{groupIdLevels}{$groupId})) {
# No, unknown group;
# Add group
$groupIdManager->{groupIdLevels}{$groupId} = keys(
%{$groupIdManager->{groupIdLevels}}
) + 1;
}
$groupLevel = $groupIdManager->{groupIdLevels}{$groupId};
# Temporarily allow symbolic references
#no strict qw(refs);
# Increase level
$groupIdManager->{levels}{$groupId}[$level - 1] += 1;
# Reset remaining levels of same group
for ($i = $level; $i < @{$groupIdManager->{levels}{$groupId}}; $i++) {
$groupIdManager->{levels}{$groupId}[$i] = 0;
}
# Assemble numeric string indicating current level
$node = $self->_formatTocNode(
$level, $groupId, $aTocToken->[TT_GROUP], $toc
);
# Add newline if _toc not empty
if ($toc->{_toc}) {
$toc->{_toc} .= "\n";
}
# Add toc item info
$toc->{_toc} .= "$level $groupLevel $groupId $node " .
$groupIdManager->{levels}{$groupId}[$level - 1] . " ";
# Add value of 'id' attribute if available
if (defined($aTokenAttributes->{id})) {
$toc->{_toc} .= $aTokenAttributes->{id};
}
$toc->{_toc} .= " ";
# Link ToC to tokens?
if ($toc->{options}{'doLinkToToken'}) {
# Yes, link ToC to tokens;
# Link ToC to token
$self->_linkTocToToken(
$toc, $file, $groupId, $level, $node, $groupLevel, $doLinkToId,
$aTokenAttributes
);
}
# Number tokens?
if (
$aTocToken->[TT_GROUP]{'doNumberToken'} ||
(
! defined($aTocToken->[TT_GROUP]{'doNumberToken'}) &&
$toc->{options}{'doNumberToken'}
)
) {
# Yes, number tokens;
# Add number by calling 'number' method
$self->number(
ref($toc->{_templateTokenNumber}) eq "CODE" ?
&{$toc->{_templateTokenNumber}}(
$node, $groupId, $file, $groupLevel, $level, $toc
) :
eval($toc->{_templateTokenNumber}),
$toc
);
}
# Must attribute be used as ToC text?
if (defined($aTocToken->[TT_ATTRIBUTES_TOC])) {
# Yes, attribute must be used as ToC text;
# Loop through attributes
foreach $attribute (@{$aTocToken->[TT_ATTRIBUTES_TOC]}) {
# Attribute is available?
if (defined($$aTokenAttributes{$attribute})) {
# Yes, attribute is available;
# Add attribute value to ToC
$self->_processTocText($$aTokenAttributes{$attribute}, $toc);
}
else {
# No, attribute isn't available;
# Show warning
$self->_showWarning(
WARNING_TOC_ATTRIBUTE_PS_NOT_AVAILABLE_WITHIN_PS,
[$attribute, $$aTokenOrigText]
);
}
# Output anchor name end only if necessary
#$self->_outputAnchorNameEndConditionally($toc);
# End attribute
$self->_processTocEndingToken($aTocToken);
}
}
else {
# No, attribute mustn't be used as ToC text;
# Add end token to 'end token array'
push(
@{$self->{_tokensTocEnd}[$aTocToken->[TT_TAG_TYPE_END]]}, $aTocToken
);
}
} # _processTocStartingToken()
#--- HTML::TocGenerator::_processTocText() ------------------------------------
# function: This function processes text which must be added to the preliminary
# ToC.
# args: - $aText: Text to add to ToC.
# - $aToc: ToC to add text to.
sub _processTocText {
# Get arguments
my ($self, $aText, $aToc) = @_;
# Add text to ToC
$aToc->{_toc} .= $aText;
} # _processTocText()
#--- HTML::TocGenerator::_processTokenAsTocEndingToken() ----------------------
# function: Check for token being a token to use for triggering the end of
# a ToC line and process it accordingly.
# args: - $aTokenType: type of token: 'start', 'end', 'comment' or 'text'.
# - $aTokenId: token id of currently parsed token
sub _processTokenAsTocEndingToken {
# Get arguments
my ($self, $aTokenType, $aTokenId) = @_;
# Local variables
my ($i, $tokenId, $toc, $tokens);
# Loop through dirty start tokens
$i = 0;
# Alias token array of right type
$tokens = $self->{_tokensTocEnd}[$aTokenType];
# Loop through token array
while ($i < scalar @$tokens) {
# Aliases
$tokenId = $tokens->[$i][TT_TAG_END];
# Does current end tag equals dirty tag?
if ($aTokenId eq $tokenId) {
# Yes, current end tag equals dirty tag;
# Process ToC-ending-token
$self->_processTocEndingToken($tokens->[$i]);
# Remove dirty tag from array, automatically advancing to
# next token
splice(@$tokens, $i, 1);
}
else {
# No, current end tag doesn't equal dirty tag;
# Advance to next token
$i++;
}
}
} # _processTokenAsTocEndingToken()
#--- HTML::TocGenerator::_processTokenAsTocStartingToken() --------------------
# function: Check for token being a ToC-starting-token and process it
# accordingly.
# args: - $aTokenType: type of token. Can be either TT_TOKENTYPE_START,
# _END, _TEXT, _COMMENT or _DECLARATION.
# - $aTokenId: token id of currently parsed token
# - $aTokenAttributes: reference to hash containing attributes of
# currently parsed token
# - $aTokenOrigText: reference to original text of token
# returns: 1 if successful, i.e. token is processed as ToC-starting-token, 0
# if not.
sub _processTokenAsTocStartingToken {
# Get arguments
my ($self, $aTokenType, $aTokenId, $aTokenAttributes, $aTokenOrigText) = @_;
# Local variables
my ($level, $levelToToc, $groupId, $groupToToc);
my ($result, $tocToken, $tagBegin, @tokensTocBegin, $fileSpec);
# Bias to token not functioning as ToC-starting-token
$result = 0;
# Loop through start tokens of right type
foreach $tocToken (@{$self->{_tokensTocBegin}[$aTokenType]}) {
# Alias file filter
$fileSpec = $tocToken->[TT_GROUP]{'fileSpec'};
# File matches?
if (!defined($fileSpec) || (
defined($fileSpec) &&
($self->{_currentFile} =~ m/$fileSpec/)
)) {
# Yes, file matches;
# Alias tag begin
$tagBegin = $tocToken->[TT_TAG_BEGIN];
# Tag and attributes match?
if (
defined($tagBegin) &&
($aTokenId =~ m/$tagBegin/) &&
HTML::TocGenerator::_doesHashContainHash(
$aTokenAttributes, $tocToken->[TT_INCLUDE_ATTRIBUTES_BEGIN], 0
) &&
HTML::TocGenerator::_doesHashContainHash(
$aTokenAttributes, $tocToken->[TT_EXCLUDE_ATTRIBUTES_BEGIN], 1
)
) {
# Yes, tag and attributes match;
# Aliases
$level = $tocToken->[TT_GROUP]{'level'};
$levelToToc = $tocToken->[TT_TOC]{options}{'levelToToc'};
$groupId = $tocToken->[TT_GROUP]{'groupId'};
$groupToToc = $tocToken->[TT_TOC]{options}{'groupToToc'};
# Must level and group be processed?
if (
($level =~ m/$levelToToc/) &&
($groupId =~ m/$groupToToc/)
) {
# Yes, level and group must be processed;
# Indicate token acts as ToC-starting-token
$result = 1;
# Process ToC-starting-token
$self->_processTocStartingToken(
$tocToken, $aTokenType, $aTokenAttributes, $aTokenOrigText
);
}
}
}
}
# Return value
return $result;
} # _processTokenAsTocStartingToken()
#--- HTML::TocGenerator::_resetBatchVariables() -------------------------------
# function: Reset variables which are set because of batch invocation.
sub _resetBatchVariables {
# Get arguments
my ($self) = @_;
# Filename of current file being parsed, empty string if not available
$self->{_currentFile} = "";
# Arrays containing start, end, comment, text & declaration tokens which
# must trigger the ToC assembling. Each array element may contain a
# reference to an array containing the following elements:
#
# TT_TAG_BEGIN => 0;
# TT_TAG_END => 1;
# TT_TAG_TYPE_END => 2;
# TT_INCLUDE_ATTRIBUTES_BEGIN => 3;
# TT_EXCLUDE_ATTRIBUTES_BEGIN => 4;
# TT_INCLUDE_ATTRIBUTES_END => 5;
# TT_EXCLUDE_ATTRIBUTES_END => 6;
# TT_GROUP => 7;
# TT_TOC => 8;
# TT_ATTRIBUTES_TOC => 9;
#
$self->{_tokensTocBegin} = [
[], # TT_TOKENTYPE_START
[], # TT_TOKENTYPE_END
[], # TT_TOKENTYPE_COMMENT
[], # TT_TOKENTYPE_TEXT
[] # TT_TOKENTYPE_DECLARATION
];
$self->{_tokensTocEnd} = [
[], # TT_TOKENTYPE_START
[], # TT_TOKENTYPE_END
[], # TT_TOKENTYPE_COMMENT
[], # TT_TOKENTYPE_TEXT
[] # TT_TOKENTYPE_DECLARATION
];
# TRUE if ToCs have been initialized, FALSE if not.
$self->{_doneInitializeTocs} = 0;
# Array of ToCs to process
$self->{_tocs} = [];
# Active anchor name
$self->{_activeAnchorName} = undef;
} # _resetBatchVariables()
#--- HTML::TocGenerator::_resetStackVariables() -------------------------------
# function: Reset variables which cumulate during ToC generation.
sub _resetStackVariables {
# Get arguments
my ($self) = @_;
# Reset variables
$self->{levels} = undef;
$self->{groupIdLevels} = undef;
} # _resetStackVariables()
#--- HTML::TocGenerator::_setActiveAnchorName() -------------------------------
# function: Set active anchor name.
# args: - aAnchorName: Name of anchor name to set active.
sub _setActiveAnchorName {
# Get arguments
my ($self, $aAnchorName) = @_;
# Set active anchor name
$self->{_activeAnchorName} = $aAnchorName;
} # _setActiveAnchorName()
#--- HTML::TocGenerator::_showWarning() ---------------------------------------
# function: Show warning.
# args: - aWarningNr: Number of warning to show.
# - aWarningArgs: Arguments to display within the warning.
sub _showWarning {
# Get arguments
my ($self, $aWarningNr, $aWarningArgs) = @_;
# Local variables
my (%warnings);
# Set warnings
%warnings = (
WARNING_NESTED_ANCHOR_PS_WITHIN_PS() =>
"Nested anchor '%s' within anchor '%s'.",
WARNING_TOC_ATTRIBUTE_PS_NOT_AVAILABLE_WITHIN_PS() =>
"ToC attribute '%s' not available within token '%s'.",
);
# Show warning
print STDERR "warning ($aWarningNr): " . sprintf($warnings{"$aWarningNr"}, @$aWarningArgs) . "\n";
} # _showWarning()
#--- HTML::TocGenerator::anchorId() -------------------------------------------
# function: Anchor id processing method. Leave it up to the descendant to do
# something useful with it.
# args: - $aAnchorId
# - $aToc: Reference to ToC to which anchorId belongs.
sub anchorId {
} # anchorId()
#--- HTML::TocGenerator::anchorNameBegin() ------------------------------------
# function: Anchor name begin processing method. Leave it up to the descendant
# to do something useful with it.
# args: - $aAnchorName
# - $aToc: Reference to ToC to which anchorname belongs.
sub anchorNameBegin {
} # anchorNameBegin()
#--- HTML::TocGenerator::anchorNameEnd() --------------------------------------
# function: Anchor name end processing method. Leave it up to the descendant
# to do something useful with it.
# args: - $aAnchorName
# - $aToc: Reference to ToC to which anchorname belongs.
sub anchorNameEnd {
} # anchorNameEnd()
#--- HTML::TocGenerator::comment() --------------------------------------------
# function: Process comment.
# args: - $aComment: comment text with '<!--' and '-->' tags stripped off.
sub comment {
# Get arguments
my ($self, $aComment) = @_;
# Must a ToC be generated?
if ($self->{_doGenerateToc}) {
# Yes, a ToC must be generated
# Process end tag as ToC-starting-token
$self->_processTokenAsTocStartingToken(
TT_TOKENTYPE_COMMENT, $aComment, undef, \$aComment
);
# Process end tag as token which ends ToC registration
$self->_processTokenAsTocEndingToken(
TT_TOKENTYPE_COMMENT, $aComment
);
}
} # comment()
#--- HTML::TocGenerator::end() ------------------------------------------------
# function: This function is called every time a closing tag is encountered.
# args: - $aTag: tag name (in lower case).
# - $aOrigText: tag name including brackets.
sub end {
# Get arguments
my ($self, $aTag, $aOrigText) = @_;
# Local variables
my ($tag, $toc, $i);
# Must a ToC be generated?
if ($self->{_doGenerateToc}) {
# Yes, a ToC must be generated
# Process end tag as ToC-starting-token
$self->_processTokenAsTocStartingToken(
TT_TOKENTYPE_END, $aTag, undef, \$aOrigText
);
# Process end tag as ToC-ending-token
$self->_processTokenAsTocEndingToken(
TT_TOKENTYPE_END, $aTag
);
# Tag is of type 'anchor'?
if (defined($self->{_activeAnchorName}) && ($aTag eq "a")) {
# Yes, tag is of type 'anchor';
# Reset dirty anchor
$self->{_activeAnchorName} = undef;
}
}
} # end()
#--- HTML::TocGenerator::extend() ---------------------------------------------
# function: Extend ToCs.
# args: - $aTocs: Reference to array of ToC objects
# - $aString: String to parse.
sub extend {
# Get arguments
my ($self, $aTocs, $aString) = @_;
# Initialize TocGenerator batch
$self->_initializeExtenderBatch($aTocs);
# Extend ToCs
$self->_extend($aString);
# Deinitialize TocGenerator batch
$self->_deinitializeExtenderBatch();
} # extend()
#--- HTML::TocGenerator::extendFromFile() -------------------------------------
# function: Extend ToCs.
# args: - @aTocs: Reference to array of ToC objects
# - @aFiles: Reference to array of files to parse.
sub extendFromFile {
# Get arguments
my ($self, $aTocs, $aFiles) = @_;
# Initialize TocGenerator batch
$self->_initializeExtenderBatch($aTocs);
# Extend ToCs
$self->_extendFromFile($aFiles);
# Deinitialize TocGenerator batch
$self->_deinitializeExtenderBatch();
} # extendFromFile()
#--- HTML::TocGenerator::generate() -------------------------------------------
# function: Generate ToC.
# args: - $aToc: Reference to (array of) ToC object(s)
# - $aString: Reference to string to parse
# - $aOptions: optional options
sub generate {
# Get arguments
my ($self, $aToc, $aString, $aOptions) = @_;
# Initialize TocGenerator batch
$self->_initializeGeneratorBatch($aToc, $aOptions);
# Do generate ToC
$self->_generate($aString);
# Deinitialize TocGenerator batch
$self->_deinitializeGeneratorBatch();
} # generate()
#--- HTML::TocGenerator::generateFromFile() -----------------------------------
# function: Generate ToC.
# args: - $aToc: Reference to (array of) ToC object(s)
# - $aFile: (reference to array of) file to parse.
# - $aOptions: optional options
sub generateFromFile {
# Get arguments
my ($self, $aToc, $aFile, $aOptions) = @_;
# Initialize TocGenerator batch
$self->_initializeGeneratorBatch($aToc, $aOptions);
# Do generate ToC
$self->_generateFromFile($aFile);
# Deinitialize TocGenerator batch
$self->_deinitializeGeneratorBatch();
} # generateFromFile()
#--- HTML::TocGenerator::number() ---------------------------------------------
# function: Heading number processing method. Leave it up to the descendant
# to do something useful with it.
# args: - $aNumber
# - $aToc: Reference to ToC to which anchorname belongs.
sub number {
# Get arguments
my ($self, $aNumber, $aToc) = @_;
} # number()
#--- HTML::TocGenerator::parse() ----------------------------------------------
# function: Parse scalar.
# args: - $aString: string to parse
sub parse {
# Get arguments
my ($self, $aString) = @_;
# Call ancestor
$self->SUPER::parse($aString);
} # parse()
#--- HTML::TocGenerator::parse_file() -----------------------------------------
# function: Parse file.
sub parse_file {
# Get arguments
my ($self, $aFile) = @_;
# Call ancestor
$self->SUPER::parse_file($aFile);
} # parse_file()
#--- HTML::TocGenerator::setOptions() -----------------------------------------
# function: Set options.
# args: - aOptions: Reference to hash containing options.
sub setOptions {
# Get arguments
my ($self, $aOptions) = @_;
# Options are defined?
if (defined($aOptions)) {
# Yes, options are defined; add to options
%{$self->{options}} = (%{$self->{options}}, %$aOptions);
}
} # setOptions()
#--- HTML::TocGenerator::start() ----------------------------------------------
# function: This function is called every time an opening tag is encountered.
# args: - $aTag: tag name (in lower case).
# - $aAttr: reference to hash containing all tag attributes (in lower
# case).
# - $aAttrSeq: reference to array containing all tag attributes (in
# lower case) in the original order
# - $aOrigText: the original HTML text
sub start {
# Get arguments
my ($self, $aTag, $aAttr, $aAttrSeq, $aOrigText) = @_;
$self->{isTocToken} = 0;
# Start tag is of type 'anchor name'?
if ($aTag eq "a" && defined($aAttr->{name})) {
# Yes, start tag is of type 'anchor name';
# Is another anchor already active?
if (defined($self->{_activeAnchorName})) {
# Yes, another anchor is already active;
# Is the first anchor inserted by 'TocGenerator'?
if ($self->{_doOutputAnchorNameEnd}) {
# Yes, the first anchor is inserted by 'TocGenerator';
# Show warning
$self->_showWarning(
WARNING_NESTED_ANCHOR_PS_WITHIN_PS,
[$aOrigText, $self->{_activeAnchorName}]
);
}
}
# Set active anchor name
$self->_setActiveAnchorName($aAttr->{name});
}
# Must a ToC be generated?
if ($self->{_doGenerateToc}) {
# Yes, a ToC must be generated
# Process start tag as ToC token
$self->{isTocToken} = $self->_processTokenAsTocStartingToken(
TT_TOKENTYPE_START, $aTag, $aAttr, \$aOrigText
);
# Process end tag as ToC-ending-token
$self->_processTokenAsTocEndingToken(
TT_TOKENTYPE_START, $aTag
);
}
} # start()
#--- HTML::TocGenerator::text() -----------------------------------------------
# function: This function is called every time plain text is encountered.
# args: - @_: array containing data.
sub text {
# Get arguments
my ($self, $aText) = @_;
# Local variables
my ($text, $toc, $i, $token, $tokens);
# Must a ToC be generated?
if ($self->{_doGenerateToc}) {
# Yes, a ToC must be generated
# Are there dirty start tags?
# Loop through token types
foreach $tokens (@{$self->{_tokensTocEnd}}) {
# Loop though tokens
foreach $token (@$tokens) {
# Add text to toc
# Alias
$toc = $token->[TT_TOC];
# Remove possible newlines from text
($text = $aText) =~ s/\s*\n\s*/ /g;
# Add text to toc
$self->_processTocText($text, $toc);
}
}
}
} # text()
#=== HTML::_TokenTocParser ====================================================
# function: Parse 'toc tokens'. 'Toc tokens' mark HTML code which is to be
# inserted into the ToC.
# note: Used internally.
package HTML::_TokenTocParser;
BEGIN {
use vars qw(@ISA);
@ISA = qw(HTML::Parser);
}
END {}
#--- HTML::_TokenTocParser::new() ---------------------------------------------
# function: Constructor
sub new {
# Get arguments
my ($aType) = @_;
# Create instance
my $self = $aType->SUPER::new;
# Return instance
return $self;
} # new()
#--- HTML::_TokenTocParser::_parseAttributes() --------------------------------
# function: Parse attributes.
# args: - $aAttr: Reference to hash containing all tag attributes (in lower
# case).
# - $aIncludeAttributes: Reference to hash to which 'include
# attributes' must be added.
# - $aExcludeAttributes: Reference to hash to which 'exclude
# attributes' must be added.
# - $aTocAttributes: Reference to hash to which 'ToC attributes'
# must be added.
sub _parseAttributes {
# Get arguments
my (
$self, $aAttr, $aIncludeAttributes, $aExcludeAttributes,
$aTocAttributes
) = @_;
# Local variables
my ($key, $value);
my ($attributeToExcludeToken, $attributeToTocToken);
# Get token which marks attributes which must be excluded
$attributeToExcludeToken = $self->{_toc}{options}{'attributeToExcludeToken'};
$attributeToTocToken = $self->{_toc}{options}{'attributeToTocToken'};
# Loop through attributes
while (($key, $value) = each %$aAttr) {
# Attribute value equals 'ToC token'?
if ($value =~ m/$attributeToTocToken/) {
# Yes, attribute value equals 'ToC token';
# Add attribute to 'ToC attributes'
push @$aTocAttributes, $key;
}
else {
# No, attribute isn't 'ToC' token;
# Attribute value starts with 'exclude token'?
if ($value =~ m/^$attributeToExcludeToken(.*)/) {
# Yes, attribute value starts with 'exclude token';
# Add attribute to 'exclude attributes'
$$aExcludeAttributes{$key} = "$1";
}
else {
# No, attribute key doesn't start with '-';
# Add attribute to 'include attributes'
$$aIncludeAttributes{$key} = $value;
}
}
}
} # _parseAttributes()
#=== HTML::_TokenTocBeginParser ===============================================
# function: Parse 'toc tokens'. 'Toc tokens' mark HTML code which is to be
# inserted into the ToC.
# note: Used internally.
package HTML::_TokenTocBeginParser;
BEGIN {
use vars qw(@ISA);
@ISA = qw(HTML::_TokenTocParser);
}
END {}
#--- HTML::_TokenTocBeginParser::new() ----------------------------------------
# function: Constructor
sub new {
# Get arguments
my ($aType, $aTokenArray) = @_;
# Create instance
my $self = $aType->SUPER::new;
# Reference token array
$self->{tokens} = $aTokenArray;
# Reference to last added token
$self->{_lastAddedToken} = undef;
$self->{_lastAddedTokenType} = undef;
# Return instance
return $self;
} # new()
#--- HTML::_TokenTocBeginParser::_processAttributes() -------------------------
# function: Process attributes.
# args: - $aAttributes: Attributes to parse.
sub _processAttributes {
# Get arguments
my ($self, $aAttributes) = @_;
# Local variables
my (%includeAttributes, %excludeAttributes, @tocAttributes);
# Parse attributes
$self->_parseAttributes(
$aAttributes, \%includeAttributes, \%excludeAttributes, \@tocAttributes
);
# Include attributes are specified?
if (keys(%includeAttributes) > 0) {
# Yes, include attributes are specified;
# Store include attributes
@${$self->{_lastAddedToken}}[
HTML::TocGenerator::TT_INCLUDE_ATTRIBUTES_BEGIN
] = \%includeAttributes;
}
# Exclude attributes are specified?
if (keys(%excludeAttributes) > 0) {
# Yes, exclude attributes are specified;
# Store exclude attributes
@${$self->{_lastAddedToken}}[
HTML::TocGenerator::TT_EXCLUDE_ATTRIBUTES_BEGIN
] = \%excludeAttributes;
}
# Toc attributes are specified?
if (@tocAttributes > 0) {
# Yes, toc attributes are specified;
# Store toc attributes
@${$self->{_lastAddedToken}}[
HTML::TocGenerator::TT_ATTRIBUTES_TOC
] = \@tocAttributes;
}
} # _processAttributes()
#--- HTML::_TokenTocBeginParser::_processToken() ------------------------------
# function: Process token.
# args: - $aTokenType: Type of token to process.
# - $aTag: Tag of token.
sub _processToken {
# Get arguments
my ($self, $aTokenType, $aTag) = @_;
# Local variables
my ($tokenArray, $index);
# Push element on array of update tokens
$index = push(@{$self->{tokens}[$aTokenType]}, []) - 1;
# Alias token array to add element to
$tokenArray = $self->{tokens}[$aTokenType];
# Indicate last updated token array element
$self->{_lastAddedTokenType} = $aTokenType;
$self->{_lastAddedToken} = \$$tokenArray[$index];
# Add fields
$$tokenArray[$index][HTML::TocGenerator::TT_TAG_BEGIN] = $aTag;
$$tokenArray[$index][HTML::TocGenerator::TT_GROUP] = $self->{_group};
$$tokenArray[$index][HTML::TocGenerator::TT_TOC] = $self->{_toc};
} # _processToken()
#--- HTML::_TokenTocBeginParser::comment() ------------------------------------
# function: Process comment.
# args: - $aComment: comment text with '<!--' and '-->' tags stripped off.
sub comment {
# Get arguments
my ($self, $aComment) = @_;
# Process token
$self->_processToken(HTML::TocGenerator::TT_TOKENTYPE_COMMENT, $aComment);
} # comment()
#--- HTML::_TokenTocBeginParser::declaration() --------------------------------
# function: This function is called every time a markup declaration is
# encountered by HTML::Parser.
# args: - $aDeclaration: Markup declaration.
sub declaration {
# Get arguments
my ($self, $aDeclaration) = @_;
# Process token
$self->_processToken(
HTML::TocGenerator::TT_TOKENTYPE_DECLARATION, $aDeclaration
);
} # declaration()
#--- HTML::_TokenTocBeginParser::end() ----------------------------------------
# function: This function is called every time a closing tag is encountered
# by HTML::Parser.
# args: - $aTag: tag name (in lower case).
sub end {
# Get arguments
my ($self, $aTag, $aOrigText) = @_;
# Process token
$self->_processToken(HTML::TocGenerator::TT_TOKENTYPE_END, $aTag);
} # end()
#--- HTML::_TokenTocBeginParser::parse() --------------------------------------
# function: Parse begin token.
# args: - $aToken: 'toc token' to parse
sub parse {
# Get arguments
my ($self, $aString) = @_;
# Call ancestor
$self->SUPER::parse($aString);
} # parse()
#--- HTML::_TokenTocBeginParser->setGroup() -----------------------------------
# function: Set current 'tokenToToc' group.
sub setGroup {
# Get arguments
my ($self, $aGroup) = @_;
# Set current 'tokenToToc' group
$self->{_group} = $aGroup;
} # setGroup()
#--- HTML::_TokenTocBeginParser->setToc() -------------------------------------
# function: Set current ToC.
sub setToc {
# Get arguments
my ($self, $aToc) = @_;
# Set current ToC
$self->{_toc} = $aToc;
} # setToc()
#--- HTML::_TokenTocBeginParser::start() --------------------------------------
# function: This function is called every time an opening tag is encountered.
# args: - $aTag: tag name (in lower case).
# - $aAttr: reference to hash containing all tag attributes (in lower
# case).
# - $aAttrSeq: reference to array containing all attribute keys (in
# lower case) in the original order
# - $aOrigText: the original HTML text
sub start {
# Get arguments
my ($self, $aTag, $aAttr, $aAttrSeq, $aOrigText) = @_;
# Process token
$self->_processToken(HTML::TocGenerator::TT_TOKENTYPE_START, $aTag);
# Process attributes
$self->_processAttributes($aAttr);
} # start()
#--- HTML::_TokenTocBeginParser::text() ---------------------------------------
# function: This function is called every time plain text is encountered.
# args: - @_: array containing data.
sub text {
# Get arguments
my ($self, $aText) = @_;
# Was token already created and is last added token of type 'text'?
if (
defined($self->{_lastAddedToken}) &&
$self->{_lastAddedTokenType} == HTML::TocGenerator::TT_TOKENTYPE_TEXT
) {
# Yes, token is already created;
# Add tag to existing token
@${$self->{_lastAddedToken}}[HTML::TocGenerator::TT_TAG_BEGIN] .= $aText;
}
else {
# No, token isn't created;
# Process token
$self->_processToken(HTML::TocGenerator::TT_TOKENTYPE_TEXT, $aText);
}
} # text()
#=== HTML::_TokenTocEndParser =================================================
# function: Parse 'toc tokens'. 'Toc tokens' mark HTML code which is to be
# inserted into the ToC.
# note: Used internally.
package HTML::_TokenTocEndParser;
BEGIN {
use vars qw(@ISA);
@ISA = qw(HTML::_TokenTocParser);
}
END {}
#--- HTML::_TokenTocEndParser::new() ------------------------------------------
# function: Constructor
# args: - $aType: Class type.
sub new {
# Get arguments
my ($aType) = @_;
# Create instance
my $self = $aType->SUPER::new;
# Reference to last added token
$self->{_lastAddedToken} = undef;
# Return instance
return $self;
} # new()
#--- HTML::_TokenTocEndParser::_processAttributes() ---------------------------
# function: Process attributes.
# args: - $aAttributes: Attributes to parse.
sub _processAttributes {
# Get arguments
my ($self, $aAttributes) = @_;
# Local variables
my (%includeAttributes, %excludeAttributes);
# Parse attributes
$self->_parseAttributes(
$aAttributes, \%includeAttributes, \%excludeAttributes
);
# Include attributes are specified?
if (keys(%includeAttributes) > 0) {
# Yes, include attributes are specified;
# Store include attributes
@${$self->{_Token}}[
HTML::TocGenerator::TT_INCLUDE_ATTRIBUTES_END
] = \%includeAttributes;
}
# Exclude attributes are specified?
if (keys(%excludeAttributes) > 0) {
# Yes, exclude attributes are specified;
# Store exclude attributes
@${$self->{_Token}}[
HTML::TocGenerator::TT_EXCLUDE_ATTRIBUTES_END
] = \%excludeAttributes;
}
} # _processAttributes()
#--- HTML::_TokenTocEndParser::_processToken() --------------------------------
# function: Process token.
# args: - $aTokenType: Type of token to process.
# - $aTag: Tag of token.
sub _processToken {
# Get arguments
my ($self, $aTokenType, $aTag) = @_;
# Update token
@${$self->{_token}}[HTML::TocGenerator::TT_TAG_TYPE_END] = $aTokenType;
@${$self->{_token}}[HTML::TocGenerator::TT_TAG_END] = $aTag;
# Indicate token type which has been processed
$self->{_lastAddedTokenType} = $aTokenType;
} # _processToken()
#--- HTML::_TokenTocEndParser::comment() --------------------------------------
# function: Process comment.
# args: - $aComment: comment text with '<!--' and '-->' tags stripped off.
sub comment {
# Get arguments
my ($self, $aComment) = @_;
# Process token
$self->_processToken(HTML::TocGenerator::TT_TOKENTYPE_COMMENT, $aComment);
} # comment()
#--- HTML::_TokenTocDeclarationParser::declaration() --------------------------
# function: This function is called every time a markup declaration is
# encountered by HTML::Parser.
# args: - $aDeclaration: Markup declaration.
sub declaration {
# Get arguments
my ($self, $aDeclaration) = @_;
# Process token
$self->_processToken(
HTML::TocGenerator::TT_TOKENTYPE_DECLARATION, $aDeclaration
);
} # declaration()
#--- HTML::_TokenTocEndParser::end() ------------------------------------------
# function: This function is called every time a closing tag is encountered
# by HTML::Parser.
# args: - $aTag: tag name (in lower case).
sub end {
# Get arguments
my ($self, $aTag, $aOrigText) = @_;
# Process token
$self->_processToken(HTML::TocGenerator::TT_TOKENTYPE_END, $aTag);
} # end()
#--- HTML::_TokenTocEndParser::parse() ----------------------------------------
# function: Parse token.
# args: - $aString: 'toc token' to parse
# - $aToken: Reference to token
# - $aTokenTypeBegin: Type of begin token
sub parse {
# Get arguments
my ($self, $aString, $aToken, $aTokenTypeBegin) = @_;
# Token argument specified?
if (defined($aToken)) {
# Yes, token argument is specified;
# Store token reference
$self->{_token} = $aToken;
}
# End tag defined?
if (! defined($aString)) {
# No, end tag isn't defined;
# Last added tokentype was of type 'start'?
if (
(defined($aTokenTypeBegin)) &&
($aTokenTypeBegin == HTML::TocGenerator::TT_TOKENTYPE_START)
) {
# Yes, last added tokentype was of type 'start';
# Assume end tag
$self->_processToken(
HTML::TocGenerator::TT_TAG_END,
@${$self->{_token}}[HTML::TocGenerator::TT_TAG_BEGIN]
);
}
}
else {
# Call ancestor
$self->SUPER::parse($aString);
}
} # parse()
#--- HTML::_TokenTocEndParser::start() ----------------------------------------
# function: This function is called every time an opening tag is encountered.
# args: - $aTag: tag name (in lower case).
# - $aAttr: reference to hash containing all tag attributes (in lower
# case).
# - $aAttrSeq: reference to array containing all attribute keys (in
# lower case) in the original order
# - $aOrigText: the original HTML text
sub start {
# Get arguments
my ($self, $aTag, $aAttr, $aAttrSeq, $aOrigText) = @_;
# Process token
$self->_processToken(HTML::TocGenerator::TT_TOKENTYPE_START, $aTag);
# Process attributes
$self->_processAttributes($aAttr);
} # start()
#--- HTML::_TokenTocEndParser::text() -----------------------------------------
# function: This function is called every time plain text is encountered.
# args: - @_: array containing data.
sub text {
# Get arguments
my ($self, $aText) = @_;
# Is token already created?
if (defined($self->{_lastAddedTokenType})) {
# Yes, token is already created;
# Add tag to existing token
@${$self->{_token}}[HTML::TocGenerator::TT_TAG_END] .= $aText;
}
else {
# No, token isn't created;
# Process token
$self->_processToken(HTML::TocGenerator::TT_TOKENTYPE_TEXT, $aText);
}
} # text()
1;