1794 lines
51 KiB
Perl
1794 lines
51 KiB
Perl
#=== 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;
|