ref: 1b27e93cd13ff60798e31634ddb362fa7aa9749d
dir: /examples/includes/HTML-Toc-0.91/Toc.pm/
#=== HTML::Toc ================================================================ # function: HTML Table of Contents package HTML::Toc; use strict; BEGIN { use vars qw($VERSION); $VERSION = '0.91'; } use constant FILE_FILTER => '.*'; use constant GROUP_ID_H => 'h'; use constant LEVEL_1 => 1; use constant NUMBERING_STYLE_DECIMAL => 'decimal'; # Templates # Anchor templates use constant TEMPLATE_ANCHOR_NAME => '$groupId."-".$node'; use constant TEMPLATE_ANCHOR_HREF_BEGIN => '"<a href=#$anchorName>"'; use constant TEMPLATE_ANCHOR_HREF_BEGIN_FILE => '"<a href=$file#$anchorName>"'; use constant TEMPLATE_ANCHOR_HREF_END => '"</a>"'; use constant TEMPLATE_ANCHOR_NAME_BEGIN => '"<a name=$anchorName>"'; use constant TEMPLATE_ANCHOR_NAME_END => '"</a>"'; use constant TOKEN_UPDATE_BEGIN_OF_ANCHOR_NAME_BEGIN => '<!-- #BeginTocAnchorNameBegin -->'; use constant TOKEN_UPDATE_END_OF_ANCHOR_NAME_BEGIN => '<!-- #EndTocAnchorNameBegin -->'; use constant TOKEN_UPDATE_BEGIN_OF_ANCHOR_NAME_END => '<!-- #BeginTocAnchorNameEnd -->'; use constant TOKEN_UPDATE_END_OF_ANCHOR_NAME_END => '<!-- #EndTocAnchorNameEnd -->'; use constant TOKEN_UPDATE_BEGIN_NUMBER => '<!-- #BeginTocNumber -->'; use constant TOKEN_UPDATE_END_NUMBER => '<!-- #EndTocNumber -->'; use constant TOKEN_UPDATE_BEGIN_TOC => '<!-- #BeginToc -->'; use constant TOKEN_UPDATE_END_TOC => '<!-- #EndToc -->'; use constant TEMPLATE_TOKEN_NUMBER => '"$node "'; # Level templates use constant TEMPLATE_LEVEL => '"<li>$text\n"'; use constant TEMPLATE_LEVEL_BEGIN => '"<ul>\n"'; use constant TEMPLATE_LEVEL_END => '"</ul>\n"'; END {} #--- HTML::Toc::new() --------------------------------------------------------- # function: Constructor sub new { # Get arguments my ($aType) = @_; # Local variables my $self; $self = bless({}, $aType); # Default to empty 'options' array $self->{options} = {}; # Empty toc $self->{_toc} = ""; # Hash reference to array for each groupId, each array element # referring to the group of the level indicated by the array index. # For example, with the default 'tokenGroups', '_levelGroups' would # look like: # # {'h'} => [\$group1, \$group2, \$group3, \$group4, \$group5, \$group6]; # $self->{_levelGroups} = undef; # Set default options $self->_setDefaults(); return $self; } # new() #--- HTML::Toc::_compareLevels() ---------------------------------------------- # function: Compare levels. # args: - $aLevel: pointer to level # - $aGroupLevel # - $aPreviousLevel # - $aPreviousGroupLevel # returns: 0 if new level equals previous level, 1 if new level exceeds # previous level, -1 if new level is smaller then previous level. sub _compareLevels { # Get arguments my ( $self, $aLevel, $aPreviousLevel, $aGroupLevel, $aPreviousGroupLevel ) = @_; # Local variables my ($result); # Levels equals? if ( ($aLevel == $aPreviousLevel) && ($aGroupLevel == $aPreviousGroupLevel) ) { # Yes, levels are equals; # Indicate so $result = 0; } else { # No, levels differ; # Bias to new level being smaller than previous level; $result = -1; # Must groups not be nested and do group levels differ? if ( ($self->{options}{'doNestGroup'} == 0) && ($aGroupLevel != $aPreviousGroupLevel) ) { # Yes, groups must be kept apart and the group levels differ; # Level is greater than previous level? if ( ($aLevel > $aPreviousLevel) ) { # Yes, level is greater than previous level; # Indicate so $result = 1; } } else { # No, group must be nested; # Level is greater than previous level? if ( ($aLevel > $aPreviousLevel) || ($aGroupLevel > $aPreviousGroupLevel) ) { # Yes, level is greater than previous level; # Indicate so $result = 1; } } } # Return value return $result; } # _compareLevels() #--- HTML::TocGenerator::_formatLevelIndent() --------------------------------- # function: Format indent. # args: - $aText: text to indent # - $aLevel: Level. # - $aGroupLevel: Group level. # - $aAdd # - $aGlobalLevel sub _formatLevelIndent { # Get arguments my ($self, $aText, $aAdd, $aGlobalLevel) = @_; # Local variables my ($levelIndent, $indent, $nrOfIndents); # Alias indentation option $levelIndent = $self->{options}{'levelIndent'}; #=~ s/[0-9]+/&/; # Calculate number of indents $nrOfIndents = ($aGlobalLevel + $aAdd) * $levelIndent; # Assemble indents $indent = pack("A$nrOfIndents"); # Return value return $indent . $aText; } # _formatLevelIndent() #--- HTML::Toc::_formatToc() -------------------------------------------------- # function: Format ToC. # args: - aPreviousLevel # - aPreviousGroupLevel # - aToc: ToC to format. # - aHeaderLines # note: Recursive function this is. sub _formatToc { # Get arguments my ( $self, $aPreviousLevel, $aPreviousGroupLevel, $aToc, $aHeaderLines, $aGlobalLevel ) = @_; # Local variables my ($level, $groupLevel, $line, $groupId, $text, $compareStatus); my ($anchorName, $globalLevel, $node, $sequenceNr); LOOP: { # Lines need processing? while (scalar(@$aHeaderLines) > 0) { # Yes, lines need processing; # Get line $line = shift @$aHeaderLines; # Determine levels ($level, $groupLevel, $groupId, $node, $sequenceNr, $anchorName, $text) = split( / /, $line, 7 ); # Must level and group be processed? if ( ($level =~ m/$self->{options}{'levelToToc'}/) && ($groupId =~ m/$self->{options}{'groupToToc'}/) ) { # Yes, level must be processed; # Compare levels $compareStatus = $self->_compareLevels( $level, $aPreviousLevel, $groupLevel, $aPreviousGroupLevel ); COMPARE_LEVELS: { # Equals? if ($compareStatus == 0) { # Yes, levels are equal; # Format level $$aToc .= $self->_formatLevelIndent( ref($self->{_templateLevel}) eq "CODE" ? &{$self->{_templateLevel}}( $level, $groupId, $node, $sequenceNr, $text ) : eval($self->{_templateLevel}), 0, $aGlobalLevel ); } # Greater? if ($compareStatus > 0) { # Yes, new level is greater than previous level; # Must level be single-stepped? if ( $self->{options}{'doSingleStepLevel'} && ($aPreviousLevel) && ($level > $aPreviousLevel) ) { # Yes, level must be single-stepped; # Make sure, new level is increased one step only $level = $aPreviousLevel + 1; } # Increase global level $aGlobalLevel++; # Format begin of level $$aToc .= $self->_formatLevelIndent( eval($self->{_templateLevelBegin}), -1, $aGlobalLevel ); # Process line again unshift @$aHeaderLines, $line; # Assemble TOC (recursive) for next level $self->_formatToc( $level, $groupLevel, $aToc, $aHeaderLines, $aGlobalLevel ); # Format end of level $$aToc .= $self->_formatLevelIndent( eval($self->{_templateLevelEnd}), -1, $aGlobalLevel ); # Decrease global level $aGlobalLevel--; # Exit loop last COMPARE_LEVELS; } # Smaller? if ($compareStatus < 0) { # Yes, new level is smaller than previous level; # Process line again unshift @$aHeaderLines, $line; # End loop last LOOP; } } } } } } # _formatToc() #--- HTML::Toc::_parseTokenGroups() ------------------------------------------- # function: Parse token groups sub _parseTokenGroups { # Get arguments my ($self) = @_; # Local variables my ($group, $levelGroups, $numberingStyle); # Clear any previous 'levelGroups' $self->{_levelGroups} = undef; # Determine default 'numberingStyle' $numberingStyle = defined($self->{options}{'numberingStyle'}) ? $self->{options}{'numberingStyle'} : NUMBERING_STYLE_DECIMAL; # Loop through groups foreach $group (@{$self->{options}{'tokenToToc'}}) { # 'groupId' is specified? if (! defined($group->{'groupId'})) { # No, 'groupId' isn't specified; # Set default groupId $group->{'groupId'} = GROUP_ID_H; } # 'level' is specified? if (! defined($group->{'level'})) { # No, 'level' isn't specified; # Set default level $group->{'level'} = LEVEL_1; } # 'numberingStyle' is specified? if (! defined($group->{'numberingStyle'})) { # No, 'numberingStyle' isn't specified; # Set default numberingStyle $group->{'numberingStyle'} = $numberingStyle; } # Add group to '_levelGroups' variabele $self->{_levelGroups}{$group->{'groupId'}}[$group->{'level'} - 1] = $group; } } # _parseTokenGroups() #--- HTML::Toc::_setDefaults() ------------------------------------------------ # function: Set default options. sub _setDefaults { # Get arguments my ($self) = @_; # Set default options $self->setOptions( { 'attributeToExcludeToken' => '-', 'attributeToTocToken' => '@', 'insertionPoint' => 'after <body>', 'levelToToc' => '.*', 'groupToToc' => '.*', 'doNumberToken' => 0, 'doLinkToFile' => 0, 'doLinkToToken' => 1, 'doLinkToId' => 0, 'doSingleStepLevel' => 1, 'linkUri' => '', 'levelIndent' => 3, 'doNestGroup' => 0, 'doUseExistingAnchors' => 1, 'doUseExistingIds' => 1, 'tokenToToc' => [ { 'level' => 1, 'tokenBegin' => '<h1>' }, { 'level' => 2, 'tokenBegin' => '<h2>' }, { 'level' => 3, 'tokenBegin' => '<h3>' }, { 'level' => 4, 'tokenBegin' => '<h4>' }, { 'level' => 5, 'tokenBegin' => '<h5>' }, { 'level' => 6, 'tokenBegin' => '<h6>' } ], 'header' => "\n<!-- Table of Contents generated by Perl - HTML::Toc -->\n", 'footer' => "\n<!-- End of generated Table of Contents -->\n", } ); } # _setDefaults() #--- HTML::Toc::clear() ------------------------------------------------------- # function: Clear ToC. sub clear { # Get arguments my ($self) = @_; # Clear ToC $self->{_toc} = ""; $self->{toc} = ""; $self->{groupIdLevels} = undef; $self->{levels} = undef; } # clear() #--- HTML::Toc::format() ------------------------------------------------------ # function: Format ToC. # returns: Formatted ToC. sub format { # Get arguments my ($self) = @_; # Local variables; my $toc = ""; my @tocLines = split(/\r\n|\n/, $self->{_toc}); # Format table of contents $self->_formatToc("0", "0", \$toc, \@tocLines, 0); # Remove last newline $toc =~ s/\n$//m; # Add header & footer $toc = $self->{options}{'header'} . $toc . $self->{options}{'footer'}; # Return value return $toc; } # format() #--- HTML::Toc::parseOptions() ------------------------------------------------ # function: Parse options. sub parseOptions { # Get arguments my ($self) = @_; # Alias options my $options = $self->{options}; # Parse token groups $self->_parseTokenGroups(); # Link ToC to tokens? if ($self->{options}{'doLinkToToken'}) { # Yes, link ToC to tokens; # Determine anchor href template begin $self->{_templateAnchorHrefBegin} = defined($options->{'templateAnchorHrefBegin'}) ? $options->{'templateAnchorHrefBegin'} : $options->{'doLinkToFile'} ? TEMPLATE_ANCHOR_HREF_BEGIN_FILE : TEMPLATE_ANCHOR_HREF_BEGIN; # Determine anchor href template end $self->{_templateAnchorHrefEnd} = defined($options->{'templateAnchorHrefEnd'}) ? $options->{'templateAnchorHrefEnd'} : TEMPLATE_ANCHOR_HREF_END; # Determine anchor name template $self->{_templateAnchorName} = defined($options->{'templateAnchorName'}) ? $options->{'templateAnchorName'} : TEMPLATE_ANCHOR_NAME; # Determine anchor name template begin $self->{_templateAnchorNameBegin} = defined($options->{'templateAnchorNameBegin'}) ? $options->{'templateAnchorNameBegin'} : TEMPLATE_ANCHOR_NAME_BEGIN; # Determine anchor name template end $self->{_templateAnchorNameEnd} = defined($options->{'templateAnchorNameEnd'}) ? $options->{'templateAnchorNameEnd'} : TEMPLATE_ANCHOR_NAME_END; } # Determine token number template $self->{_templateTokenNumber} = defined($options->{'templateTokenNumber'}) ? $options->{'templateTokenNumber'} : TEMPLATE_TOKEN_NUMBER; # Determine level template $self->{_templateLevel} = defined($options->{'templateLevel'}) ? $options->{'templateLevel'} : TEMPLATE_LEVEL; # Determine level begin template $self->{_templateLevelBegin} = defined($options->{'templateLevelBegin'}) ? $options->{'templateLevelBegin'} : TEMPLATE_LEVEL_BEGIN; # Determine level end template $self->{_templateLevelEnd} = defined($options->{'templateLevelEnd'}) ? $options->{'templateLevelEnd'} : TEMPLATE_LEVEL_END; # Determine 'anchor name begin' begin update token $self->{_tokenUpdateBeginOfAnchorNameBegin} = defined($options->{'tokenUpdateBeginOfAnchorNameBegin'}) ? $options->{'tokenUpdateBeginOfAnchorNameBegin'} : TOKEN_UPDATE_BEGIN_OF_ANCHOR_NAME_BEGIN; # Determine 'anchor name begin' end update token $self->{_tokenUpdateEndOfAnchorNameBegin} = defined($options->{'tokenUpdateEndOfAnchorNameBegin'}) ? $options->{'tokenUpdateEndOfAnchorNameBegin'} : TOKEN_UPDATE_END_OF_ANCHOR_NAME_BEGIN; # Determine 'anchor name end' begin update token $self->{_tokenUpdateBeginOfAnchorNameEnd} = defined($options->{'tokenUpdateBeginOfAnchorNameEnd'}) ? $options->{'tokenUpdateBeginOfAnchorNameEnd'} : TOKEN_UPDATE_BEGIN_OF_ANCHOR_NAME_END; # Determine 'anchor name end' end update token $self->{_tokenUpdateEndOfAnchorNameEnd} = defined($options->{'tokenUpdateEndOfAnchorNameEnd'}) ? $options->{'tokenUpdateEndOfAnchorNameEnd'} : TOKEN_UPDATE_END_OF_ANCHOR_NAME_END; # Determine number begin update token $self->{_tokenUpdateBeginNumber} = defined($options->{'tokenUpdateBeginNumber'}) ? $options->{'tokenUpdateBeginNumber'} : TOKEN_UPDATE_BEGIN_NUMBER; # Determine number end update token $self->{_tokenUpdateEndNumber} = defined($options->{'tokenUpdateEndNumber'}) ? $options->{'tokenUpdateEndNumber'} : TOKEN_UPDATE_END_NUMBER; # Determine toc begin update token $self->{_tokenUpdateBeginToc} = defined($options->{'tokenUpdateBeginToc'}) ? $options->{'tokenUpdateBeginToc'} : TOKEN_UPDATE_BEGIN_TOC; # Determine toc end update token $self->{_tokenUpdateEndToc} = defined($options->{'tokenUpdateEndToc'}) ? $options->{'tokenUpdateEndToc'} : TOKEN_UPDATE_END_TOC; } # parseOptions() #--- HTML::Toc::setOptions() -------------------------------------------------- # function: Set options. # args: - aOptions: Reference to hash containing options. sub setOptions { # Get arguments my ($self, $aOptions) = @_; # Add options %{$self->{options}} = (%{$self->{options}}, %$aOptions); } # setOptions() 1;