ref: 1b27e93cd13ff60798e31634ddb362fa7aa9749d
dir: /examples/includes/HTML-Toc-0.91/TocInsertor.pm/
#--- TocInsertor.pm -----------------------------------------------------------
# function: Insert Table of Contents HTML::Toc, generated by
# HTML::TocGenerator.
# note: - The term 'propagate' is used as a shortcut for the process of
# both generating and inserting a ToC at the same time.
# - 'TIP' is an abbreviation of 'Toc Insertion Point'.
package HTML::TocInsertor;
use strict;
use FileHandle;
use HTML::TocGenerator;
BEGIN {
use vars qw(@ISA $VERSION);
$VERSION = '0.91';
@ISA = qw(HTML::TocGenerator);
}
# TocInsertionPoint (TIP) constants
use constant TIP_PREPOSITION_REPLACE => 'replace';
use constant TIP_PREPOSITION_BEFORE => 'before';
use constant TIP_PREPOSITION_AFTER => 'after';
use constant TIP_TOKEN_ID => 0;
use constant TIP_PREPOSITION => 1;
use constant TIP_INCLUDE_ATTRIBUTES => 2;
use constant TIP_EXCLUDE_ATTRIBUTES => 3;
use constant TIP_TOC => 4;
use constant MODE_DO_NOTHING => 0; # 0b00
use constant MODE_DO_INSERT => 1; # 0b01
use constant MODE_DO_PROPAGATE => 3; # 0b11
END {}
#--- HTML::TocInsertor::new() -------------------------------------------------
# function: Constructor.
sub new {
# Get arguments
my ($aType) = @_;
my $self = $aType->SUPER::new;
# TRUE if insertion point token must be output, FALSE if not
$self->{_doOutputInsertionPointToken} = 1;
# Reset batch variables
$self->_resetBatchVariables;
# Bias to not insert ToC
$self->{hti__Mode} = MODE_DO_NOTHING;
# TODO: Initialize output
return $self;
} # new()
#--- HTML::TocInsertor::_deinitializeOutput() ---------------------------------
# function: Deinitialize output.
sub _deinitializeOutput {
# Get arguments
my ($self) = @_;
# Filehandle is defined?
if (defined($self->{_outputFileHandle})) {
# Yes, filehandle is defined;
# Restore selected filehandle
select($self->{_oldFileHandle});
# Undefine filehandle, closing it automatically
undef $self->{_outputFileHandle};
}
} # _deinitializeOutput()
#--- HTML::TocInsertor::_initializeOutput() -----------------------------------
# function: Initialize output.
sub _initializeOutput {
# Get arguments
my ($self) = @_;
# Bias to write to outputfile
my $doOutputToFile = 1;
# Is output specified?
if (defined($self->{options}{'output'})) {
# Yes, output is specified;
# Indicate to not output to outputfile
$doOutputToFile = 0;
# Alias output reference
$self->{_output} = $self->{options}{'output'};
# Clear output
${$self->{_output}} = "";
}
# Is output file specified?
if (defined($self->{options}{'outputFile'})) {
# Yes, output file is specified;
# Indicate to output to outputfile
$doOutputToFile = 1;
# Open file
$self->{_outputFileHandle} =
new FileHandle ">" . $self->{options}{'outputFile'};
# Backup currently selected filehandle
$self->{_oldFileHandle} = select;
# Set new default filehandle
select($self->{_outputFileHandle});
}
# Alias output-to-file indicator
$self->{_doOutputToFile} = $doOutputToFile;
} # _initializeOutput()
#--- HTML::TocInsertor::_deinitializeInsertorBatch() --------------------------
# function: Deinitialize insertor batch.
sub _deinitializeInsertorBatch {
# Get arguments
my ($self) = @_;
# Indicate ToC insertion has finished
$self->{_isTocInsertionPointPassed} = 0;
# Write buffered output
$self->_writeBufferedOutput();
# Propagate?
if ($self->{hti__Mode} == MODE_DO_PROPAGATE) {
# Yes, propagate;
# Deinitialize generator batch
$self->_deinitializeGeneratorBatch();
}
else {
# No, insert only;
# Do general batch deinitialization
$self->_deinitializeBatch();
}
# Deinitialize output
$self->_deinitializeOutput();
# Indicate end of batch
$self->{hti__Mode} = MODE_DO_NOTHING;
# Reset batch variables
$self->_resetBatchVariables();
} # _deinitializeInsertorBatch()
#--- HTML::TocInsertor::_initializeInsertorBatch() ----------------------------
# function: Initialize insertor batch.
# args: - $aTocs: Reference to array of tocs.
# - $aOptions: optional options
sub _initializeInsertorBatch {
# Get arguments
my ($self, $aTocs, $aOptions) = @_;
# Add invocation options
$self->setOptions($aOptions);
# Option 'doGenerateToc' specified?
if (!defined($self->{options}{'doGenerateToc'})) {
# No, options 'doGenerateToc' not specified;
# Default to 'doGenerateToc'
$self->{options}{'doGenerateToc'} = 1;
}
# Propagate?
if ($self->{options}{'doGenerateToc'}) {
# Yes, propagate;
# Indicate mode
$self->{hti__Mode} = MODE_DO_PROPAGATE;
# Initialize generator batch
# NOTE: This method takes care of calling '_initializeBatch()'
$self->_initializeGeneratorBatch($aTocs);
}
else {
# No, insert;
# Indicate mode
$self->{hti__Mode} = MODE_DO_INSERT;
# Do general batch initialization
$self->_initializeBatch($aTocs);
}
# Initialize output
$self->_initializeOutput();
# Parse ToC insertion points
$self->_parseTocInsertionPoints();
} # _initializeInsertorBatch()
#--- HTML::TocInsertor::_insert() ---------------------------------------------
# function: Insert ToC in string.
# args: - $aString: Reference to string to parse.
# note: Used internally.
sub _insert {
# Get arguments
my ($self, $aString) = @_;
# Propagate?
if ($self->{options}{'doGenerateToc'}) {
# Yes, propagate;
# Generate & insert ToC
$self->_generate($aString);
}
else {
# No, just insert ToC
# Insert by parsing file
$self->parse($aString);
# Flush remaining buffered text
$self->eof();
}
} # _insert()
#--- HTML::TocInsertor::_insertIntoFile() -------------------------------------
# function: Do insert generated ToCs in file.
# args: - $aToc: (reference to array of) ToC object(s) to insert.
# - $aFile: (reference to array of) file(s) to parse for insertion
# points.
# - $aOptions: optional insertor options
# note: Used internally.
sub _insertIntoFile {
# 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) {
# Propagate?
if ($self->{options}{'doGenerateToc'}) {
# Yes, propagate;
# Generate and insert ToC
$self->_generateFromFile($file);
}
else {
# No, just insert ToC
# Insert by parsing file
$self->parse_file($file);
}
}
} # _insertIntoFile()
#--- HTML::TocInsertor::_parseTocInsertionPoints() ----------------------------
# function: Parse ToC insertion point specifier.
sub _parseTocInsertionPoints {
# Get arguments
my ($self) = @_;
# Local variables
my ($tipPreposition, $tipToken, $toc, $tokenTipParser);
# Create parser for TIP tokens
$tokenTipParser = HTML::_TokenTipParser->new(
$self->{_tokensTip}
);
# Loop through ToCs
foreach $toc (@{$self->{_tocs}}) {
# Split TIP in preposition and token
($tipPreposition, $tipToken) = split(
'\s+', $toc->{options}{'insertionPoint'}, 2
);
# Known preposition?
if (
($tipPreposition ne TIP_PREPOSITION_REPLACE) &&
($tipPreposition ne TIP_PREPOSITION_BEFORE) &&
($tipPreposition ne TIP_PREPOSITION_AFTER)
) {
# No, unknown preposition;
# Use default preposition
$tipPreposition = TIP_PREPOSITION_AFTER;
# Use entire 'insertionPoint' as token
$tipToken = $toc->{options}{'insertionPoint'};
}
# Indicate current ToC to parser
$tokenTipParser->setToc($toc);
# Indicate current preposition to parser
$tokenTipParser->setPreposition($tipPreposition);
# Parse ToC Insertion Point
$tokenTipParser->parse($tipToken);
# Flush remaining buffered text
$tokenTipParser->eof();
}
} # _parseTocInsertionPoints()
#--- HTML::TocInsertor::_processTokenAsInsertionPoint() -----------------------
# function: Check for token being a ToC insertion point (Tip) token and
# process it accordingly.
# args: - $aTokenType: type of token: start, end, comment or text.
# - $aTokenId: token id of currently parsed token
# - $aTokenAttributes: attributes of currently parsed token
# - $aOrigText: complete token
# returns: 1 if successful -- token is processed as insertion point, 0
# if not.
sub _processTokenAsInsertionPoint {
# Get arguments
my ($self, $aTokenType, $aTokenId, $aTokenAttributes, $aOrigText) = @_;
# Local variables
my ($i, $result, $tipToken, $tipTokenId, $tipTokens);
# Bias to token not functioning as a ToC insertion point (Tip) token
$result = 0;
# Alias ToC insertion point (Tip) array of right type
$tipTokens = $self->{_tokensTip}[$aTokenType];
# Loop through tipTokens
$i = 0;
while ($i < scalar @{$tipTokens}) {
# Aliases
$tipToken = $tipTokens->[$i];
$tipTokenId = $tipToken->[TIP_TOKEN_ID];
# Id & attributes match?
if (
($aTokenId =~ m/$tipTokenId/) && (
HTML::TocGenerator::_doesHashContainHash(
$aTokenAttributes, $tipToken->[TIP_INCLUDE_ATTRIBUTES], 0
) &&
HTML::TocGenerator::_doesHashContainHash(
$aTokenAttributes, $tipToken->[TIP_EXCLUDE_ATTRIBUTES], 1
)
)
) {
# Yes, id and attributes match;
# Process ToC insertion point
$self->_processTocInsertionPoint($tipToken);
# Indicate token functions as ToC insertion point
$result = 1;
# Remove Tip token, automatically advancing to next token
splice(@$tipTokens, $i, 1);
}
else {
# No, tag doesn't match ToC insertion point
# Advance to next start token
$i++;
}
}
# Token functions as ToC insertion point?
if ($result) {
# Yes, token functions as ToC insertion point;
# Process insertion point(s)
$self->_processTocInsertionPoints($aOrigText);
}
# Return value
return $result;
} # _processTokenAsInsertionPoint()
#--- HTML::TocInsertor::toc() -------------------------------------------------
# function: Toc processing method. Add toc reference to scenario.
# args: - $aScenario: Scenario to add ToC reference to.
# - $aToc: Reference to ToC to insert.
# note: The ToC hasn't been build yet; only a reference to the ToC to be
# build is inserted.
sub toc {
# Get arguments
my ($self, $aScenario, $aToc) = @_;
# Add toc to scenario
push(@$aScenario, $aToc);
} # toc()
#--- HTML::TocInsertor::_processTocInsertionPoint() ----------------------------
# function: Process ToC insertion point.
# args: - $aTipToken: Reference to token array item which matches the ToC
# insertion point.
sub _processTocInsertionPoint {
# Get arguments
my ($self, $aTipToken) = @_;
# Local variables
my ($tipToc, $tipPreposition);
# Aliases
$tipToc = $aTipToken->[TIP_TOC];
$tipPreposition = $aTipToken->[TIP_PREPOSITION];
SWITCH: {
# Replace token with ToC?
if ($tipPreposition eq TIP_PREPOSITION_REPLACE) {
# Yes, replace token;
# Indicate ToC insertion point has been passed
$self->{_isTocInsertionPointPassed} = 1;
# Add ToC reference to scenario reference by calling 'toc' method
$self->toc($self->{_scenarioAfterToken}, $tipToc);
#push(@{$self->{_scenarioAfterToken}}, $tipTokenToc);
# Indicate token itself must not be output
$self->{_doOutputInsertionPointToken} = 0;
last SWITCH;
}
# Output ToC before token?
if ($tipPreposition eq TIP_PREPOSITION_BEFORE) {
# Yes, output ToC before token;
# Indicate ToC insertion point has been passed
$self->{_isTocInsertionPointPassed} = 1;
# Add ToC reference to scenario reference by calling 'toc' method
$self->toc($self->{_scenarioBeforeToken}, $tipToc);
#push(@{$self->{_scenarioBeforeToken}}, $tipTokenToc);
last SWITCH;
}
# Output ToC after token?
if ($tipPreposition eq TIP_PREPOSITION_AFTER) {
# Yes, output ToC after token;
# Indicate ToC insertion point has been passed
$self->{_isTocInsertionPointPassed} = 1;
# Add ToC reference to scenario reference by calling 'toc' method
$self->toc($self->{_scenarioAfterToken}, $tipToc);
#push(@{$self->{_scenarioAfterToken}}, $tipTokenToc);
last SWITCH;
}
}
} # _processTocInsertionPoint()
#--- HTML::TocInsertor::_processTocInsertionPoints() --------------------------
# function: Process ToC insertion points
# args: - $aTokenText: Text of token which acts as insertion point for one
# or multiple ToCs.
sub _processTocInsertionPoints {
# Get arguments
my ($self, $aTokenText) = @_;
# Local variables
my ($outputPrefix, $outputSuffix);
# Extend scenario
push(@{$self->{_scenario}}, @{$self->{_scenarioBeforeToken}});
if ($outputPrefix = $self->{_outputPrefix}) {
push(@{$self->{_scenario}}, \$outputPrefix);
$self->{_outputPrefix} = "";
}
# Must insertion point token be output?
if ($self->{_doOutputInsertionPointToken}) {
# Yes, output insertion point token;
push(@{$self->{_scenario}}, \$aTokenText);
}
if ($outputSuffix = $self->{_outputSuffix}) {
push(@{$self->{_scenario}}, \$outputSuffix);
$self->{_outputSuffix} = "";
}
push(@{$self->{_scenario}}, @{$self->{_scenarioAfterToken}});
# Add new act to scenario for output to come
my $output = "";
push(@{$self->{_scenario}}, \$output);
# Write output, processing possible '_outputSuffix'
#$self->_writeOrBufferOutput("");
# Reset helper scenario's
$self->{_scenarioBeforeToken} = [];
$self->{_scenarioAfterToken} = [];
# Reset bias value to output insertion point token
$self->{_doOutputInsertionPointToken} = 1;
} # _processTocInsertionPoints()
#--- HTML::Toc::_resetBatchVariables() ----------------------------------------
# function: Reset batch variables.
sub _resetBatchVariables {
my ($self) = @_;
# Call ancestor
$self->SUPER::_resetBatchVariables();
# Array containing references to scalars. This array depicts the order
# in which output must be performed after the first ToC Insertion Point
# has been passed.
$self->{_scenario} = [];
# Helper scenario
$self->{_scenarioBeforeToken} = [];
# Helper scenario
$self->{_scenarioAfterToken} = [];
# Arrays containing start, end, comment, text & declaration tokens which
# must trigger the ToC insertion. Each array element may contain a
# reference to an array containing the following elements:
$self->{_tokensTip} = [
[], # TT_TOKENTYPE_START
[], # TT_TOKENTYPE_END
[], # TT_TOKENTYPE_COMMENT
[], # TT_TOKENTYPE_TEXT
[] # TT_TOKENTYPE_DECLARATION
];
# 1 if ToC insertion point has been passed, 0 if not
$self->{_isTocInsertionPointPassed} = 0;
# Tokens after ToC
$self->{outputBuffer} = "";
# Trailing text after parsed token
$self->{_outputSuffix} = "";
# Preceding text before parsed token
$self->{_outputPrefix} = "";
} # _resetBatchVariables()
#--- HTML::TocInsertor::_writeBufferedOutput() --------------------------------
# function: Write buffered output to output device(s).
sub _writeBufferedOutput {
# Get arguments
my ($self) = @_;
# Local variables
my ($scene);
# Must ToC be parsed?
if ($self->{options}{'parseToc'}) {
# Yes, ToC must be parsed;
# Parse ToC
#$self->parse($self->{toc});
# Output tokens after ToC
#$self->_writeOrBufferOutput($self->{outputBuffer});
}
else {
# No, ToC needn't be parsed;
# Output scenario
foreach $scene (@{$self->{_scenario}}) {
# Is scene a reference to a scalar?
if (ref($scene) eq "SCALAR") {
# Yes, scene is a reference to a scalar;
# Output scene
$self->_writeOutput($$scene);
}
else {
# No, scene must be reference to HTML::Toc;
# Output toc
$self->_writeOutput($scene->format());
}
}
}
} # _writeBufferedOutput()
#--- HTML::TocInsertor::_writeOrBufferOutput() --------------------------------
# function: Write processed HTML to output device(s).
# args: - aOutput: scalar to write
# note: If '_isTocInsertionPointPassed' text is buffered before being
# output because the ToC has to be generated before it can be output.
# Only after the entire data has been parsed, the ToC and the
# following text will be output.
sub _writeOrBufferOutput {
# Get arguments
my ($self, $aOutput) = @_;
# Add possible output prefix and suffix
$aOutput = $self->{_outputPrefix} . $aOutput . $self->{_outputSuffix};
# Clear output prefix and suffix
$self->{_outputPrefix} = "";
$self->{_outputSuffix} = "";
# Has ToC insertion point been passed?
if ($self->{_isTocInsertionPointPassed}) {
# Yes, ToC insertion point has been passed;
# Buffer output; add output to last '_scenario' item
my $index = scalar(@{$self->{_scenario}}) - 1;
${$self->{_scenario}[$index]} .= $aOutput;
}
else {
# No, ToC insertion point hasn't been passed;
# Write output
$self->_writeOutput($aOutput);
}
} # _writeOrBufferOutput()
#--- HTML::TocInsertor::_writeOutput() ----------------------------------------
# function: Write processed HTML to output device(s).
# args: - aOutput: scalar to write
sub _writeOutput {
# Get arguments
my ($self, $aOutput) = @_;
# Write output to scalar;
${$self->{_output}} .= $aOutput if (defined($self->{_output}));
# Write output to output file
print $aOutput if ($self->{_doOutputToFile})
} # _writeOutput()
#--- HTML::TocGenerator::anchorId() -------------------------------------------
# function: Anchor id processing method.
# args: - $aAnchorId
sub anchorId {
# Get arguments
my ($self, $aAnchorId) = @_;
# Indicate id must be added to start tag
$self->{_doAddAnchorIdToStartTag} = 1;
$self->{_anchorId} = $aAnchorId;
} # anchorId()
#--- HTML::TocInsertor::anchorNameBegin() -------------------------------------
# function: Process anchor name begin, generated by HTML::TocGenerator.
# args: - $aAnchorNameBegin: Anchor name begin tag to output.
# - $aToc: Reference to ToC to which anchorname belongs.
sub anchorNameBegin {
# Get arguments
my ($self, $aAnchorNameBegin, $aToc) = @_;
# Is another anchorName active?
if (defined($self->{_activeAnchorName})) {
# Yes, another anchorName is active;
# Show warning
print "Warn\n";
$self->_showWarning(
HTML::TocGenerator::WARNING_NESTED_ANCHOR_PS_WITHIN_PS,
[$aAnchorNameBegin, $self->{_activeAnchorName}]
);
}
# Store anchor name as output prefix
$self->{_outputPrefix} = $aAnchorNameBegin;
# Indicate active anchor name
$self->{_activeAnchorName} = $aAnchorNameBegin;
# Indicate anchor name end must be output
$self->{_doOutputAnchorNameEnd} = 1;
} # anchorNameBegin()
#--- HTML::TocInsertor::anchorNameEnd() ---------------------------------------
# function: Process anchor name end, generated by HTML::TocGenerator.
# args: - $aAnchorNameEnd: Anchor name end tag to output.
# - $aToc: Reference to ToC to which anchorname belongs.
sub anchorNameEnd {
# Get arguments
my ($self, $aAnchorNameEnd) = @_;
# Store anchor name as output prefix
$self->{_outputSuffix} .= $aAnchorNameEnd;
# Indicate deactive anchor name
$self->{_activeAnchorName} = undef;
} # anchorNameEnd()
#--- HTML::TocInsertor::comment() ---------------------------------------------
# function: Process comment.
# args: - $aComment: comment text with '<!--' and '-->' tags stripped off.
sub comment {
# Get arguments
my ($self, $aComment) = @_;
# Local variables
my ($tocInsertionPointToken, $doOutput, $origText);
# Allow ancestor to process the comment tag
$self->SUPER::comment($aComment);
# Assemble original comment
$origText = "<!--$aComment-->";
# Must ToCs be inserted?
if ($self->{hti__Mode} & MODE_DO_INSERT) {
# Yes, ToCs must be inserted;
# Processing comment as ToC insertion point is successful?
if (! $self->_processTokenAsInsertionPoint(
HTML::TocGenerator::TT_TOKENTYPE_COMMENT, $aComment, undef, $origText
)) {
# No, comment isn't a ToC insertion point;
# Output comment normally
$self->_writeOrBufferOutput($origText);
}
}
} # comment()
#--- HTML::TocInsertor::declaration() -----------------------------------------
# function: This function is called every time a declaration is encountered
# by HTML::Parser.
sub declaration {
# Get arguments
my ($self, $aDeclaration) = @_;
# Allow ancestor to process the declaration tag
$self->SUPER::declaration($aDeclaration);
# Must ToCs be inserted?
if ($self->{hti__Mode} & MODE_DO_INSERT) {
# Yes, ToCs must be inserted;
# Processing declaration as ToC insertion point is successful?
if (! $self->_processTokenAsInsertionPoint(
HTML::TocGenerator::TT_TOKENTYPE_DECLARATION, $aDeclaration, undef,
"<!$aDeclaration>"
)) {
# No, declaration isn't a ToC insertion point;
# Output declaration normally
$self->_writeOrBufferOutput("<!$aDeclaration>");
}
}
} # declaration()
#--- HTML::TocInsertor::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) = @_;
# Allow ancestor to process the end tag
$self->SUPER::end($aTag, $aOrigText);
# Must ToCs be inserted?
if ($self->{hti__Mode} & MODE_DO_INSERT) {
# Yes, ToCs must be inserted;
# Processing end tag as ToC insertion point is successful?
if (! $self->_processTokenAsInsertionPoint(
HTML::TocGenerator::TT_TOKENTYPE_END, $aTag, undef, $aOrigText
)) {
# No, end tag isn't a ToC insertion point;
# Output end tag normally
$self->_writeOrBufferOutput($aOrigText);
}
}
} # end()
#--- HTML::TocInsertor::insert() ----------------------------------------------
# function: Insert ToC in string.
# args: - $aToc: (reference to array of) ToC object to insert
# - $aString: string to insert ToC in
# - $aOptions: hash reference with optional insertor options
sub insert {
# Get arguments
my ($self, $aToc, $aString, $aOptions) = @_;
# Initialize TocInsertor batch
$self->_initializeInsertorBatch($aToc, $aOptions);
# Do insert Toc
$self->_insert($aString);
# Deinitialize TocInsertor batch
$self->_deinitializeInsertorBatch();
} # insert()
#--- HTML::TocInsertor::insertIntoFile() --------------------------------------
# function: Insert ToCs in file.
# args: - $aToc: (reference to array of) ToC object(s) to insert.
# - $aFile: (reference to array of) file(s) to parse for insertion
# points.
# - $aOptions: optional insertor options
sub insertIntoFile {
# Get arguments
my ($self, $aToc, $aFile, $aOptions) = @_;
# Initialize TocInsertor batch
$self->_initializeInsertorBatch($aToc, $aOptions);
# Do insert ToCs into file
$self->_insertIntoFile($aFile);
# Deinitialize TocInsertor batch
$self->_deinitializeInsertorBatch();
} # insertIntoFile()
#--- HTML::TocInsertor::number() ----------------------------------------------
# function: Process heading number generated by HTML::Toc.
# args: - $aNumber
sub number {
# Get arguments
my ($self, $aNumber) = @_;
# Store heading number as output suffix
$self->{_outputSuffix} .= $aNumber;
} # number()
#--- HTML::TocInsertor::propagateFile() ---------------------------------------
# function: Propagate ToC; generate & insert ToC, using file as input.
# args: - $aToc: (reference to array of) ToC object to insert
# - $aFile: (reference to array of) file to parse for insertion
# points.
# - $aOptions: optional insertor options
sub propagateFile {
# Get arguments
my ($self, $aToc, $aFile, $aOptions) = @_;
# Local variables;
my ($file, @files);
# Initialize TocInsertor batch
$self->_initializeInsertorBatch($aToc, $aOptions);
# Dereference array reference or make array of file specification
@files = (ref($aFile) =~ m/ARRAY/) ? @$aFile : ($aFile);
# Loop through files
foreach $file (@files) {
# Generate and insert ToC
$self->_generateFromFile($file);
}
# Deinitialize TocInsertor batch
$self->_deinitializeInsertorBatch();
} # propagateFile()
#--- HTML::TocInsertor::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) = @_;
# Local variables
my ($doOutput, $i, $tocToken, $tag, $anchorId);
# Let ancestor process the start tag
$self->SUPER::start($aTag, $aAttr, $aAttrSeq, $aOrigText);
# Must ToC be inserted?
if ($self->{hti__Mode} & MODE_DO_INSERT) {
# Yes, ToC must be inserted;
# Processing start tag as ToC insertion point is successful?
if (! $self->_processTokenAsInsertionPoint(
HTML::TocGenerator::TT_TOKENTYPE_START, $aTag, $aAttr, $aOrigText
)) {
# No, start tag isn't a ToC insertion point;
# Add anchor id?
if ($self->{_doAddAnchorIdToStartTag}) {
# Yes, anchor id must be added;
# Reset indicator;
$self->{_doAddAnchorIdToStartTag} = 0;
# Alias anchor id
$anchorId = $self->{_anchorId};
# Attribute 'id' already exists?
if (defined($aAttr->{id})) {
# Yes, attribute 'id' already exists;
# Show warning
print STDERR "WARNING: Overwriting existing id attribute '" .
$aAttr->{id} . "' of tag $aOrigText\n";
# Add anchor id to start tag
$aOrigText =~ s/(id)=\S*([\s>])/$1=$anchorId$2/i;
}
else {
# No, attribute 'id' doesn't exist;
# Add anchor id to start tag
$aOrigText =~ s/>/ id=$anchorId>/;
}
}
# Output start tag normally
$self->_writeOrBufferOutput($aOrigText);
}
}
} # start()
#--- HTML::TocInsertor::text() ------------------------------------------------
# function: This function is called every time plain text is encountered.
# args: - @_: array containing data.
sub text {
# Get arguments
my ($self, $aText) = @_;
# Let ancestor process the text
$self->SUPER::text($aText);
# Must ToC be inserted?
if ($self->{hti__Mode} & MODE_DO_INSERT) {
# Yes, ToC must be inserted;
# Processing text as ToC insertion point is successful?
if (! $self->_processTokenAsInsertionPoint(
HTML::TocGenerator::TT_TOKENTYPE_TEXT, $aText, undef, $aText
)) {
# No, text isn't a ToC insertion point;
# Output text normally
$self->_writeOrBufferOutput($aText);
}
}
} # text()
#=== HTML::_TokenTipParser ====================================================
# function: Parse 'TIP tokens'. 'TIP tokens' mark HTML code which is to be
# used as the ToC Insertion Point.
# note: Used internally.
package HTML::_TokenTipParser;
BEGIN {
use vars qw(@ISA);
@ISA = qw(HTML::_TokenTocParser);
}
END {}
#--- HTML::_TokenTipParser::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::_TokenTipParser::_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->{_lastAddedToken}}[
HTML::TocInsertor::TIP_INCLUDE_ATTRIBUTES
] = \%includeAttributes;
}
# Exclude attributes are specified?
if (keys(%excludeAttributes) > 0) {
# Yes, exclude attributes are specified;
# Store exclude attributes
@${$self->{_lastAddedToken}}[
HTML::TocInsertor::TIP_EXCLUDE_ATTRIBUTES
] = \%excludeAttributes;
}
} # _processAttributes()
#--- HTML::_TokenTipParser::_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::TocInsertor::TIP_TOC] = $self->{_toc};
$$tokenArray[$index][HTML::TocInsertor::TIP_TOKEN_ID] = $aTag;
$$tokenArray[$index][HTML::TocInsertor::TIP_PREPOSITION] =
$self->{_preposition};
} # _processToken()
#--- HTML::_TokenTipParser::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::_TokenTipParser::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::_TokenTipParser::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::_TokenTipParser->setPreposition() ----------------------------------
# function: Set current preposition.
sub setPreposition {
# Get arguments
my ($self, $aPreposition) = @_;
# Set current ToC
$self->{_preposition} = $aPreposition;
} # setPreposition()
#--- HTML::_TokenTipParser->setToc() ------------------------------------------
# function: Set current ToC.
sub setToc {
# Get arguments
my ($self, $aToc) = @_;
# Set current ToC
$self->{_toc} = $aToc;
} # setToc()
#--- HTML::_TokenTipParser::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::_TokenTipParser::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()
1;