1#==== HTML::TocUpdator ======================================================== 2# function: Update 'HTML::Toc' table of contents. 3# note: - 'TUT' is an abbreviation of 'Toc Update Token'. 4 5 6package HTML::TocUpdator; 7 8 9use strict; 10use HTML::TocInsertor; 11 12 13BEGIN { 14 use vars qw(@ISA $VERSION); 15 16 $VERSION = '0.91'; 17 18 @ISA = qw(HTML::TocInsertor); 19} 20 21 22use constant TUT_TOKENTYPE_START => 0; 23use constant TUT_TOKENTYPE_END => 1; 24use constant TUT_TOKENTYPE_TEXT => 2; 25use constant TUT_TOKENTYPE_COMMENT => 3; 26 27use constant MODE_DO_NOTHING => 0; # 0b00 28use constant MODE_DO_INSERT => 1; # 0b01 29use constant MODE_DO_UPDATE => 3; # 0b11 30 31 32END {} 33 34 35#--- HTML::TocUpdator::new() -------------------------------------------------- 36# function: Constructor. 37 38sub new { 39 # Get arguments 40 my ($aType) = @_; 41 my $self = $aType->SUPER::new; 42 # Bias to not update ToC 43 $self->{htu__Mode} = MODE_DO_NOTHING; 44 # Bias to not delete tokens 45 $self->{_doDeleteTokens} = 0; 46 # Reset batch variables 47 #$self->_resetBatchVariables; 48 49 $self->{options} = {}; 50 51 # TODO: Initialize output 52 53 return $self; 54} # new() 55 56 57#--- HTML::TocUpdator::_deinitializeUpdatorBatch() -------------------------- 58# function: Deinitialize updator batch. 59# args: - $aTocs: Reference to array of tocs. 60 61sub _deinitializeUpdatorBatch { 62 # Get arguments 63 my ($self, $aTocs) = @_; 64 # Indicate end of ToC updating 65 $self->{htu__Mode} = MODE_DO_NOTHING; 66 # Deinitialize insertor batch 67 $self->_deinitializeInsertorBatch(); 68} # _deinitializeUpdatorBatch() 69 70 71#--- HTML::TokenUpdator::_doesHashEqualHash() --------------------------------- 72# function: Determines whether hash1 equals hash2. 73# args: - $aHash1 74# - $aHash2 75# returns: True (1) if hash1 equals hash2, 0 if not. For example, with the 76# following hashes: 77# 78# %hash1 = { %hash2 = { 79# 'class' => 'header', 'class' => 'header', 80# 'id' => 'intro1' 'id' => 'intro2' 81# } } 82# 83# the routine will return 0, cause the hash fields 'id' differ. 84# note: Class function. 85 86sub _doesHashEqualHash { 87 # Get arguments 88 my ($aHash1, $aHash2) = @_; 89 # Local variables 90 my ($key1, $value1, $key2, $value2, $result); 91 # Bias to success 92 $result = 1; 93 # Loop through hash1 while values available 94 HASH1: while (($key1, $value1) = each %$aHash1) { 95 # Yes, values are available; 96 # Value1 differs from value2? 97 if ($value1 ne $aHash2->{$key1}) { 98 # Yes, hashes differ; 99 # Indicate condition fails 100 $result = 0; 101 # Reset 'each' iterator which we're going to break 102 keys %$aHash2; 103 # Break loop 104 last HASH1; 105 } 106 } 107 # Return value 108 return $result; 109} # _doesHashEqualHash() 110 111 112#--- HTML::TokenUpdator::_doesTagExistInArray() ------------------------------- 113# function: Check whether tag & attributes matches any of the tags & attributes 114# in the specified array. The array must consist of elements with 115# format: 116# 117# [$tag, \%attributes] 118# 119# args: - $aTag: tag to search for 120# - $aAttributes: tag attributes to search for 121# - $aArray: Array to search in. 122# returns: 1 if tag does exist in array, 0 if not. 123# note: Class function. 124 125sub _doesTagExistInArray { 126 # Get arguments 127 my ($aTag, $aAttributes, $aArray) = @_; 128 # Local variables 129 my ($tag, $result); 130 # Bias to non-existing tag 131 $result = 0; 132 # Loop through existing tags 133 TAG: foreach $tag (@{$aArray}) { 134 if (defined(@{$tag}[0])) { 135 # Does tag equals any existing tag? 136 if ($aTag eq @{$tag}[0]) { 137 # Yes, tag equals existing tag; 138 # Do hashes equal? 139 if (HTML::TocUpdator::_doesHashEqualHash( 140 $aAttributes, @{$tag}[1] 141 )) { 142 # Yes, hashes are the same; 143 # Indicate tag exists in array 144 $result = 1; 145 # Break loop 146 last TAG; 147 } 148 } 149 } 150 } 151 # Return value 152 return $result; 153} # _doesTagExistInArray() 154 155 156#--- HTML::TocUpdator::_initializeUpdatorBatch() ---------------------------- 157# function: Initialize insertor batch. 158# args: - $aMode: Mode. Can be either MODE_DO_INSERT or MODE_DO_UPDATE 159# - $aTocs: Reference to array of tocs. 160# - $aOptions: optional options 161# note: Updating actually means: deleting the old ToC and inserting a new 162# ToC. That's why we're calling 'insertor' methods here. 163 164sub _initializeUpdatorBatch { 165 # Get arguments 166 my ($self, $aMode, $aTocs, $aOptions) = @_; 167 # Initialize insertor batch 168 $self->_initializeInsertorBatch($aTocs, $aOptions); 169 # Parse ToC update templates 170 $self->_parseTocUpdateTokens(); 171 # Indicate start of ToC updating 172 $self->{htu__Mode} = $aMode; 173} # _initializeUpdatorBatch() 174 175 176#--- HTML::TocUpdator::_parseTocUpdateTokens() -------------------------------- 177# function: Parse ToC insertion point specifier. 178 179sub _parseTocUpdateTokens { 180 # Get arguments 181 my ($self) = @_; 182 # Local variables 183 my ($toc, $tokenType, $tokenPreposition, $token); 184 my ($tocInsertionPoint, $tocInsertionPointTokenAttributes); 185 # Create parser for update begin tokens 186 my $tokenUpdateBeginParser = HTML::_TokenUpdateParser->new( 187 $self->{_tokensUpdateBegin} 188 ); 189 # Create parser for update end tokens 190 my $tokenUpdateEndParser = HTML::_TokenUpdateParser->new( 191 $self->{_tokensUpdateEnd} 192 ); 193 194 # Loop through ToCs 195 foreach $toc (@{$self->{_tocs}}) { 196 # Parse update tokens 197 $tokenUpdateBeginParser->parse( 198 $toc->{_tokenUpdateBeginOfAnchorNameBegin} 199 ); 200 $tokenUpdateBeginParser->parse($toc->{_tokenUpdateBeginOfAnchorNameEnd}); 201 $tokenUpdateBeginParser->parse($toc->{_tokenUpdateBeginNumber}); 202 $tokenUpdateBeginParser->parse($toc->{_tokenUpdateBeginToc}); 203 204 $tokenUpdateEndParser->parse($toc->{_tokenUpdateEndOfAnchorNameBegin}); 205 $tokenUpdateEndParser->parse($toc->{_tokenUpdateEndOfAnchorNameEnd}); 206 $tokenUpdateEndParser->parse($toc->{_tokenUpdateEndNumber}); 207 $tokenUpdateEndParser->parse($toc->{_tokenUpdateEndToc}); 208 } 209} # _parseTocUpdateTokens() 210 211 212#--- HTML::TocUpdator::_resetBatchVariables() --------------------------------- 213# function: Reset batch variables 214 215sub _resetBatchVariables { 216 # Get arguments 217 my ($self) = @_; 218 # Call ancestor 219 $self->SUPER::_resetBatchVariables(); 220 # Arrays containing start, end, comment & text tokens which indicate 221 # the begin of ToC tokens. The tokens are stored in keys of hashes to 222 # avoid storing duplicates as an array would. 223 $self->{_tokensUpdateBegin} = [ 224 [], # ['<start tag>', <attributes>] 225 {}, # {'<end tag>' => ''} 226 {}, # {'<text>' => ''} 227 {} # {'<comment>' => ''} 228 ]; 229 # Arrays containing start, end, comment & text tokens which indicate 230 # the end of ToC tokens. The tokens are stored in keys of hashes to 231 # avoid storing duplicates as an array would. 232 $self->{_tokensUpdateEnd} = [ 233 [], # ['<start tag>', <attributes>] 234 {}, # {'<end tag>' => ''} 235 {}, # {'<text>' => ''} 236 {} # {'<comment>' => ''} 237 ]; 238} # _resetBatchVariables() 239 240 241#--- HTML::TocUpdator::_setActiveAnchorName() --------------------------------- 242# function: Set active anchor name. 243# args: - aAnchorName: Name of anchor name to set active. 244 245sub _setActiveAnchorName { 246 # Get arguments 247 my ($self, $aAnchorName) = @_; 248 # Are tokens being deleted? 249 if (! $self->{_doDeleteTokens}) { 250 # No, tokens aren't being deleted; 251 # Call ancestor to set anchor name 252 $self->SUPER::_setActiveAnchorName($aAnchorName); 253 } 254} # _setActiveAnchorName() 255 256 257#--- HTML::TocUpdator::_update() ---------------------------------------------- 258# function: Update ToC in string. 259# args: - $aMode: Mode. Can be either MODE_DO_UPDATE or MODE_DO_INSERT. 260# - $aToc: (reference to array of) ToC object to update 261# - $aString: string to update ToC of 262# - $aOptions: optional updator options 263# note: Used internally. 264 265sub _update { 266 # Get arguments 267 my ($self, $aMode, $aToc, $aString, $aOptions) = @_; 268 # Initialize TocUpdator batch 269 $self->_initializeUpdatorBatch($aMode, $aToc, $aOptions); 270 # Start updating ToC by starting ToC insertion 271 $self->_insert($aString); 272 # Deinitialize TocUpdator batch 273 $self->_deinitializeUpdatorBatch(); 274} # update() 275 276 277#--- HTML::TocUpdator::_updateFile() ------------------------------------------ 278# function: Update ToCs in file. 279# args: - $aMode: Mode. Can be either MODE_DO_UPDATE or MODE_DO_INSERT. 280# - $aToc: (reference to array of) ToC object to update 281# - $aFile: (reference to array of) file to parse for updating. 282# - $aOptions: optional updator options 283# note: Used internally. 284 285sub _updateFile { 286 # Get arguments 287 my ($self, $aMode, $aToc, $aFile, $aOptions) = @_; 288 # Initialize TocUpdator batch 289 $self->_initializeUpdatorBatch($aMode, $aToc, $aOptions); 290 # Start updating ToC by starting ToC insertion 291 $self->_insertIntoFile($aFile); 292 # Deinitialize TocUpdator batch 293 $self->_deinitializeUpdatorBatch(); 294} # _updateFile() 295 296 297#--- HTML::TocUpdator::_writeOrBufferOutput() --------------------------------- 298# function: Write processed HTML to output device(s). 299# args: - aOutput: scalar to write 300 301sub _writeOrBufferOutput { 302 # Get arguments 303 my ($self, $aOutput) = @_; 304 # Delete output? 305 if (! $self->{_doDeleteTokens}) { 306 # No, don't delete output; 307 # Call ancestor 308 $self->SUPER::_writeOrBufferOutput($aOutput); 309 } 310} # _writeOrBufferOutput() 311 312 313#--- HTML::TocUpdator::anchorNameBegin() -------------------------------------- 314# function: Process 'anchor name begin' generated by HTML::Toc. 315# args: - $aAnchorName: Anchor name begin tag to output. 316# - $aToc: Reference to ToC to which anchorname belongs. 317 318sub anchorNameBegin { 319 # Get arguments 320 my ($self, $aAnchorNameBegin, $aToc) = @_; 321 # Call ancestor 322 $self->SUPER::anchorNameBegin($aAnchorNameBegin); 323 # Must ToC be inserted or updated? 324 if ($self->{htu__Mode} != MODE_DO_NOTHING) { 325 # Yes, ToC must be inserted or updated; 326 # Surround anchor name with update tags 327 $self->{_outputPrefix} = 328 $aToc->{_tokenUpdateBeginOfAnchorNameBegin} . 329 $self->{_outputPrefix} . 330 $aToc->{_tokenUpdateEndOfAnchorNameBegin}; 331 } 332} # anchorNameBegin() 333 334 335#--- HTML::TocUpdator::anchorNameEnd() ---------------------------------------- 336# function: Process 'anchor name end' generated by HTML::Toc. 337# args: - $aAnchorNameEnd: Anchor name end tag to output. 338# - $aToc: Reference to ToC to which anchorname belongs. 339 340sub anchorNameEnd { 341 # Get arguments 342 my ($self, $aAnchorNameEnd, $aToc) = @_; 343 # Call ancestor 344 $self->SUPER::anchorNameEnd($aAnchorNameEnd); 345 # Must ToC be inserted or updated? 346 if ($self->{htu__Mode} != MODE_DO_NOTHING) { 347 # Yes, ToC must be inserted or updated; 348 # Surround anchor name with update tags 349 $self->{_outputSuffix} = 350 $aToc->{_tokenUpdateBeginOfAnchorNameEnd} . 351 $self->{_outputSuffix} . 352 $aToc->{_tokenUpdateEndOfAnchorNameEnd}; 353 } 354} # anchorNameEnd() 355 356 357#--- HTML::TocUpdator::comment() ---------------------------------------------- 358# function: Process comment. 359# args: - $aComment: comment text with '<!--' and '-->' tags stripped off. 360 361sub comment { 362 # Get arguments 363 my ($self, $aComment) = @_; 364 # Must ToC be updated? 365 if ($self->{htu__Mode} == MODE_DO_UPDATE) { 366 # Yes, ToC must be updated; 367 # Updator is currently deleting tokens? 368 if ($self->{_doDeleteTokens}) { 369 # Yes, tokens must be deleted; 370 # Call ancestor 371 $self->SUPER::comment($aComment); 372 373 # Look for update end token 374 375 # Does comment matches update end token? 376 if (defined( 377 $self->{_tokensUpdateEnd}[TUT_TOKENTYPE_COMMENT]{$aComment} 378 )) { 379 # Yes, comment matches update end token; 380 # Indicate to stop deleting tokens 381 $self->{_doDeleteTokens} = 0; 382 } 383 } 384 else { 385 # No, tokens mustn't be deleted; 386 387 # Look for update begin token 388 389 # Does comment matches update begin token? 390 if (defined( 391 $self->{_tokensUpdateBegin}[TUT_TOKENTYPE_COMMENT]{$aComment} 392 )) { 393 # Yes, comment matches update begin token; 394 # Indicate to start deleting tokens 395 $self->{_doDeleteTokens} = 1; 396 } 397 # Call ancestor 398 $self->SUPER::comment($aComment); 399 } 400 } 401 else { 402 # No, ToC mustn't be updated; 403 # Call ancestor 404 $self->SUPER::comment($aComment); 405 } 406} # comment() 407 408 409#--- HTML::TocUpdator::end() -------------------------------------------------- 410# function: This function is called every time a closing tag is encountered. 411# args: - $aTag: tag name (in lower case). 412# - $aOrigText: tag name including brackets. 413 414sub end { 415 # Get arguments 416 my ($self, $aTag, $aOrigText) = @_; 417 # Call ancestor 418 $self->SUPER::end($aTag, $aOrigText); 419 # Must ToC be updated? 420 if ($self->{htu__Mode} == MODE_DO_UPDATE) { 421 # Yes, ToC must be updated; 422 # Updator is currently deleting tokens? 423 if ($self->{_doDeleteTokens}) { 424 # Yes, tokens must be deleted; 425 # Does end tag matches update end token? 426 if (defined( 427 $self->{_tokensUpdateEnd}[TUT_TOKENTYPE_END]{$aTag} 428 )) { 429 # Yes, end tag matches update end token; 430 # Indicate to stop deleting tokens 431 $self->{_doDeleteTokens} = 0; 432 } 433 } 434 } 435} # end() 436 437 438#--- HTML::TocUpdator::insert() ----------------------------------------------- 439# function: Insert ToC in string. 440# args: - $aToc: (reference to array of) ToC object to update 441# - $aString: string to insert ToC in. 442# - $aOptions: optional updator options 443 444sub insert { 445 # Get arguments 446 my ($self, $aToc, $aString, $aOptions) = @_; 447 # Do start insert 448 $self->_update(MODE_DO_INSERT, $aToc, $aString, $aOptions); 449} # insert() 450 451 452#--- HTML::TocUpdator::insertIntoFile() -------------------------------------- 453# function: Insert ToC in file. 454# args: - $aToc: (reference to array of) ToC object to update 455# - $aFile: File to insert ToC in. 456# - $aOptions: optional updator options 457 458sub insertIntoFile { 459 # Get arguments 460 my ($self, $aToc, $aFile, $aOptions) = @_; 461 # Do start insert 462 $self->_updateFile(MODE_DO_INSERT, $aToc, $aFile, $aOptions); 463} # insertIntoFile() 464 465 466#--- HTML::TocUpdator::number() ----------------------------------------------- 467# function: Process heading number generated by HTML::Toc. 468# args: - $aNumber 469# - $aToc: Reference to ToC to which anchorname belongs. 470 471sub number { 472 # Get arguments 473 my ($self, $aNumber, $aToc) = @_; 474 # Call ancestor 475 $self->SUPER::number($aNumber); 476 # Must ToC be inserted or updated? 477 if ($self->{htu__Mode} != MODE_DO_NOTHING) { 478 # Yes, ToC must be inserted or updated; 479 # Surround number with update tags 480 $self->{_outputSuffix} = 481 $aToc->{_tokenUpdateBeginNumber} . 482 $self->{_outputSuffix} . 483 $aToc->{_tokenUpdateEndNumber}; 484 } 485} # number() 486 487 488#--- HTML::TocUpdator::start() ------------------------------------------------ 489# function: This function is called every time an opening tag is encountered. 490# args: - $aTag: tag name (in lower case). 491# - $aAttr: reference to hash containing all tag attributes (in lower 492# case). 493# - $aAttrSeq: reference to array containing all tag attributes (in 494# lower case) in the original order 495# - $aOrigText: the original HTML text 496 497sub start { 498 # Get arguments 499 my ($self, $aTag, $aAttr, $aAttrSeq, $aOrigText) = @_; 500 # Must ToC be updated? 501 if ($self->{htu__Mode} == MODE_DO_UPDATE) { 502 # Yes, ToC must be updated; 503 # Does start tag matches token update begin tag? 504 if (HTML::TocUpdator::_doesTagExistInArray( 505 $aTag, $aAttr, $self->{_tokensUpdateBegin}[TUT_TOKENTYPE_START] 506 )) { 507 # Yes, start tag matches token update tag; 508 # Indicate to delete tokens 509 $self->{_doDeleteTokens} = 1; 510 } 511 } 512 # Let ancestor process the start tag 513 $self->SUPER::start($aTag, $aAttr, $aAttrSeq, $aOrigText); 514} # start() 515 516 517#--- HTML::TocUpdator::toc() -------------------------------------------------- 518# function: Toc processing method. Add toc reference to scenario. 519# args: - $aScenario: Scenario to add ToC reference to. 520# - $aToc: Reference to ToC to insert. 521# note: The ToC hasn't been build yet; only a reference to the ToC to be 522# build is inserted. 523 524sub toc { 525 # Get arguments 526 my ($self, $aScenario, $aToc) = @_; 527 528 # Surround toc with update tokens 529 530 # Add update begin token 531 push(@$aScenario, \$aToc->{_tokenUpdateBeginToc}); 532 # Call ancestor 533 $self->SUPER::toc($aScenario, $aToc); 534 # Add update end token 535 push(@$aScenario, \$aToc->{_tokenUpdateEndToc}); 536} # toc() 537 538 539#--- HTML::TocUpdator::_processTocText() -------------------------------------- 540# function: Toc text processing function. 541# args: - $aText: Text to add to ToC. 542# - $aToc: ToC to add text to. 543 544sub _processTocText { 545 # Get arguments 546 my ($self, $aText, $aToc) = @_; 547 # Delete output? 548 if (! $self->{_doDeleteTokens}) { 549 # No, don't delete output; 550 # Call ancestor 551 $self->SUPER::_processTocText($aText, $aToc); 552 } 553} # _processTocText() 554 555 556#--- HTML::TocUpdator::update() ----------------------------------------------- 557# function: Update ToC in string. 558# args: - $aToc: (reference to array of) ToC object to update 559# - $aString: string to update ToC of 560# - $aOptions: optional updator options 561 562sub update { 563 # Get arguments 564 my ($self, $aToc, $aString, $aOptions) = @_; 565 # Do start update 566 $self->_update(MODE_DO_UPDATE, $aToc, $aString, $aOptions); 567} # update() 568 569 570#--- HTML::TocUpdator::updateFile() ------------------------------------------- 571# function: Update ToC of file. 572# args: - $aToc: (reference to array of) ToC object to update 573# - $aFile: (reference to array of) file to parse for updating. 574# - $aOptions: optional updator options 575 576sub updateFile { 577 # Get arguments 578 my ($self, $aToc, $aFile, $aOptions) = @_; 579 # Do start update 580 $self->_updateFile(MODE_DO_UPDATE, $aToc, $aFile, $aOptions); 581} # update() 582 583 584 585 586#=== HTML::_TokenUpdateParser ================================================= 587# function: Parse 'update tokens'. 'Update tokens' mark HTML code which is 588# inserted by 'HTML::TocInsertor'. 589# note: Used internally. 590 591package HTML::_TokenUpdateParser; 592 593 594BEGIN { 595 use vars qw(@ISA); 596 597 @ISA = qw(HTML::Parser); 598} 599 600END {} 601 602 603#--- HTML::_TokenUpdateParser::new() ------------------------------------------ 604# function: Constructor 605 606sub new { 607 # Get arguments 608 my ($aType, $aTokenArray) = @_; 609 # Create instance 610 my $self = $aType->SUPER::new; 611 # Reference token array 612 $self->{tokens} = $aTokenArray; 613 # Return instance 614 return $self; 615} # new() 616 617 618#--- HTML::_TokenUpdateParser::comment() -------------------------------------- 619# function: Process comment. 620# args: - $aComment: comment text with '<!--' and '-->' tags stripped off. 621 622sub comment { 623 # Get arguments 624 my ($self, $aComment) = @_; 625 # Add token to array of update tokens 626 $self->{tokens}[HTML::TocUpdator::TUT_TOKENTYPE_COMMENT]{$aComment} = ''; 627} # comment() 628 629 630#--- HTML::_TokenUpdateParser::end() ------------------------------------------ 631# function: This function is called every time a closing tag is encountered 632# by HTML::Parser. 633# args: - $aTag: tag name (in lower case). 634 635sub end { 636 # Get arguments 637 my ($self, $aTag, $aOrigText) = @_; 638 # Add token to array of update tokens 639 $self->{tokens}[HTML::TocUpdator::TUT_TOKENTYPE_END]{$aTag} = ''; 640} # end() 641 642 643#--- HTML::_TokenUpdateParser::parse() ---------------------------------------- 644# function: Parse token. 645# args: - $aToken: 'update token' to parse 646 647sub parse { 648 # Get arguments 649 my ($self, $aString) = @_; 650 # Call ancestor 651 $self->SUPER::parse($aString); 652} # parse() 653 654 655#--- HTML::_TokenUpdateParser::start() ---------------------------------------- 656# function: This function is called every time an opening tag is encountered. 657# args: - $aTag: tag name (in lower case). 658# - $aAttr: reference to hash containing all tag attributes (in lower 659# case). 660# - $aAttrSeq: reference to array containing all tag attributes (in 661# lower case) in the original order 662# - $aOrigText: the original HTML text 663 664sub start { 665 # Get arguments 666 my ($self, $aTag, $aAttr, $aAttrSeq, $aOrigText) = @_; 667 # Does token exist in array? 668 if (! HTML::TocUpdator::_doesTagExistInArray( 669 $aTag, $aAttr, $self->{tokens}[HTML::TocUpdator::TUT_TOKENTYPE_START] 670 )) { 671 # No, token doesn't exist in array; 672 # Add token to array of update tokens 673 push( 674 @{$self->{tokens}[HTML::TocUpdator::TUT_TOKENTYPE_START]}, 675 [$aTag, $aAttr] 676 ); 677 } 678} # start() 679 680 681#--- HTML::_TokenUpdateParser::text() ----------------------------------------- 682# function: This function is called every time plain text is encountered. 683# args: - @_: array containing data. 684 685sub text { 686 # Get arguments 687 my ($self, $aText) = @_; 688 # Add token to array of update tokens 689 $self->{tokens}[HTML::TocUpdator::TUT_TOKENTYPE_TEXT]{$aText} = ''; 690} # text() 691 692 6931; 694