1#=== HTML::Toc ================================================================ 2# function: HTML Table of Contents 3 4 5package HTML::Toc; 6 7 8use strict; 9 10 11BEGIN { 12 use vars qw($VERSION); 13 14 $VERSION = '0.91'; 15} 16 17 18use constant FILE_FILTER => '.*'; 19use constant GROUP_ID_H => 'h'; 20use constant LEVEL_1 => 1; 21use constant NUMBERING_STYLE_DECIMAL => 'decimal'; 22 23 # Templates 24 25 # Anchor templates 26use constant TEMPLATE_ANCHOR_NAME => '$groupId."-".$node'; 27use constant TEMPLATE_ANCHOR_HREF_BEGIN => 28 '"<a href=#$anchorName>"'; 29use constant TEMPLATE_ANCHOR_HREF_BEGIN_FILE => 30 '"<a href=$file#$anchorName>"'; 31use constant TEMPLATE_ANCHOR_HREF_END => '"</a>"'; 32use constant TEMPLATE_ANCHOR_NAME_BEGIN => 33 '"<a name=$anchorName>"'; 34use constant TEMPLATE_ANCHOR_NAME_END => '"</a>"'; 35use constant TOKEN_UPDATE_BEGIN_OF_ANCHOR_NAME_BEGIN => 36 '<!-- #BeginTocAnchorNameBegin -->'; 37use constant TOKEN_UPDATE_END_OF_ANCHOR_NAME_BEGIN => 38 '<!-- #EndTocAnchorNameBegin -->'; 39use constant TOKEN_UPDATE_BEGIN_OF_ANCHOR_NAME_END => 40 '<!-- #BeginTocAnchorNameEnd -->'; 41use constant TOKEN_UPDATE_END_OF_ANCHOR_NAME_END => 42 '<!-- #EndTocAnchorNameEnd -->'; 43use constant TOKEN_UPDATE_BEGIN_NUMBER => 44 '<!-- #BeginTocNumber -->'; 45use constant TOKEN_UPDATE_END_NUMBER => 46 '<!-- #EndTocNumber -->'; 47use constant TOKEN_UPDATE_BEGIN_TOC => 48 '<!-- #BeginToc -->'; 49use constant TOKEN_UPDATE_END_TOC => 50 '<!-- #EndToc -->'; 51 52use constant TEMPLATE_TOKEN_NUMBER => '"$node "'; 53 54 # Level templates 55use constant TEMPLATE_LEVEL => '"<li>$text\n"'; 56use constant TEMPLATE_LEVEL_BEGIN => '"<ul>\n"'; 57use constant TEMPLATE_LEVEL_END => '"</ul>\n"'; 58 59 60END {} 61 62 63#--- HTML::Toc::new() --------------------------------------------------------- 64# function: Constructor 65 66sub new { 67 # Get arguments 68 my ($aType) = @_; 69 # Local variables 70 my $self; 71 72 $self = bless({}, $aType); 73 # Default to empty 'options' array 74 $self->{options} = {}; 75 # Empty toc 76 $self->{_toc} = ""; 77 # Hash reference to array for each groupId, each array element 78 # referring to the group of the level indicated by the array index. 79 # For example, with the default 'tokenGroups', '_levelGroups' would 80 # look like: 81 # 82 # {'h'} => [\$group1, \$group2, \$group3, \$group4, \$group5, \$group6]; 83 # 84 $self->{_levelGroups} = undef; 85 # Set default options 86 $self->_setDefaults(); 87 return $self; 88} # new() 89 90 91#--- HTML::Toc::_compareLevels() ---------------------------------------------- 92# function: Compare levels. 93# args: - $aLevel: pointer to level 94# - $aGroupLevel 95# - $aPreviousLevel 96# - $aPreviousGroupLevel 97# returns: 0 if new level equals previous level, 1 if new level exceeds 98# previous level, -1 if new level is smaller then previous level. 99 100sub _compareLevels { 101 # Get arguments 102 my ( 103 $self, $aLevel, $aPreviousLevel, $aGroupLevel, $aPreviousGroupLevel 104 ) = @_; 105 # Local variables 106 my ($result); 107 # Levels equals? 108 if ( 109 ($aLevel == $aPreviousLevel) && 110 ($aGroupLevel == $aPreviousGroupLevel) 111 ) { 112 # Yes, levels are equals; 113 # Indicate so 114 $result = 0; 115 } 116 else { 117 # No, levels differ; 118 # Bias to new level being smaller than previous level; 119 $result = -1; 120 # Must groups not be nested and do group levels differ? 121 if ( 122 ($self->{options}{'doNestGroup'} == 0) && 123 ($aGroupLevel != $aPreviousGroupLevel) 124 ) { 125 # Yes, groups must be kept apart and the group levels differ; 126 # Level is greater than previous level? 127 if ( 128 ($aLevel > $aPreviousLevel) 129 ) { 130 # Yes, level is greater than previous level; 131 # Indicate so 132 $result = 1; 133 } 134 } 135 else { 136 # No, group must be nested; 137 # Level is greater than previous level? 138 if ( 139 ($aLevel > $aPreviousLevel) || 140 ($aGroupLevel > $aPreviousGroupLevel) 141 ) { 142 # Yes, level is greater than previous level; 143 # Indicate so 144 $result = 1; 145 } 146 } 147 } 148 # Return value 149 return $result; 150} # _compareLevels() 151 152 153#--- HTML::TocGenerator::_formatLevelIndent() --------------------------------- 154# function: Format indent. 155# args: - $aText: text to indent 156# - $aLevel: Level. 157# - $aGroupLevel: Group level. 158# - $aAdd 159# - $aGlobalLevel 160 161sub _formatLevelIndent { 162 # Get arguments 163 my ($self, $aText, $aAdd, $aGlobalLevel) = @_; 164 # Local variables 165 my ($levelIndent, $indent, $nrOfIndents); 166 # Alias indentation option 167 $levelIndent = $self->{options}{'levelIndent'}; #=~ s/[0-9]+/&/; 168 # Calculate number of indents 169 $nrOfIndents = ($aGlobalLevel + $aAdd) * $levelIndent; 170 # Assemble indents 171 $indent = pack("A$nrOfIndents"); 172 # Return value 173 return $indent . $aText; 174} # _formatLevelIndent() 175 176 177#--- HTML::Toc::_formatToc() -------------------------------------------------- 178# function: Format ToC. 179# args: - aPreviousLevel 180# - aPreviousGroupLevel 181# - aToc: ToC to format. 182# - aHeaderLines 183# note: Recursive function this is. 184 185sub _formatToc { 186 # Get arguments 187 my ( 188 $self, $aPreviousLevel, $aPreviousGroupLevel, $aToc, $aHeaderLines, 189 $aGlobalLevel 190 ) = @_; 191 # Local variables 192 my ($level, $groupLevel, $line, $groupId, $text, $compareStatus); 193 my ($anchorName, $globalLevel, $node, $sequenceNr); 194 195 LOOP: { 196 # Lines need processing? 197 while (scalar(@$aHeaderLines) > 0) { 198 # Yes, lines need processing; 199 # Get line 200 $line = shift @$aHeaderLines; 201 202 # Determine levels 203 ($level, $groupLevel, $groupId, $node, $sequenceNr, 204 $anchorName, $text) = split( 205 / /, $line, 7 206 ); 207 # Must level and group be processed? 208 if ( 209 ($level =~ m/$self->{options}{'levelToToc'}/) && 210 ($groupId =~ m/$self->{options}{'groupToToc'}/) 211 ) { 212 # Yes, level must be processed; 213 # Compare levels 214 $compareStatus = $self->_compareLevels( 215 $level, $aPreviousLevel, $groupLevel, $aPreviousGroupLevel 216 ); 217 218 COMPARE_LEVELS: { 219 220 # Equals? 221 if ($compareStatus == 0) { 222 # Yes, levels are equal; 223 # Format level 224 $$aToc .= $self->_formatLevelIndent( 225 ref($self->{_templateLevel}) eq "CODE" ? 226 &{$self->{_templateLevel}}( 227 $level, $groupId, $node, $sequenceNr, $text 228 ) : 229 eval($self->{_templateLevel}), 230 0, $aGlobalLevel 231 ); 232 } 233 234 # Greater? 235 if ($compareStatus > 0) { 236 # Yes, new level is greater than previous level; 237 # Must level be single-stepped? 238 if ( 239 $self->{options}{'doSingleStepLevel'} && 240 ($aPreviousLevel) && 241 ($level > $aPreviousLevel) 242 ) { 243 # Yes, level must be single-stepped; 244 # Make sure, new level is increased one step only 245 $level = $aPreviousLevel + 1; 246 } 247 # Increase global level 248 $aGlobalLevel++; 249 # Format begin of level 250 $$aToc .= $self->_formatLevelIndent( 251 eval($self->{_templateLevelBegin}), -1, $aGlobalLevel 252 ); 253 # Process line again 254 unshift @$aHeaderLines, $line; 255 # Assemble TOC (recursive) for next level 256 $self->_formatToc( 257 $level, $groupLevel, $aToc, $aHeaderLines, $aGlobalLevel 258 ); 259 # Format end of level 260 $$aToc .= $self->_formatLevelIndent( 261 eval($self->{_templateLevelEnd}), -1, $aGlobalLevel 262 ); 263 # Decrease global level 264 $aGlobalLevel--; 265 # Exit loop 266 last COMPARE_LEVELS; 267 } 268 269 # Smaller? 270 if ($compareStatus < 0) { 271 # Yes, new level is smaller than previous level; 272 # Process line again 273 unshift @$aHeaderLines, $line; 274 # End loop 275 last LOOP; 276 } 277 } 278 } 279 } 280 } 281} # _formatToc() 282 283 284#--- HTML::Toc::_parseTokenGroups() ------------------------------------------- 285# function: Parse token groups 286 287sub _parseTokenGroups { 288 # Get arguments 289 my ($self) = @_; 290 # Local variables 291 my ($group, $levelGroups, $numberingStyle); 292 293 # Clear any previous 'levelGroups' 294 $self->{_levelGroups} = undef; 295 # Determine default 'numberingStyle' 296 $numberingStyle = defined($self->{options}{'numberingStyle'}) ? 297 $self->{options}{'numberingStyle'} : NUMBERING_STYLE_DECIMAL; 298 299 # Loop through groups 300 foreach $group (@{$self->{options}{'tokenToToc'}}) { 301 # 'groupId' is specified? 302 if (! defined($group->{'groupId'})) { 303 # No, 'groupId' isn't specified; 304 # Set default groupId 305 $group->{'groupId'} = GROUP_ID_H; 306 } 307 # 'level' is specified? 308 if (! defined($group->{'level'})) { 309 # No, 'level' isn't specified; 310 # Set default level 311 $group->{'level'} = LEVEL_1; 312 } 313 # 'numberingStyle' is specified? 314 if (! defined($group->{'numberingStyle'})) { 315 # No, 'numberingStyle' isn't specified; 316 # Set default numberingStyle 317 $group->{'numberingStyle'} = $numberingStyle; 318 } 319 # Add group to '_levelGroups' variabele 320 $self->{_levelGroups}{$group->{'groupId'}}[$group->{'level'} - 1] = 321 $group; 322 } 323} # _parseTokenGroups() 324 325 326#--- HTML::Toc::_setDefaults() ------------------------------------------------ 327# function: Set default options. 328 329sub _setDefaults { 330 # Get arguments 331 my ($self) = @_; 332 # Set default options 333 $self->setOptions( 334 { 335 'attributeToExcludeToken' => '-', 336 'attributeToTocToken' => '@', 337 'insertionPoint' => 'after <body>', 338 'levelToToc' => '.*', 339 'groupToToc' => '.*', 340 'doNumberToken' => 0, 341 'doLinkToFile' => 0, 342 'doLinkToToken' => 1, 343 'doLinkToId' => 0, 344 'doSingleStepLevel' => 1, 345 'linkUri' => '', 346 'levelIndent' => 3, 347 'doNestGroup' => 0, 348 'doUseExistingAnchors' => 1, 349 'doUseExistingIds' => 1, 350 'tokenToToc' => [ 351 { 352 'level' => 1, 353 'tokenBegin' => '<h1>' 354 }, { 355 'level' => 2, 356 'tokenBegin' => '<h2>' 357 }, { 358 'level' => 3, 359 'tokenBegin' => '<h3>' 360 }, { 361 'level' => 4, 362 'tokenBegin' => '<h4>' 363 }, { 364 'level' => 5, 365 'tokenBegin' => '<h5>' 366 }, { 367 'level' => 6, 368 'tokenBegin' => '<h6>' 369 } 370 ], 371 'header' => 372 "\n<!-- Table of Contents generated by Perl - HTML::Toc -->\n", 373 'footer' => 374 "\n<!-- End of generated Table of Contents -->\n", 375 } 376 ); 377} # _setDefaults() 378 379 380#--- HTML::Toc::clear() ------------------------------------------------------- 381# function: Clear ToC. 382 383sub clear { 384 # Get arguments 385 my ($self) = @_; 386 # Clear ToC 387 $self->{_toc} = ""; 388 $self->{toc} = ""; 389 $self->{groupIdLevels} = undef; 390 $self->{levels} = undef; 391} # clear() 392 393 394#--- HTML::Toc::format() ------------------------------------------------------ 395# function: Format ToC. 396# returns: Formatted ToC. 397 398sub format { 399 # Get arguments 400 my ($self) = @_; 401 # Local variables; 402 my $toc = ""; 403 my @tocLines = split(/\r\n|\n/, $self->{_toc}); 404 # Format table of contents 405 $self->_formatToc("0", "0", \$toc, \@tocLines, 0); 406 # Remove last newline 407 $toc =~ s/\n$//m; 408 # Add header & footer 409 $toc = $self->{options}{'header'} . $toc . $self->{options}{'footer'}; 410 # Return value 411 return $toc; 412} # format() 413 414 415#--- HTML::Toc::parseOptions() ------------------------------------------------ 416# function: Parse options. 417 418sub parseOptions { 419 # Get arguments 420 my ($self) = @_; 421 # Alias options 422 my $options = $self->{options}; 423 424 # Parse token groups 425 $self->_parseTokenGroups(); 426 427 # Link ToC to tokens? 428 if ($self->{options}{'doLinkToToken'}) { 429 # Yes, link ToC to tokens; 430 # Determine anchor href template begin 431 $self->{_templateAnchorHrefBegin} = 432 defined($options->{'templateAnchorHrefBegin'}) ? 433 $options->{'templateAnchorHrefBegin'} : 434 $options->{'doLinkToFile'} ? 435 TEMPLATE_ANCHOR_HREF_BEGIN_FILE : TEMPLATE_ANCHOR_HREF_BEGIN; 436 437 # Determine anchor href template end 438 $self->{_templateAnchorHrefEnd} = 439 defined($options->{'templateAnchorHrefEnd'}) ? 440 $options->{'templateAnchorHrefEnd'} : 441 TEMPLATE_ANCHOR_HREF_END; 442 443 # Determine anchor name template 444 $self->{_templateAnchorName} = 445 defined($options->{'templateAnchorName'}) ? 446 $options->{'templateAnchorName'} : 447 TEMPLATE_ANCHOR_NAME; 448 449 # Determine anchor name template begin 450 $self->{_templateAnchorNameBegin} = 451 defined($options->{'templateAnchorNameBegin'}) ? 452 $options->{'templateAnchorNameBegin'} : 453 TEMPLATE_ANCHOR_NAME_BEGIN; 454 455 # Determine anchor name template end 456 $self->{_templateAnchorNameEnd} = 457 defined($options->{'templateAnchorNameEnd'}) ? 458 $options->{'templateAnchorNameEnd'} : 459 TEMPLATE_ANCHOR_NAME_END; 460 } 461 462 # Determine token number template 463 $self->{_templateTokenNumber} = 464 defined($options->{'templateTokenNumber'}) ? 465 $options->{'templateTokenNumber'} : 466 TEMPLATE_TOKEN_NUMBER; 467 468 # Determine level template 469 $self->{_templateLevel} = 470 defined($options->{'templateLevel'}) ? 471 $options->{'templateLevel'} : 472 TEMPLATE_LEVEL; 473 474 # Determine level begin template 475 $self->{_templateLevelBegin} = 476 defined($options->{'templateLevelBegin'}) ? 477 $options->{'templateLevelBegin'} : 478 TEMPLATE_LEVEL_BEGIN; 479 480 # Determine level end template 481 $self->{_templateLevelEnd} = 482 defined($options->{'templateLevelEnd'}) ? 483 $options->{'templateLevelEnd'} : 484 TEMPLATE_LEVEL_END; 485 486 # Determine 'anchor name begin' begin update token 487 $self->{_tokenUpdateBeginOfAnchorNameBegin} = 488 defined($options->{'tokenUpdateBeginOfAnchorNameBegin'}) ? 489 $options->{'tokenUpdateBeginOfAnchorNameBegin'} : 490 TOKEN_UPDATE_BEGIN_OF_ANCHOR_NAME_BEGIN; 491 492 # Determine 'anchor name begin' end update token 493 $self->{_tokenUpdateEndOfAnchorNameBegin} = 494 defined($options->{'tokenUpdateEndOfAnchorNameBegin'}) ? 495 $options->{'tokenUpdateEndOfAnchorNameBegin'} : 496 TOKEN_UPDATE_END_OF_ANCHOR_NAME_BEGIN; 497 498 # Determine 'anchor name end' begin update token 499 $self->{_tokenUpdateBeginOfAnchorNameEnd} = 500 defined($options->{'tokenUpdateBeginOfAnchorNameEnd'}) ? 501 $options->{'tokenUpdateBeginOfAnchorNameEnd'} : 502 TOKEN_UPDATE_BEGIN_OF_ANCHOR_NAME_END; 503 504 # Determine 'anchor name end' end update token 505 $self->{_tokenUpdateEndOfAnchorNameEnd} = 506 defined($options->{'tokenUpdateEndOfAnchorNameEnd'}) ? 507 $options->{'tokenUpdateEndOfAnchorNameEnd'} : 508 TOKEN_UPDATE_END_OF_ANCHOR_NAME_END; 509 510 # Determine number begin update token 511 $self->{_tokenUpdateBeginNumber} = 512 defined($options->{'tokenUpdateBeginNumber'}) ? 513 $options->{'tokenUpdateBeginNumber'} : 514 TOKEN_UPDATE_BEGIN_NUMBER; 515 516 # Determine number end update token 517 $self->{_tokenUpdateEndNumber} = 518 defined($options->{'tokenUpdateEndNumber'}) ? 519 $options->{'tokenUpdateEndNumber'} : 520 TOKEN_UPDATE_END_NUMBER; 521 522 # Determine toc begin update token 523 $self->{_tokenUpdateBeginToc} = 524 defined($options->{'tokenUpdateBeginToc'}) ? 525 $options->{'tokenUpdateBeginToc'} : 526 TOKEN_UPDATE_BEGIN_TOC; 527 528 # Determine toc end update token 529 $self->{_tokenUpdateEndToc} = 530 defined($options->{'tokenUpdateEndToc'}) ? 531 $options->{'tokenUpdateEndToc'} : 532 TOKEN_UPDATE_END_TOC; 533 534} # parseOptions() 535 536 537#--- HTML::Toc::setOptions() -------------------------------------------------- 538# function: Set options. 539# args: - aOptions: Reference to hash containing options. 540 541sub setOptions { 542 # Get arguments 543 my ($self, $aOptions) = @_; 544 # Add options 545 %{$self->{options}} = (%{$self->{options}}, %$aOptions); 546} # setOptions() 547 548 5491; 550