#--- 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 '' 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 = ""; # 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, "" )) { # No, declaration isn't a ToC insertion point; # Output declaration normally $self->_writeOrBufferOutput(""); } } } # 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 '' 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;