1067 lines
32 KiB
Perl
1067 lines
32 KiB
Perl
|
#--- 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;
|