HTML-Toc-1.12/ 0000755 0001750 0001750 00000000000 11234545460 012244 5 ustar freddy freddy HTML-Toc-1.12/t/ 0000755 0001750 0001750 00000000000 11234545460 012507 5 ustar freddy freddy HTML-Toc-1.12/t/SiteMap/ 0000755 0001750 0001750 00000000000 11234545460 014051 5 ustar freddy freddy HTML-Toc-1.12/t/SiteMap/SubDir2/ 0000755 0001750 0001750 00000000000 11234545460 015323 5 ustar freddy freddy HTML-Toc-1.12/t/SiteMap/SubDir2/SubSubDir2/ 0000755 0001750 0001750 00000000000 11234545460 017247 5 ustar freddy freddy HTML-Toc-1.12/t/SiteMap/SubDir2/SubSubDir2/index.htm 0000755 0001750 0001750 00000000065 11111100703 021051 0 ustar freddy freddy
$aNode $aText";
last SWITCH;
}
}
# Return value
return $result;
} # AssembleTocLine()
#--- AssembleTokenNumber() ----------------------------------------------------
# function: Assemble token number.
sub AssembleTokenNumber {
# Get arguments
my ($aNode, $aGroupId, $aFile, $aGroupLevel, $aLevel, $aToc) = @_;
# Local variables
my ($result);
# Assemble token number
SWITCH: {
if ($aGroupId eq "part") {
$result = "Part $aNode ";
last SWITCH;
}
else {
$result = "$aNode ";
last SWITCH;
}
}
# Return value
return $result;
} # AssembleTokenNumber()
#--- TestInsertManualToc ------------------------------------------------------
# function: Test inserting ToC into manual.
sub TestInsertManualToc {
my $output;
# Create objects
my $toc = new HTML::Toc;
my $tocOfFigures = new HTML::Toc;
my $tocOfTables = new HTML::Toc;
my $tocInsertor = new HTML::TocInsertor;
# Set ToC options
$toc->setOptions({
'doNestGroup' => 1,
'doNumberToken' => 1,
'insertionPoint' => "replace ",
'templateLevel' => \&AssembleTocLine,
'templateLevelBegin' => '"\n"',
'templateLevelEnd' => '"
\n"',
'templateTokenNumber' => \&AssembleTokenNumber,
'tokenToToc' => [{
'groupId' => 'part',
'doNumberToken' => 1,
'level' => 1,
'tokenBegin' => '',
}, {
'tokenBegin' => ''
}, {
'tokenBegin' => '',
'level' => 2
}, {
'tokenBegin' => '',
'level' => 3
}, {
'groupId' => 'appendix',
'tokenBegin' => '',
'numberingStyle' => 'upper-alpha',
}, {
'groupId' => 'appendix',
'tokenBegin' => '',
'level' => 2
}, {
'groupId' => 'prelude',
'tokenBegin' => '',
'level' => 1,
'doNumberToken' => 0,
}],
});
$tocOfFigures->setOptions({
'doNumberToken' => 1,
'insertionPoint' => "replace ",
'templateLevelBegin' => '"\n"',
'templateLevelEnd' => '"
\n"',
'templateTokenNumber' => '"Figure $node: "',
'tokenToToc' => [{
'groupId' => 'Figure',
'tokenBegin' => '
'
}]
});
$tocOfTables->setOptions({
'doNumberToken' => 1,
'insertionPoint' => "replace ",
'templateLevelBegin' => '"
\n"',
'templateLevelEnd' => '"
\n"',
'templateTokenNumber' => '"Table $node: "',
'tokenToToc' => [{
'groupId' => 'Table',
'tokenBegin' => ''
}]
});
# Insert ToC
$tocInsertor->insertIntoFile(
[$toc, $tocOfFigures, $tocOfTables],
't/ManualTest/manualTest1.htm', {
'doUseGroupsGlobal' => 1,
'output' => \$output,
'outputFile' => 't/ManualTest/manualTest2.htm'
}
);
eq_or_diff($output, < 120});
Manual
Preface
Better C than never.
Table of Contents
Table of Figures
- Contents Compiler Disk v1
- Contents Compiler Disk v2
Table of Tables
- Compile Steps
Introduction
Thanks to standardisation and the excellent work of the QWERTY corporation it is possible to learn C with almost any C manual.
Table 1: Compile Steps
Parser
Compiler
Linker
Part 1 Disks
1 Compiler Disk v1

Figure 1: Contents Compiler Disk v1
1.1 System
1.2 Standard Library
2 Compiler Disk v2

Figure 2: Contents Compiler Disk v2
2.1 System
2.1.1 parser.com
2.1.2 compiler.com
2.1.3 linker.com
2.2 Standard Library
3 Library System Disk
Part 2 Personal
4 Tips & Tricks
Part 3 Appendixes
A Functions Standard Library v1
B Functions Standard Library v2
C Functions Graphic Library
Bibliography
HTML
} # TestInsertManualToc()
#--- TestInsertManualForUpdating() --------------------------------------------
# function: Test inserting ToC into manual.
sub TestInsertManualForUpdating {
my $output;
# Create objects
my $toc = new HTML::Toc;
my $tocOfFigures = new HTML::Toc;
my $tocOfTables = new HTML::Toc;
my $tocUpdator = new HTML::TocUpdator;
# Set ToC options
$toc->setOptions({
'doNestGroup' => 1,
'doNumberToken' => 1,
'insertionPoint' => "after ",
'templateLevel' => \&AssembleTocLine,
'templateLevelBegin' => '"\n"',
'templateLevelEnd' => '"
\n"',
'templateTokenNumber' => \&AssembleTokenNumber,
'tokenToToc' => [{
'groupId' => 'part',
'doNumberToken' => 1,
'level' => 1,
'tokenBegin' => '',
}, {
'tokenBegin' => ''
}, {
'tokenBegin' => '',
'level' => 2
}, {
'tokenBegin' => '',
'level' => 3
}, {
'groupId' => 'appendix',
'tokenBegin' => '',
'numberingStyle' => 'upper-alpha',
}, {
'groupId' => 'appendix',
'tokenBegin' => '',
'level' => 2
}, {
'groupId' => 'prelude',
'tokenBegin' => '',
'level' => 1,
'doNumberToken' => 0,
}],
});
$tocOfFigures->setOptions({
'doNumberToken' => 1,
'insertionPoint' => "after ",
'templateLevelBegin' => '"\n"',
'templateLevelEnd' => '"
\n"',
'templateTokenNumber' => '"Figure $node: "',
'tokenToToc' => [{
'groupId' => 'Figure',
'tokenBegin' => '
'
}]
});
$tocOfTables->setOptions({
'doNumberToken' => 1,
'insertionPoint' => "after ",
'templateLevelBegin' => '"
\n"',
'templateLevelEnd' => '"
\n"',
'templateTokenNumber' => '"Table $node: "',
'tokenToToc' => [{
'groupId' => 'Table',
'tokenBegin' => ''
}]
});
# Insert ToC
$tocUpdator->updateFile(
[$toc, $tocOfFigures, $tocOfTables],
't/ManualTest/manualTest1.htm', {
'doUseGroupsGlobal' => 1,
'output' => \$output,
'outputFile' => 't/ManualTest/manualTest3.htm'
}
);
eq_or_diff($output, < 120});
Manual
Preface
Better C than never.
Table of Contents
Table of Figures
- Contents Compiler Disk v1
- Contents Compiler Disk v2
Table of Tables
- Compile Steps
Introduction
Thanks to standardisation and the excellent work of the QWERTY corporation it is possible to learn C with almost any C manual.
Table 1: Compile Steps
Parser
Compiler
Linker
Part 1 Disks
1 Compiler Disk v1

Figure 1: Contents Compiler Disk v1
1.1 System
1.2 Standard Library
2 Compiler Disk v2

Figure 2: Contents Compiler Disk v2
2.1 System
2.1.1 parser.com
2.1.2 compiler.com
2.1.3 linker.com
2.2 Standard Library
3 Library System Disk
Part 2 Personal
4 Tips & Tricks
Part 3 Appendixes
A Functions Standard Library v1
B Functions Standard Library v2
C Functions Graphic Library
Bibliography
HTML
} # TestInsertManualForUpdating()
#--- TestUpdateManual() -------------------------------------------------------
# function: Test inserting ToC into manual.
sub TestUpdateManual {
my $output;
# Create objects
my $toc = new HTML::Toc;
my $tocOfFigures = new HTML::Toc;
my $tocOfTables = new HTML::Toc;
my $tocUpdator = new HTML::TocUpdator;
# Set ToC options
$toc->setOptions({
'doNestGroup' => 1,
'doNumberToken' => 1,
'insertionPoint' => "after ",
'templateLevel' => \&AssembleTocLine,
'templateLevelBegin' => '"\n"',
'templateLevelEnd' => '"
\n"',
'templateTokenNumber' => \&AssembleTokenNumber,
'tokenToToc' => [{
'groupId' => 'part',
'doNumberToken' => 1,
'level' => 1,
'tokenBegin' => '',
}, {
'tokenBegin' => ''
}, {
'tokenBegin' => '',
'level' => 2
}, {
'tokenBegin' => '',
'level' => 3
}, {
'groupId' => 'appendix',
'tokenBegin' => '',
'numberingStyle' => 'upper-alpha',
}, {
'groupId' => 'appendix',
'tokenBegin' => '',
'level' => 2
}, {
'groupId' => 'prelude',
'tokenBegin' => '',
'level' => 1,
'doNumberToken' => 0,
}],
});
$tocOfFigures->setOptions({
'doNumberToken' => 1,
'insertionPoint' => "after ",
'templateLevelBegin' => '"\n"',
'templateLevelEnd' => '"
\n"',
'templateTokenNumber' => '"Figure $node: "',
'tokenToToc' => [{
'groupId' => 'Figure',
'tokenBegin' => '
'
}]
});
$tocOfTables->setOptions({
'doNumberToken' => 1,
'insertionPoint' => "after ",
'templateLevelBegin' => '"
\n"',
'templateLevelEnd' => '"
\n"',
'templateTokenNumber' => '"Table $node: "',
'tokenToToc' => [{
'groupId' => 'Table',
'tokenBegin' => ''
}]
});
# Insert ToC
$tocUpdator->updateFile(
[$toc, $tocOfFigures, $tocOfTables],
't/ManualTest/manualTest3.htm', {
'doUseGroupsGlobal' => 1,
'output' => \$output,
'outputFile' => 't/ManualTest/manualTest4.htm'
}
);
eq_or_diff($output, < 120});
Manual
Preface
Better C than never.
Table of Contents
Table of Figures
- Contents Compiler Disk v1
- Contents Compiler Disk v2
Table of Tables
- Compile Steps
Introduction
Thanks to standardisation and the excellent work of the QWERTY corporation it is possible to learn C with almost any C manual.
Table 1: Compile Steps
Parser
Compiler
Linker
Part 1 Disks
1 Compiler Disk v1

Figure 1: Contents Compiler Disk v1
1.1 System
1.2 Standard Library
2 Compiler Disk v2

Figure 2: Contents Compiler Disk v2
2.1 System
2.1.1 parser.com
2.1.2 compiler.com
2.1.3 linker.com
2.2 Standard Library
3 Library System Disk
Part 2 Personal
4 Tips & Tricks
Part 3 Appendixes
A Functions Standard Library v1
B Functions Standard Library v2
C Functions Graphic Library
Bibliography
HTML
} # TestUpdateManual()
# Test inserting ToC into manual
TestInsertManualToc();
# Test inserting ToC with update tokens into manual
TestInsertManualForUpdating();
# Test updating ToC
TestUpdateManual();
HTML-Toc-1.12/t/options.t 0000755 0001750 0001750 00000011736 11170451327 014377 0 ustar freddy freddy #--- options.t ----------------------------------------------------------------
# function: Test HTML::ToC. In particular test the available options.
use strict;
use Test::More tests => 5;
use Test::Differences;
use HTML::Toc;
use HTML::TocGenerator;
use HTML::TocInsertor;
use HTML::TocUpdator;
my ($filename);
BEGIN {
# Create test file
$filename = "file$$.htm";
die "$filename is already there" if -e $filename;
}
END {
# Remove test file
unlink($filename) or warn "Can't unlink $filename: $!";
}
#--- TestAttributeToExcludeToken() --------------------------------------------
# function: Test 'HTML::Toc' option 'attributeToExcludeToken'
sub TestAttributeToExcludeToken {
# Assemble test file
open(FILE, ">$filename") || die "Can't create $filename: $!";
print FILE <<'EOT'; close(FILE);
Chapter 1
Appendix
EOT
# Create objects
my $toc = HTML::Toc->new();
my $tocGenerator = HTML::TocGenerator->new();
$toc->setOptions({
'attributeToExcludeToken' => 'foo',
'tokenToToc' => [{
'tokenBegin' => ''
}]
});
# Generate ToC
$tocGenerator->generateFromFile($toc, $filename);
# Test ToC
eq_or_diff($toc->format(), < 120});
EOT
} # TestAttributeToExcludeToken()
#--- TestAttributeToTocToken() ------------------------------------------------
# function: Test 'HTML::Toc' option 'attributeToTocToken'
sub TestAttributeToTocToken {
# Assemble test file
open(FILE, ">$filename") || die "Can't create $filename: $!";
print FILE <<'EOT'; close(FILE);
EOT
# Create objects
my $toc = HTML::Toc->new();
my $tocGenerator = HTML::TocGenerator->new();
$toc->setOptions({
'attributeToTocToken' => 'foo',
'tokenToToc' => [{
'groupId' => 'image',
'tokenBegin' => '
'
}],
});
# Generate ToC
$tocGenerator->generateFromFile($toc, $filename);
# Test ToC
eq_or_diff($toc->format(), < 120});
EOT
} # TestAttributeToTocToken()
#--- TestNumberingStyleDecimal ------------------------------------------------
# function: Test 'decimal' numbering style.
sub TestNumberingStyleDecimal {
# Local variables
my $output;
# Create objects
my $toc = HTML::Toc->new();
my $tocInsertor = HTML::TocInsertor->new();
$toc->setOptions({
'doNumberToken' => 1,
'tokenToToc' => [{
'level' => 1,
'tokenBegin' => '',
'numberingStyle' => 'decimal'
}],
});
# Generate ToC
$tocInsertor->insert($toc, "Header
", {'output' => \$output});
# Test ToC
eq_or_diff("$output\n", <1 Header
EOT
} # TestNumberingStyleDecimal()
#--- TestNumberingStyleLowerAlpha ---------------------------------------------
# function: Test 'lower-alpha' numbering style.
sub TestNumberingStyleLowerAlpha {
# Local variables
my $output;
# Create objects
my $toc = HTML::Toc->new();
my $tocInsertor = HTML::TocInsertor->new();
$toc->setOptions({
'doNumberToken' => 1,
'tokenToToc' => [{
'level' => 1,
'tokenBegin' => '',
'numberingStyle' => 'lower-alpha'
}],
});
# Generate ToC
$tocInsertor->insert($toc, "Header
", {'output' => \$output});
# Test ToC
eq_or_diff("$output\n", <a Header
EOT
} # TestNumberingStyleLowerAlpha()
#--- TestNumberingStyleUpperAlpha ---------------------------------------------
# function: Test 'upper-alpha' numbering style.
sub TestNumberingStyleUpperAlpha {
# Local variables
my $output;
# Create objects
my $toc = HTML::Toc->new();
my $tocInsertor = HTML::TocInsertor->new();
$toc->setOptions({
'doNumberToken' => 1,
'tokenToToc' => [{
'level' => 1,
'tokenBegin' => '',
'numberingStyle' => 'upper-alpha'
}],
});
# Generate ToC
$tocInsertor->insert($toc, "Header
", {'output' => \$output});
# Test ToC
eq_or_diff("$output\n", <A Header
EOT
} # TestNumberingStyleUpperAlpha()
# 1. Test 'attributeToTocToken'
TestAttributeToTocToken();
# 2. Test 'attributeToExcludeToken'
TestAttributeToExcludeToken();
# 3. Test 'numberingStyleDecimal'
TestNumberingStyleDecimal();
# 4. Test 'numberingStyleLowerAlpha'
TestNumberingStyleLowerAlpha();
# 5. Test 'numberingStyleUpperAlpha'
TestNumberingStyleUpperAlpha();
HTML-Toc-1.12/t/generate.t 0000755 0001750 0001750 00000013546 11170451327 014477 0 ustar freddy freddy #--- generate.t ---------------------------------------------------------------
# function: Test ToC generation.
use strict;
use Test::More tests => 14;
use Test::Differences;
use HTML::Toc;
use HTML::TocGenerator;
my ($filename);
my $toc = HTML::Toc->new;
my $tocGenerator = HTML::TocGenerator->new;
$toc->setOptions({
'doLinkToToken' => 0,
'levelIndent' => 0,
'header' => '',
'footer' => '',
});
BEGIN {
# Create test file
$filename = "file$$.htm";
die "$filename is already there" if -e $filename;
open(FILE, ">$filename") || die "Can't create $filename: $!";
print FILE <<'EOT';
Header
EOT
close(FILE);
}
END {
# Remove test file
unlink($filename) or warn "Can't unlink $filename: $!";
}
#--- 1. generate --------------------------------------------------------------
$tocGenerator->generate($toc, "Header
");
eq_or_diff($toc->format(), "", 'generate');
#--- 2. generateFromFile ------------------------------------------------------
$tocGenerator->generateFromFile($toc, $filename);
eq_or_diff($toc->format(), "", 'generateFromFile');
#--- 3. generateFromFiles -----------------------------------------------------
$tocGenerator->generateFromFile($toc, [$filename, $filename]);
eq_or_diff($toc->format(), "", 'generateFromFiles');
#--- 4. doLinkToToken -----------------------------------------------------
$toc->setOptions({'doLinkToToken' => 1});
$tocGenerator->generateFromFile($toc, $filename, {'globalGroups' => 1});
eq_or_diff($toc->format(), "", 'doLinkToToken');
#--- 5. doLinkToFile -------------------------------------------------------
$toc->setOptions({'doLinkToFile' => 1});
$tocGenerator->generateFromFile($toc, $filename);
eq_or_diff($toc->format(), "", 'doLinkToFile');
#--- 6. templateAnchorHrefBegin -----------------------------------------------
# Set options
$toc->setOptions({'templateAnchorHrefBegin' => '"test-$file"'});
# Generate ToC
$tocGenerator->generateFromFile($toc, $filename);
# Test ToC
eq_or_diff($toc->format(), "\n- test-".$filename."Header
\n
", 'templateAnchorHrefBegin');
# Reset options
$toc->setOptions({'templateAnchorHrefBegin' => undef});
#--- 7. templateAnchorHrefBegin function --------------------------------------
sub AssembleAnchorHrefBegin {
# Get arguments
my ($aFile, $aGroupId, $aLevel, $aNode) = @_;
# Return value
return $aFile . $aGroupId . $aLevel . $aNode;
} # AssembleAnchorHrefBegin()
# Set options
$toc->setOptions({'templateAnchorHrefBegin' => \&AssembleAnchorHrefBegin});
# Generate ToC
$tocGenerator->generateFromFile($toc, $filename);
# Test ToC
eq_or_diff($toc->format(), "\n- ".$filename."h11Header
\n
", 'templateAnchorHrefBegin');
# Reset options
$toc->setOptions({'templateAnchorHrefBegin' => undef});
#--- 8. levelToToc no levels available ---------------------------------------
$toc->setOptions({'levelToToc' => '2'});
$tocGenerator->generate($toc, "Header
");
eq_or_diff($toc->format(), "", 'levelToToc');
#--- 9. levelToToc level 1 ---------------------------------------------------
# Set options
$toc->setOptions({
'levelToToc' => '1',
'doLinkToToken' => 0,
});
$tocGenerator->generate($toc, "Header1
\nHeader2
");
eq_or_diff($toc->format(), "", 'levelToToc level 1');
#--- 10. levelToToc level 2 --------------------------------------------------
# Set options
$toc->setOptions({
'levelToToc' => '2',
'doLinkToToken' => 0,
});
$tocGenerator->generate($toc, "Header1
\nHeader2
");
eq_or_diff($toc->format(), "", 'levelToToc level 2');
# Restore options
$toc->setOptions({
'levelToToc' => '.*',
});
#--- 11. tokenToToc empty array ----------------------------------------------
# Set options
$toc->setOptions({'tokenToToc' => []});
$tocGenerator->generate($toc, "Header
");
eq_or_diff($toc->format(), "", 'tokenToToc');
#--- 12. groups nested --------------------------------------------------------
$toc->setOptions({
'doNestGroup' => 1,
'tokenToToc' => [
{
'level' => 1,
'tokenBegin' => ''
}, {
'groupId' => 'appendix',
'level' => 1,
'tokenBegin' => ''
}
]
});
$tocGenerator->generate(
$toc, "Header1
\nAppendix
"
);
eq_or_diff($toc->format() . "\n", <
Header1
HTML
#--- 13. groups not nested ----------------------------------------------------
$toc->setOptions({
'doNestGroup' => 0,
'tokenToToc' => [
{
'level' => 1,
'tokenBegin' => ''
}, {
'groupId' => 'appendix',
'level' => 1,
'tokenBegin' => ''
}
]
});
$tocGenerator->generate(
$toc, "Header1
\nAppendix
"
);
eq_or_diff($toc->format() . "\n", <
Header1
HTML
#--- 14. text and children passed to templateAnchorName ----------------
sub AssembleAnchorName {
# Get arguments
my ($aFile, $aGroupId, $aLevel, $aNode, $aText, $aChildren) = @_;
# Return value
return $aChildren;
} # AssembleAnchorHrefBegin()
# Set options
$toc->setOptions({
'doLinkToToken' => 1,
'tokenToToc' => [{
'level' => 1,
'tokenBegin' => ''
}],
'templateAnchorName' => \&AssembleAnchorName
});
# Generate ToC
$tocGenerator->generate($toc, 'very important
');
# Test ToC
eq_or_diff($toc->format(),
"",
'text and children passed to templateAnchorName'
);
# Reset options
$toc->setOptions({'templateAnchorName' => undef});
HTML-Toc-1.12/t/ManualTest/ 0000755 0001750 0001750 00000000000 11234545460 014564 5 ustar freddy freddy HTML-Toc-1.12/t/ManualTest/manualTest1.htm 0000755 0001750 0001750 00000004424 11152612466 017503 0 ustar freddy freddy
Manual
Preface
Better C than never.
Table of Contents
Table of Figures
Table of Tables
Introduction
Thanks to standardisation and the excellent work of the QWERTY corporation it is possible to learn C with almost any C manual.
Compile Steps
Parser
Compiler
Linker
Disks
Compiler Disk v1

Contents Compiler Disk v1
System
Standard Library
Compiler Disk v2

Contents Compiler Disk v2
System
parser.com
compiler.com
linker.com
Standard Library
Library System Disk
Personal
Tips & Tricks
Appendixes
Functions Standard Library v1
Functions Standard Library v2
Functions Graphic Library
Bibliography
HTML-Toc-1.12/t/update.t 0000755 0001750 0001750 00000010553 11170451327 014162 0 ustar freddy freddy #--- update.t -----------------------------------------------------------------
# function: Test ToC updating.
use strict;
use Test::More tests => 6;
use Test::Differences;
use HTML::Toc;
use HTML::TocUpdator;
my ($output, $output2, $content, $filename);
my $toc = HTML::Toc->new;
my $tocUpdator = HTML::TocUpdator->new;
$toc->setOptions({
'doLinkToToken' => 1,
'doNumberToken' => 1,
'levelIndent' => 0,
'insertionPoint' => 'before ',
'header' => '',
'footer' => '',
});
BEGIN {
# Create test file
$filename = "file$$.htm";
die "$filename is already there" if -e $filename;
open my $file, ">", $filename or die "Can't create $filename: $!";
print $file <<'EOT'; close $file;
Header
EOT
}
END {
# Remove test file
unlink($filename) or warn "Can't unlink $filename: $!";
}
#--- 1. update ----------------------------------------------------------------
$tocUpdator->update($toc, "Header
", {'output' => \$output});
eq_or_diff("$output\n", <1 Header
HTML
#--- 2. updateFile ------------------------------------------------------------
$tocUpdator->updateFile($toc, $filename, {'output' => \$output});
open my $file, '>', 'a.out1' || die "Can't create a.out1: $!";
print $file $output; close $file;
$output2 = <1 Header
HTML
open $file, '>', 'a.out2' || die "Can't create a.out2: $!";
print $file $output2; close $file;
eq_or_diff($output, $output2, 'updateFile', {max_width => 120});
END { for(qw/a.out1 a.out2/) {
unlink $_ or warn "Can't delete $_\n";
}}
#--- 3. insert ----------------------------------------------------------------
$tocUpdator->insert($toc, "Header
", {'output' => \$output});
eq_or_diff("$output\n", < 120});
1 Header
HTML
#--- 4. insertIntoFile --------------------------------------------------------
$tocUpdator->insertIntoFile($toc, $filename, {'output' => \$output});
eq_or_diff($output, < 120});
1 Header
HTML
#--- 5. update twice ----------------------------------------------------------
$tocUpdator->update($toc, "Header
", {'output' => \$output});
$tocUpdator->update($toc, $output, {'output' => \$output2});
eq_or_diff("$output\n", <<'EOT', 'update twice', {max_width => 120});
1 Header
EOT
#--- 6. tokens update begin & end ---------------------------------------------
$toc->setOptions({
'templateAnchorNameBegin' => '""',
'templateAnchorNameEnd' => '""',
'tokenUpdateBeginOfAnchorNameBegin' => '',
'tokenUpdateEndOfAnchorNameBegin' => '',
'tokenUpdateBeginOfAnchorNameEnd' => '',
'tokenUpdateEndOfAnchorNameEnd' => '',
'tokenUpdateBeginNumber' => '',
'tokenUpdateEndNumber' => '',
'tokenUpdateBeginToc' => '',
'tokenUpdateEndToc', => ''
});
$tocUpdator->update($toc, "Header
", {'output' => \$output});
eq_or_diff("$output\n", < 120});
1 Header
HTML
HTML-Toc-1.12/t/podExamples.t 0000755 0001750 0001750 00000054600 11170451327 015162 0 ustar freddy freddy #--- podExamples.t ------------------------------------------------------------
# function: Test HTML::ToC. In particular test the examples as described in
# the POD documentation.
use strict;
use Test::More tests => 16;
use Test::Differences;
use HTML::Toc;
use HTML::TocGenerator;
use HTML::TocInsertor;
use HTML::TocUpdator;
my ($filename, $filename2);
BEGIN {
# Create test file
$filename = "tmp.htm";
die "$filename is already there" if -e $filename;
# Create test file 2
$filename2 = "tmp2.htm";
die "$filename2 is already there" if -e $filename2;
}
END {
# Remove test file
unlink($filename) or warn "Can't unlink $filename: $!";
# Remove test file 2
unlink($filename2) or warn "Can't unlink $filename2: $!";
}
#--- TestExtendFromFile() --------------------------------------------------
# function: Test HTML::TocGenerator->extendFromFile()
sub TestExtendFromFile {
# Assemble test file
open(FILE, ">$filename") || die "Can't create $filename: $!";
print FILE <<'EOT'; close(FILE);
Chapter of document 1
EOT
# Assemble test file 2
open(FILE, ">$filename2") || die "Can't create $filename2: $!";
print FILE <<'EOT'; close(FILE);
Chapter of document 2
EOT
# Create objects
my $toc = HTML::Toc->new();
my $tocGenerator = HTML::TocGenerator->new();
# Set ToC options
$toc->setOptions({'doLinkToFile' => 1});
# Generate ToC
$tocGenerator->generateFromFile($toc, $filename);
$tocGenerator->extendFromFile($toc, $filename2);
# Test ToC
eq_or_diff($toc->format(), <extendFromFile()', {max_width=>120});
EOT
} # TestExtendFromFile()
#--- TestGenerateFromFiles() --------------------------------------------------
# function: Test HTML::TocGenerator->generateFromFile()
sub TestGenerateFromFiles {
# Assemble test file
open(FILE, ">$filename") || die "Can't create $filename: $!";
print FILE <<'EOT'; close(FILE);
Chapter of document 1
EOT
# Assemble test file 2
open(FILE, ">$filename2") || die "Can't create $filename2: $!";
print FILE <<'EOT'; close(FILE);
Chapter of document 2
EOT
# Create objects
my $toc = HTML::Toc->new();
my $tocGenerator = HTML::TocGenerator->new();
# Set ToC options
$toc->setOptions({'doLinkToFile' => 1});
# Generate ToC
$tocGenerator->generateFromFile($toc, [$filename, $filename2]);
# Test ToC
eq_or_diff($toc->format(), <generateFromFile()', {max_width=>120});
EOT
} # TestGenerateFromFiles()
#--- TestGenerateFromFile() --------------------------------------------------
# function: Test HTML::TocGenerator->generateFromFile() using multiple files.
sub TestGenerateFromFile {
# Assemble test file 1
open(FILE, ">$filename") || die "Can't create $filename: $!";
print FILE <<'EOT'; close(FILE);
Chapter
EOT
# Create objects
my $toc = HTML::Toc->new();
my $tocGenerator = HTML::TocGenerator->new();
# Generate ToC
$tocGenerator->generateFromFile($toc, $filename);
# Test ToC
eq_or_diff($toc->format(), <generateFromFile() using multiple files', {max_width=>120});
EOT
} # TestGenerateFromFile()
#--- TestInsertIntoFile() -----------------------------------------------------
# function: Test HTML::TocInsertor->insertIntoFile()
sub TestInsertIntoFile {
# Assemble test file
open(FILE, ">$filename") || die "Can't create $filename: $!";
print FILE <<'EOT'; close(FILE);
Chapter
EOT
# Create objects
my $toc = HTML::Toc->new();
my $tocInsertor = HTML::TocInsertor->new();
my $output;
# Generate ToC
$tocInsertor->insertIntoFile($toc, $filename, {'output' => \$output});
# Test ToC
eq_or_diff($output, <insertIntoFile()', {max_width=>120});
Chapter
EOT
} # TestInsertIntoFile()
#--- TestInsertIntoFileUsingTocUpdator() --------------------------------------
# function: Test HTML::TocUpdator->insertIntoFile()
sub TestInsertIntoFileUsingTocUpdator {
# Assemble test file
open(FILE, ">$filename") || die "Can't create $filename: $!";
print FILE <<'EOT'; close(FILE);
Chapter
EOT
# Create objects
my $toc = HTML::Toc->new();
my $tocUpdator = HTML::TocUpdator->new();
my $output;
# Generate ToC
$tocUpdator->insertIntoFile($toc, $filename, {'output' => \$output});
# Test ToC
eq_or_diff($output, <insertIntoFile()', {max_width=>120});
Chapter
EOT
} # TestInsertIntoFileUsingTocUpdator()
#--- TestUpdateFileUsingTocUpdator() -----------------------------------
# function: Test HTML::TocUpdator->updateFile()
sub TestUpdateFileUsingTocUpdator {
# Assemble test file
open(FILE, ">$filename") || die "Can't create $filename: $!";
print FILE <<'EOT'; close(FILE);
foo
bar
Chapter
EOT
# Create objects
my $toc = HTML::Toc->new();
my $tocUpdator = HTML::TocUpdator->new();
my $output;
# Generate ToC
$tocUpdator->updateFile($toc, $filename, {'output' => \$output});
# Test ToC
eq_or_diff($output, <updateFile()', {max_width=>120});
Chapter
EOT
} # TestInsertIntoFileUsingTocUpdator()
#--- TestUsingAttributeValueAsTocText() -----------------------------------
# function: Test HTML::TocInsertor->insertIntoFile()
sub TestUsingAttributeValueAsTocText {
# Assemble test file
open(FILE, ">$filename") || die "Can't create $filename: $!";
print FILE <<'EOT'; close(FILE);
EOT
# Create objects
my $toc = HTML::Toc->new();
my $tocInsertor = HTML::TocInsertor->new();
my $output;
$toc->setOptions({
'tokenToToc' => [{
'groupId' => 'image',
'tokenBegin' => '
'
}],
});
# Generate ToC
$tocInsertor->insertIntoFile($toc, $filename, {'output' => \$output});
# Test ToC
eq_or_diff($output, <120});
EOT
} # TestUsingAttributeValueAsTocText()
#--- TestGlobalGroups0() ------------------------------------------------------
# function: Test 'HTML::TocGenerator' option 'doUseGroupsGlobal = 0'.
sub TestGlobalGroups0 {
# Assemble test file
open(FILE, ">$filename") || die "Can't create $filename: $!";
print FILE <<'EOT'; close(FILE);
Chapter
Paragraph
EOT
# Create objects
my $toc1 = HTML::Toc->new();
my $toc2 = HTML::Toc->new();
my $tocGenerator = HTML::TocGenerator->new();
# Set options
$toc1->setOptions({
'header' => '',
'footer' => '',
'tokenToToc' => [{'tokenBegin' => ''}]
});
$toc2->setOptions({
'header' => '',
'footer' => '',
'tokenToToc' => [{'tokenBegin' => ''}]
});
# Generate ToC
$tocGenerator->generateFromFile([$toc1, $toc2], $filename);
# Test ToC
eq_or_diff($toc1->format() . $toc2->format() . "\n", <<'EOT', "Test 'HTML::TocGenerator' option 'doUseGroupsGlobal = 0'", {max_width=>120});
EOT
} # TestGlobalGroups0()
#--- TestGlobalGroups1() ------------------------------------------------------
# function: Test 'HTML::TocGenerator' option 'doUseGroupsGlobal = 1'.
sub TestGlobalGroups1 {
# Assemble test file
open(FILE, ">$filename") || die "Can't create $filename: $!";
print FILE <<'EOT';
Chapter
Paragraph
EOT
close(FILE);
# Create objects
my $toc1 = HTML::Toc->new();
my $toc2 = HTML::Toc->new();
my $tocGenerator = HTML::TocGenerator->new();
# Set options
$toc1->setOptions({
'header' => '',
'footer' => '',
'tokenToToc' => [{'tokenBegin' => ''}]
});
$toc2->setOptions({
'header' => '',
'footer' => '',
'tokenToToc' => [{'tokenBegin' => ''}]
});
# Generate ToC
$tocGenerator->generateFromFile(
[$toc1, $toc2], $filename, {'doUseGroupsGlobal' => 1}
);
# Test ToC
eq_or_diff($toc1->format() . $toc2->format() . "\n", <<'EOT', "Test 'HTML::TocGenerator' option 'doUseGroupsGlobal = 1'", {max_width=>120});
EOT
} # TestGlobalGroups1()
#--- TestMultipleGroupsAppendix() ---------------------------------------------
# function: Test multiple ToCs
sub TestMultipleGroupsAppendix() {
# Create objects
my $toc = HTML::Toc->new();
my $tocInsertor = HTML::TocInsertor->new();
my $output;
# Set ToC options
$toc->setOptions({
'tokenToToc' => [{
'tokenBegin' => ''
}, {
'tokenBegin' => '',
'level' => 2
}, {
'groupId' => 'appendix',
'tokenBegin' => '',
}, {
'groupId' => 'appendix',
'tokenBegin' => '',
'level' => 2
}],
});
# Generate ToC
$tocInsertor->insert($toc, < \$output});
Chapter
Paragraph
Subparagraph
Chapter
Appendix Chapter
Appendix Paragraph
EOT
# Test ToC
eq_or_diff($output, <120});
Chapter
Paragraph
Subparagraph
Chapter
Appendix Chapter
Appendix Paragraph
HTML
} # TestMultipleGroupsAppendix()
#--- TestMultipleGroupsPart() -------------------------------------------------
# function: Test multiple ToCs
sub TestMultipleGroupsPart() {
# Create objects
my $toc = HTML::Toc->new();
my $tocInsertor = HTML::TocInsertor->new();
my $output;
# Set ToC options
$toc->setOptions({
'tokenToToc' => [{
'tokenBegin' => ''
}, {
'tokenBegin' => '',
'level' => 2,
}, {
'groupId' => 'part',
'tokenBegin' => '',
'level' => 1,
'doNumberToken' => 1,
'numberingStyle' => 'upper-alpha'
}]
});
# Generate ToC
$tocInsertor->insert($toc, < \$output});
First Part
Chapter
Paragraph
Second Part
Chapter
Paragraph
HTML
# Test ToC
eq_or_diff($output, <120});
A First Part
Chapter
Paragraph
B Second Part
Chapter
Paragraph
HTML
} # TestMultipleGroupsPart()
#--- TestMultipleTocs() -------------------------------------------------------
# function: Test multiple ToCs
sub TestMultipleTocs() {
# Assemble test file
open(FILE, ">$filename") || die "Can't create $filename: $!";
print FILE <<'EOT'; close(FILE);
Header One
Paragraph One
EOT
# Create objects
my $toc1 = HTML::Toc->new();
my $toc2 = HTML::Toc->new();
my $tocInsertor = HTML::TocInsertor->new();
my $output;
# Set ToC options
$toc2->setOptions({
'tokenToToc' => [{
'groupId' => 'image',
'tokenBegin' => '
'
}],
});
# Generate ToC
$tocInsertor->insertIntoFile(
[$toc1, $toc2], $filename, {'output' => \$output}
);
# Test ToC
eq_or_diff($output, <120});
Header One
Paragraph One
HTML
} # TestMultipleTocs()
#--- TestSpecifyNumberedList() ------------------------------------------------
# function: Test specifying numbered list.
sub TestSpecifyNumberedList {
# Assemble test file
open(FILE, ">$filename") || die "Can't create $filename: $!";
print FILE <<'EOT'; close(FILE);
Chapter
Paragraph
EOT
# Create objects
my $toc = HTML::Toc->new();
my $tocGenerator = HTML::TocGenerator->new();
# Set ToC options
$toc->setOptions({
'templateLevelBegin' => '"\n"',
'templateLevelEnd' => '"
\n"',
});
# Generate ToC
$tocGenerator->generateFromFile($toc, $filename);
# Test ToC
eq_or_diff($toc->format(), <120});
- Chapter
- Paragraph
HTML
} # TestSpecifyNumberedList()
#--- TestNumberTocUsingGeneratedNumbers() ------------------------------------------------
# function: Test number ToC using generated numbers
sub TestNumberTocUsingGeneratedNumbers {
# Assemble test file
open(FILE, ">$filename") || die "Can't create $filename: $!";
print FILE <<'EOT'; close(FILE);
Chapter
Paragraph
EOT
# Create objects
my $toc = HTML::Toc->new();
my $tocGenerator = HTML::TocGenerator->new();
# Set ToC options
$toc->setOptions({
'templateLevel' => '"
$node $text"',
});
# Generate ToC
$tocGenerator->generateFromFile($toc, $filename);
# Test ToC
eq_or_diff($toc->format(), <120});
HTML
} # TestNumberTocUsingGeneratedNumbers()
#--- TestUpdateFile() ---------------------------------------------------------
# function: Test HTML::TocUpdator->updateFile()
sub TestUpdateFile {
# Assemble test file
open(FILE, ">$filename") || die "Can't create $filename: $!";
print FILE <<'EOT'; close(FILE);
foo
bar
Chapter
foo
EOT
# Create objects
my $toc = HTML::Toc->new();
my $tocUpdator = HTML::TocUpdator->new();
my $output;
# Generate ToC
$tocUpdator->updateFile($toc, $filename, {'output' => \$output});
# Test ToC
eq_or_diff($output, <updateFile()', {max_width=>120});
Chapter
HTML
} # TestUpdateFile()
#--- TestUsingCSS() -----------------------------------------------------------
# function: Test multiple ToCs
sub TestUsingCSS() {
# Create objects
my $toc = new HTML::Toc;
my $tocInsertor = new HTML::TocInsertor;
my $output;
$toc->setOptions({
'templateLevelBegin' => '"\n"',
'templateLevelEnd' => '"
\n"',
'doNumberToken' => 1,
'tokenToToc' => [{
'groupId' => 'appendix',
'tokenBegin' => '',
'numberingStyle' => 'upper-alpha'
}, {
'groupId' => 'appendix',
'tokenBegin' => '',
'level' => 2,
}]
});
$tocInsertor->insert($toc, <
Appendix
Appendix Paragraph
Appendix
Appendix Paragraph
EOT
# Insert ToC
$tocInsertor->insert($toc, < \$output});
Appendix
Appendix Paragraph
Appendix
Appendix Paragraph
EOT
# Test ToC
eq_or_diff($output, <120});
- Appendix
- Appendix Paragraph
- Appendix
- Appendix Paragraph
A Appendix
A.1 Appendix Paragraph
B Appendix
B.1 Appendix Paragraph
HTML
} # TestUsingCSS()
# 2. Test 'generateFromFile()'
TestGenerateFromFile();
# 4. Test 'doUseGroupsGlobal = 0'
TestGlobalGroups0();
# 5. Test 'doUseGroupsGlobal = 1'
TestGlobalGroups1();
# 6. Test 'tocInsertor->insertIntoFile'
TestInsertIntoFile();
# 7. Test 'tocUpdator->insertIntoFile'
TestInsertIntoFileUsingTocUpdator();
# 8. Test 'tocUpdator->updateFile'
TestUpdateFileUsingTocUpdator();
# 9. Test using attribute value as ToC text
TestUsingAttributeValueAsTocText();
# 3. Test 'generateFromFiles()'
TestGenerateFromFiles();
# 1. Test 'extendFromFile()'
TestExtendFromFile();
# 10. Test multiple ToCs
TestMultipleTocs();
# 8. Test additional 'appendix' group
TestMultipleGroupsAppendix();
# 9. Test additional 'part' group
TestMultipleGroupsPart();
# 11. Test specifying numbered list
TestSpecifyNumberedList();
# 11. Test specifying numbered list
TestNumberTocUsingGeneratedNumbers();
# 12. Test 'updateFile()'
TestUpdateFile();
# 13. Test using CSS
TestUsingCSS();
HTML-Toc-1.12/t/extend.t 0000755 0001750 0001750 00000003773 11170451327 014175 0 ustar freddy freddy #--- generate.t ---------------------------------------------------------------
# function: Test ToC generation.
use strict;
use Test;
BEGIN { plan tests => 4; }
use HTML::Toc;
use HTML::TocGenerator;
my ($filename);
my $toc = HTML::Toc->new;
my $tocGenerator = HTML::TocGenerator->new;
$toc->setOptions({
'doLinkToToken' => 0,
'levelIndent' => 0,
'header' => '',
'footer' => '',
});
BEGIN {
# Create test file
$filename = "file$$.htm";
die "$filename is already there" if -e $filename;
open(FILE, ">$filename") || die "Can't create $filename: $!";
print FILE <<'EOT';
Header
EOT
close(FILE);
}
END {
# Remove test file
unlink($filename) or warn "Can't unlink $filename: $!";
}
#--- 1. extend ----------------------------------------------------------------
# Generate ToC
$tocGenerator->generate($toc, "Header
");
# Extend ToC
$tocGenerator->extend($toc, "Header
");
# Test ToC
ok($toc->format(), "");
#--- 2. extendFromFile --------------------------------------------------------
# Generate ToC
$tocGenerator->generateFromFile($toc, $filename);
# Extend ToC
$tocGenerator->extendFromFile($toc, $filename);
# Test ToC
ok($toc->format(), "");
#--- 3. extendFromFiles -------------------------------------------------------
# Generate ToC
$tocGenerator->generateFromFile($toc, $filename);
# Extend ToC
$tocGenerator->extendFromFile($toc, [$filename, $filename]);
# Test ToC
ok($toc->format(), "\n- Header
\n- Header
\n- Header
\n
");
#--- 4. linkTocToToken --------------------------------------------------------
$toc->setOptions({
'doLinkToToken' => 1,
});
# Generate ToC
$tocGenerator->generate($toc, "Header
");
# Extend ToC
$tocGenerator->extend($toc, "Header
");
# Test ToC
ok($toc->format() . "\n", <<'EOT');
EOT
HTML-Toc-1.12/t/insert.t 0000755 0001750 0001750 00000021742 11170461124 014202 0 ustar freddy freddy #--- insert.t -----------------------------------------------------------------
# function: Test ToC insertion.
use strict;
use Test::More tests => 10;
use Test::Differences;
use HTML::Toc;
use HTML::TocGenerator;
use HTML::TocInsertor;
my ($output, $content, $filename);
my $toc = HTML::Toc->new;
my $tocGenerator = HTML::TocGenerator->new;
my $tocInsertor = HTML::TocInsertor->new;
$toc->setOptions({
'doLinkToToken' => 0,
'levelIndent' => 0,
'header' => "",
'footer' => "",
});
BEGIN {
# Create test file
$filename = "file$$.htm";
die "$filename is already there" if -e $filename;
open(FILE, ">$filename") || die "Can't create $filename: $!";
print FILE <<'HTML'; close(FILE);
Header
HTML
}
END {
# Remove test file
unlink($filename) or warn "Can't unlink $filename: $!";
}
#--- 1. insert before start ---------------------------------------------------
$toc->setOptions({'insertionPoint' => 'before '});
# Generate ToC
$tocGenerator->generate($toc, "Header
");
$tocInsertor->insert($toc, "Header
", {
'output' => \$output,
'doGenerateToc' => 0
});
# Test ToC
eq_or_diff($output, "Header
", 'insert before start');
#--- 2. insert after start ----------------------------------------------------
$toc->setOptions({'insertionPoint' => 'after '});
# Generate ToC
$tocGenerator->generate($toc, "Header
");
$tocInsertor->insert($toc, "Header
", {
'output' => \$output,
'doGenerateToc' => 0
});
# Test ToC
eq_or_diff($output, "Header
", 'insert after start');
#--- 3. insert before end -----------------------------------------------------
$toc->setOptions({'insertionPoint' => 'before
'});
# Generate ToC
$tocGenerator->generate($toc, "Header
");
$tocInsertor->insert($toc, "Header
", {
'output' => \$output,
'doGenerateToc' => 0
});
# Test ToC
eq_or_diff($output, "Header
", 'insert before end');
#--- 4. insert after end ------------------------------------------------------
$toc->setOptions({'insertionPoint' => 'after
'});
# Generate ToC
$tocGenerator->generate($toc, "Header
");
$tocInsertor->insert($toc, "Header
", {
'output' => \$output,
'doGenerateToc' => 0
});
# Test ToC
eq_or_diff($output, "Header
", 'insert after end');
#--- 5. outputFile ------------------------------------------------------------
$toc->setOptions({'insertionPoint' => 'before '});
# Generate ToC
$tocGenerator->generate($toc, "Header
");
# Insert ToC, output to file
$tocInsertor->insert($toc, "Header
", {
'outputFile' => $filename,
'doGenerateToc' => 0
});
# Read outputfile
open(FILE, "<$filename") || die "Can't open $filename: $!";
$content = join('', );
close(FILE);
# Test ToC
eq_or_diff($output, "Header
", 'outputFile');
#--- 6. empty toc -------------------------------------------------------------
$tocGenerator->generate($toc, "");
$tocInsertor->insert($toc, "", {
'output' => \$output,
'doGenerateToc' => 0
});
eq_or_diff($output, "", 'empty toc');
#--- TestAfterDeclaration() ---------------------------------------------------
# function: Test putting HTML comment after declaration.
sub TestAfterDeclaration {
# Create objects
my $toc = HTML::Toc->new();
my $tocInsertor = HTML::TocInsertor->new();
my $output;
# Set ToC options
$toc->setOptions({
'insertionPoint' => "after "
});
# Generate ToC
$tocInsertor->insert($toc, < \$output});
Appendix
Appendix Paragraph
Appendix
Appendix Paragraph
HTML
open(FILE, ">a.out") || die "Can't create a.out: $!";
print FILE $output;
close(FILE);
# Test ToC
eq_or_diff($output, < 120});
Appendix
Appendix Paragraph
Appendix
Appendix Paragraph
HTML
} # TestAfterDeclaration()
#--- TestNumberingStyle() -----------------------------------------------------
# function: Test numberingstyle.
sub TestNumberingStyle {
# Create objects
my $toc = HTML::Toc->new();
my $tocInsertor = HTML::TocInsertor->new();
my $output;
# Set ToC options
$toc->setOptions({
'numberingStyle' => 'lower-alpha',
'doNumberToken' => 1,
'tokenToToc' => [{
'tokenBegin' => '',
}, {
'tokenBegin' => '',
'level' => 2,
'numberingStyle' => 'upper-alpha'
}, {
'tokenBegin' => '',
'level' => 3,
'numberingStyle' => 'decimal'
}]
});
# Generate ToC
$tocInsertor->insert($toc, < \$output});
Chapter
Paragraph
Paragraph
Paragraph
Paragraph
HTML
# Test ToC
eq_or_diff($output, < 102});
a Chapter
a.A Paragraph
a.A.1 Paragraph
a.A.2 Paragraph
a.A.3 Paragraph
HTML
} # TestNumberingStyle()
#--- TestReplaceComment() -----------------------------------------------------
# function: Test replacing HTML comment with ToC.
sub TestReplaceComment {
# Create objects
my $toc = HTML::Toc->new();
my $tocInsertor = HTML::TocInsertor->new();
my $output;
# Set ToC options
$toc->setOptions({
'insertionPoint' => "replace "
});
# Generate ToC
$tocInsertor->insert($toc, < \$output});
Appendix
Appendix Paragraph
Appendix
Appendix Paragraph
HTML
# Test ToC
eq_or_diff($output, < 120});
Appendix
Appendix Paragraph
Appendix
Appendix Paragraph
HTML
} # TestReplaceComment()
#--- TestReplaceText() -----------------------------------------------------
# function: Test replacing text with ToC.
sub TestReplaceText {
# Create objects
my $toc = HTML::Toc->new();
my $tocInsertor = HTML::TocInsertor->new();
my $output;
# Set ToC options
$toc->setOptions({
'insertionPoint' => "replace ToC will be placed here[,]"
});
# Generate ToC
$tocInsertor->insert($toc, < \$output});
The ToC will be placed here, overnight.
Appendix
Appendix Paragraph
Appendix
Appendix Paragraph
HTML
# Test ToC
eq_or_diff($output, < 120});
The
overnight.
Appendix
Appendix Paragraph
Appendix
Appendix Paragraph
HTML
} # TestReplaceText()
# 7. Test 'numberingStyle'
TestNumberingStyle();
# 8. Test replace comment
TestReplaceComment();
# 9. Test after declaration
TestAfterDeclaration();
# 10. Test replace text
TestReplaceText();
HTML-Toc-1.12/TocInsertor.pm 0000755 0001750 0001750 00000106756 11234545235 015077 0 ustar freddy freddy #--- 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'.
# - `scene' ?
# - The term `scenario' is used for the output, which is seen as one
# long story (scenario), split in scenes:
# +-------------------scenario--------------------+
# +--scene--+--toc--+--scene--+--scene--+--scene--+
package HTML::TocInsertor;
use strict;
use HTML::TocGenerator;
BEGIN {
use vars qw(@ISA $VERSION);
$VERSION = '1.12';
@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;
# True if anchor name is being written to output
$self->{_writingAnchorName} = 0;
# True if anchor name-begin is being written to output
$self->{_writingAnchorNameBegin} = 0;
# 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
open $self->{_outputFileHandle}, ">", $self->{options}{'outputFile'}
or die "Can't create $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}}) {
if (length $toc->{options}{'insertionPoint'}) {
# 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 'after '
$tipPreposition = TIP_PREPOSITION_AFTER;
# Use entire 'insertionPoint' as token
$tipToken = $toc->{options}{'insertionPoint'};
} # if
} else {
# No, insertion point is empty string;
# Use default `after '
$tipPreposition = TIP_PREPOSITION_AFTER;
$tipToken = '';
} # if
# 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);
# Does token happen to be a ToC token, or is tip-tokentype <> TEXT?
if ($self->{_doReleaseElement} || $aTokenType != HTML::TocGenerator::TT_TOKENTYPE_TEXT) {
# No, token isn't a ToC token;
# 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, $aTokenType);
# 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++;
} # if
} # while
# Token functions as ToC insertion point?
if ($result) {
# Yes, token functions as ToC insertion point;
# Process insertion point(s)
$self->_processTocInsertionPoints($aOrigText);
} # if
} else {
$result = 0;
} // if
# 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.
# - $aTokenType: type of token: start, end, comment or text.
sub _processTocInsertionPoint {
# Get arguments
my ($self, $aTipToken, $aTokenType) = @_;
# Local variables
my ($tipToc, $tipPreposition);
# Aliases
$tipToc = $aTipToken->[TIP_TOC];
$tipPreposition = $aTipToken->[TIP_PREPOSITION];
# If TipToken is of type TEXT, prepend possible preceding string
if ($aTokenType == HTML::TocGenerator::TT_TOKENTYPE_TEXT && length $`) {
my $prepend = $`;
push(@{$self->{_scenarioBeforeToken}}, \$prepend);
} # if
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);
# Indicate token itself must not be output
$self->{_doOutputInsertionPointToken} = 0;
last SWITCH;
} # if
# 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);
# Add token text
if ($aTokenType == HTML::TocGenerator::TT_TOKENTYPE_TEXT) {
my $text = $&;
push(@{$self->{_scenarioBeforeToken}}, \$text);
$self->{_doOutputInsertionPointToken} = 0;
} else {
$self->{_doOutputInsertionPointToken} = ! $self->{_isTocToken};
} # if
last SWITCH;
} # if
# 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 token text
if ($aTokenType == HTML::TocGenerator::TT_TOKENTYPE_TEXT) {
my $text = $&;
$self->toc($self->{_scenarioAfterToken}, \$text);
$self->{_doOutputInsertionPointToken} = 0;
} else {
$self->{_doOutputInsertionPointToken} = ! $self->{_isTocToken};
} # if
# Add ToC reference to scenario reference by calling 'toc' method
$self->toc($self->{_scenarioAfterToken}, $tipToc);
last SWITCH;
} # if
} # SWITCH
# If TipToken is of type TEXT, append possible following string
if ($aTokenType == HTML::TocGenerator::TT_TOKENTYPE_TEXT && length $') {
my $append = $';
push(@{$self->{_scenarioAfterToken}}, \$append);
} # if
} # _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->_writeOrBufferOutput(\$outputPrefix);
$self->{_outputPrefix} = "";
}
# Must insertion point token be output?
if ($self->{_doOutputInsertionPointToken}) {
# Yes, output insertion point token;
push(@{$self->{_scenario}}, \$aTokenText);
#$self->_writeOrBufferOutput(\$aTokenText);
}
if ($outputSuffix = $self->{_outputSuffix}) {
push(@{$self->{_scenario}}, \$outputSuffix);
#$self->_writeOrBufferOutput(\$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} = "";
if ($self->{_doReleaseElement}) {
# 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);
} # if
} # if
} # _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::afterAnchorNameBegin() -------------------------
# Extend ancestor method.
# @see HTML::TocGenerator::afterAnchorNameBegin
sub afterAnchorNameBegin {
# Get arguments
my ($self, $aAnchorNameBegin, $aToc) = @_;
# Store anchor name as output suffix
#$self->{_outputSuffix} = $aAnchorNameBegin;
$self->{_holdChildren} = $aAnchorNameBegin . $self->{_holdChildren};
# Indicate anchor name is being written
$self->{_writingAnchorNameBegin} = 1;
# Indicate anchor name end must be output
$self->{_doOutputAnchorNameEnd} = 1;
} # afterAnchorNameBegin()
#--- 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->{_outputPrefix} .= $aAnchorNameEnd;
# Is anchor-name-begin being output this parsing round as well?
if ($self->{_writingAnchorNameBegin}) {
# Yes, anchor-name-begin is being output as well;
# Indicate both anchor name begin and anchor name end are being written
$self->{_writingAnchorName} = 1;
} # if
} # 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, $aToc) = @_;
# Store heading number as output suffix
#$self->{_outputSuffix} .= $aNumber;
#$self->_writeOrBufferOutput($aNumber);
$self->{_holdChildren} = $aNumber . $self->{_holdChildren};
} # number()
#--- HTML::TocInsertor::_processTocStartingToken() ---------------------------
# Extend ancestor method.
sub _processTocStartingToken {
# Get arguments
my ($self, $aTocToken, $aTokenType, $aTokenAttributes, $aTokenOrig) = @_;
$self->SUPER::_processTocStartingToken($aTocToken, $aTokenType, $aTokenAttributes, $aTokenOrig);
# Was attribute used as ToC text?
if (defined($aTocToken->[HTML::TocGenerator::TT_ATTRIBUTES_TOC])) {
# Yes, attribute was used as ToC text;
# Output children - containing anchor name only - before toc element
$self->_writeOrBufferOutput($self->{_holdChildren} . $self->{_holdBeginTokenOrig});
} else {
# No, attribute wasn't used as ToC text;
# Output children - including anchor name - within toc element
$self->_writeOrBufferOutput($self->{_holdBeginTokenOrig} . $self->{_holdChildren});
} # if
} # _processTocStartingToken()
#--- 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
# - $aTokenOrig: the original token string
sub start {
# Get arguments
my ($self, $aTag, $aAttr, $aAttrSeq, $aTokenOrig) = @_;
# Local variables
my ($doOutput, $i, $tocToken, $tag, $anchorId);
# Let ancestor process the start tag
$self->SUPER::start($aTag, $aAttr, $aAttrSeq, $aTokenOrig);
# 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, $aTokenOrig
)) {
# 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 $aTokenOrig\n";
# Add anchor id to start tag
$aTokenOrig =~ s/(id)=\S*([\s>])/$1=$anchorId$2/i;
}
else {
# No, attribute 'id' doesn't exist;
# Add anchor id to start tag
$aTokenOrig =~ s/>/ id=$anchorId>/;
}
} # if
# Is start tag a ToC token?
if (! $self->{_isTocToken}) {
# No, start tag isn't a ToC token;
# Output start tag normally
$self->_writeOrBufferOutput($aTokenOrig);
} # if
}
}
} # 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;
HTML-Toc-1.12/Changes 0000755 0001750 0001750 00000005630 11234545050 013541 0 ustar freddy freddy Revision history for Perl extension HTML::Toc.
2009-07-31 Freddy Vulto
Release 1.12
- Added Test::Differences to Makefile.PL
2009-04-13 Freddy Vulto
Release 1.11
- ToC insertion point doesn't match anymore if insertionPoint is a text
token within a ToC token.
- fix TocInsertor.pm to preserve surrounding text of ToC insertion point
- updated Makefile.PL to automatically do "SET PERLIO=perlio" on
MSWin32 (Dan Dascalescu)
- Test suite:
- switched tests to use Test::More and Test::Differences (Dan
Dascalescu)
- added separate test files `insertionPoint.t' and `anchors.t' (Dan
Dascalescu)
- added test "text and children passed to templateAnchorName" to
`generate.t' (Dan Dascalescu)
2008-12-12 Freddy Vulto
Release 1.10
- additional paramaters `text' and `children' are now passed to
`templateAnchorName'. To make this possible, internals have been
changed to defer processing of a ToC item (matched on a start tag -
at which processing used to take place immediately), until the
matching `end' tag is passed.
- Reverted addition of `:raw:utf8' layers (v1.00), because CPAN Testers
reported "Unknown open() mode '>:raw:utf8'" on Perl-5.6.2. CRLF test
issues under Windows can be addressed instead by setting `set
PERLIO=perlio' before running `make test'.
2008-11-28 Freddy Vulto
Release 1.00
- Made ToC compliant to XHTML-1.0 STRICT:
- attributes are now quoted;
- nested ul's are embedded within li's;
- anchor name tag is inserted within header tags instead of outside;
- the inserted anchor name tag now is empty, i.e. immediately
followed by , to make nested anchor errors less likely to occur.
- Removed FileHandle dependency and added `:raw:utf8' layers when
opening files. This fixes CRLF issues under Windows (thanks to Dan
Dascalescu).
2008-11-20 Freddy Vulto
Release 0.92
- Fixed tests on Debian.
2001-09-03 Freddy Vulto
Release 0.91
- Tested on Cygwin.
- Used Unix file type for source files.
- Updated documentation.
- Prohibited call with undefined parameter to HTML::Parser->parse() from
HTML::_tokenTocEndParser->parse() which caused havoc with version 3.25
of HTML::Parser.
- Specified 'HTML::Parser' as module that needs to be available in order
to use HTML::Toc.
- Added protected method HTML::TocGenerator::_setActiveAnchorName().
This method replaces the incongruous access of
'HTML::TocUpdator::_doDeleteTokens' by HTML::TocGenerator.
HTML::TocUpdator now overrides '_setActiveAnchorName()' to allow
the ancestor call to HTML::TocGenerator only when '_doDeleteTokens'
equals false.
2001-08-09 Freddy Vulto
Release 0.90
- First release.
HTML-Toc-1.12/TocUpdator.pm 0000755 0001750 0001750 00000053420 11234545245 014676 0 ustar freddy freddy #==== HTML::TocUpdator ========================================================
# function: Update 'HTML::Toc' table of contents.
# note: - 'TUT' is an abbreviation of 'Toc Update Token'.
package HTML::TocUpdator;
use strict;
use HTML::TocInsertor;
use Data::Dumper;
BEGIN {
use vars qw(@ISA $VERSION);
$VERSION = '1.12';
@ISA = qw(HTML::TocInsertor);
}
use constant TUT_TOKENTYPE_START => 0;
use constant TUT_TOKENTYPE_END => 1;
use constant TUT_TOKENTYPE_TEXT => 2;
use constant TUT_TOKENTYPE_COMMENT => 3;
use constant MODE_DO_NOTHING => 0; # 0b00
use constant MODE_DO_INSERT => 1; # 0b01
use constant MODE_DO_UPDATE => 3; # 0b11
END {}
#--- HTML::TocUpdator::new() --------------------------------------------------
# function: Constructor.
sub new {
# Get arguments
my ($aType) = @_;
my $self = $aType->SUPER::new;
# Bias to not update ToC
$self->{htu__Mode} = MODE_DO_NOTHING;
# Bias to not delete tokens
$self->{_doDeleteTokens} = 0;
# Reset batch variables
#$self->_resetBatchVariables;
$self->{options} = {};
# TODO: Initialize output
return $self;
} # new()
#--- HTML::TocUpdator::_deinitializeUpdatorBatch() --------------------------
# function: Deinitialize updator batch.
# args: - $aTocs: Reference to array of tocs.
sub _deinitializeUpdatorBatch {
# Get arguments
my ($self, $aTocs) = @_;
# Indicate end of ToC updating
$self->{htu__Mode} = MODE_DO_NOTHING;
# Deinitialize insertor batch
$self->_deinitializeInsertorBatch();
} # _deinitializeUpdatorBatch()
#--- HTML::TokenUpdator::_doesHashEqualHash() ---------------------------------
# function: Determines whether hash1 equals hash2.
# args: - $aHash1
# - $aHash2
# returns: True (1) if hash1 equals hash2, 0 if not. For example, with the
# following hashes:
#
# %hash1 = { %hash2 = {
# 'class' => 'header', 'class' => 'header',
# 'id' => 'intro1' 'id' => 'intro2'
# } }
#
# the routine will return 0, cause the hash fields 'id' differ.
# note: Class function.
sub _doesHashEqualHash {
# Get arguments
my ($aHash1, $aHash2) = @_;
# Local variables
my ($key1, $value1, $key2, $value2, $result);
# Bias to success
$result = 1;
# Loop through hash1 while values available
HASH1: while (($key1, $value1) = each %$aHash1) {
# Yes, values are available;
# Value1 differs from value2?
if ($value1 ne $aHash2->{$key1}) {
# Yes, hashes differ;
# Indicate condition fails
$result = 0;
# Reset 'each' iterator which we're going to break
keys %$aHash2;
# Break loop
last HASH1;
}
}
# Return value
return $result;
} # _doesHashEqualHash()
#--- HTML::TokenUpdator::_doesTagExistInArray() -------------------------------
# function: Check whether tag & attributes matches any of the tags & attributes
# in the specified array. The array must consist of elements with
# format:
#
# [$tag, \%attributes]
#
# args: - $aTag: tag to search for
# - $aAttributes: tag attributes to search for
# - $aArray: Array to search in.
# returns: 1 if tag does exist in array, 0 if not.
# note: Class function.
sub _doesTagExistInArray {
# Get arguments
my ($aTag, $aAttributes, $aArray) = @_;
# Local variables
my ($tag, $result);
# Bias to non-existing tag
$result = 0;
# Loop through existing tags
TAG: foreach $tag (@{$aArray}) {
if (defined(@{$tag}[0])) {
# Does tag equals any existing tag?
if ($aTag eq @{$tag}[0]) {
# Yes, tag equals existing tag;
# Do hashes equal?
if (HTML::TocUpdator::_doesHashEqualHash(
$aAttributes, @{$tag}[1]
)) {
# Yes, hashes are the same;
# Indicate tag exists in array
$result = 1;
# Break loop
last TAG;
}
}
}
}
# Return value
return $result;
} # _doesTagExistInArray()
#--- HTML::TocUpdator::_initializeUpdatorBatch() ----------------------------
# function: Initialize insertor batch.
# args: - $aMode: Mode. Can be either MODE_DO_INSERT or MODE_DO_UPDATE
# - $aTocs: Reference to array of tocs.
# - $aOptions: optional options
# note: Updating actually means: deleting the old ToC and inserting a new
# ToC. That's why we're calling 'insertor' methods here.
sub _initializeUpdatorBatch {
# Get arguments
my ($self, $aMode, $aTocs, $aOptions) = @_;
# Initialize insertor batch
$self->_initializeInsertorBatch($aTocs, $aOptions);
# Parse ToC update templates
$self->_parseTocUpdateTokens();
# Indicate start of ToC updating
$self->{htu__Mode} = $aMode;
} # _initializeUpdatorBatch()
#--- HTML::TocUpdator::_parseTocUpdateTokens() --------------------------------
# function: Parse ToC insertion point specifier.
sub _parseTocUpdateTokens {
# Get arguments
my ($self) = @_;
# Local variables
my ($toc, $tokenType, $tokenPreposition, $token);
my ($tocInsertionPoint, $tocInsertionPointTokenAttributes);
# Create parser for update begin tokens
my $tokenUpdateBeginParser = HTML::_TokenUpdateParser->new(
$self->{_tokensUpdateBegin}
);
# Create parser for update end tokens
my $tokenUpdateEndParser = HTML::_TokenUpdateParser->new(
$self->{_tokensUpdateEnd}
);
# Loop through ToCs
foreach $toc (@{$self->{_tocs}}) {
# Parse update tokens
$tokenUpdateBeginParser->parse(
$toc->{_tokenUpdateBeginOfAnchorNameBegin}
);
$tokenUpdateBeginParser->parse($toc->{_tokenUpdateBeginOfAnchorNameEnd});
$tokenUpdateBeginParser->parse($toc->{_tokenUpdateBeginNumber});
$tokenUpdateBeginParser->parse($toc->{_tokenUpdateBeginToc});
$tokenUpdateEndParser->parse($toc->{_tokenUpdateEndOfAnchorNameBegin});
$tokenUpdateEndParser->parse($toc->{_tokenUpdateEndOfAnchorNameEnd});
$tokenUpdateEndParser->parse($toc->{_tokenUpdateEndNumber});
$tokenUpdateEndParser->parse($toc->{_tokenUpdateEndToc});
}
} # _parseTocUpdateTokens()
#--- HTML::TocUpdator::_resetBatchVariables() ---------------------------------
# function: Reset batch variables
sub _resetBatchVariables {
# Get arguments
my ($self) = @_;
# Call ancestor
$self->SUPER::_resetBatchVariables();
# Arrays containing start, end, comment & text tokens which indicate
# the begin of ToC tokens. The tokens are stored in keys of hashes to
# avoid storing duplicates as an array would.
$self->{_tokensUpdateBegin} = [
[], # ['', ]
{}, # {'' => ''}
{}, # {'' => ''}
{} # {'' => ''}
];
# Arrays containing start, end, comment & text tokens which indicate
# the end of ToC tokens. The tokens are stored in keys of hashes to
# avoid storing duplicates as an array would.
$self->{_tokensUpdateEnd} = [
[], # ['', ]
{}, # {'' => ''}
{}, # {'' => ''}
{} # {'' => ''}
];
} # _resetBatchVariables()
#--- HTML::TocUpdator::_setActiveAnchorName() ---------------------------------
# function: Set active anchor name.
# args: - aAnchorName: Name of anchor name to set active.
sub _setActiveAnchorName {
# Get arguments
my ($self, $aAnchorName) = @_;
# Are tokens being deleted?
if (! $self->{_doDeleteTokens}) {
# No, tokens aren't being deleted;
# Call ancestor to set anchor name
$self->SUPER::_setActiveAnchorName($aAnchorName);
}
} # _setActiveAnchorName()
#--- HTML::TocUpdator::_update() ----------------------------------------------
# function: Update ToC in string.
# args: - $aMode: Mode. Can be either MODE_DO_UPDATE or MODE_DO_INSERT.
# - $aToc: (reference to array of) ToC object to update
# - $aString: string to update ToC of
# - $aOptions: optional updator options
# note: Used internally.
sub _update {
# Get arguments
my ($self, $aMode, $aToc, $aString, $aOptions) = @_;
# Initialize TocUpdator batch
$self->_initializeUpdatorBatch($aMode, $aToc, $aOptions);
# Start updating ToC by starting ToC insertion
$self->_insert($aString);
# Deinitialize TocUpdator batch
$self->_deinitializeUpdatorBatch();
} # update()
#--- HTML::TocUpdator::_updateFile() ------------------------------------------
# function: Update ToCs in file.
# args: - $aMode: Mode. Can be either MODE_DO_UPDATE or MODE_DO_INSERT.
# - $aToc: (reference to array of) ToC object to update
# - $aFile: (reference to array of) file to parse for updating.
# - $aOptions: optional updator options
# note: Used internally.
sub _updateFile {
# Get arguments
my ($self, $aMode, $aToc, $aFile, $aOptions) = @_;
# Initialize TocUpdator batch
$self->_initializeUpdatorBatch($aMode, $aToc, $aOptions);
# Start updating ToC by starting ToC insertion
$self->_insertIntoFile($aFile);
# Deinitialize TocUpdator batch
$self->_deinitializeUpdatorBatch();
} # _updateFile()
#--- HTML::TocUpdator::_writeOrBufferOutput() ---------------------------------
# function: Write processed HTML to output device(s).
# args: - aOutput: scalar to write
sub _writeOrBufferOutput {
# Get arguments
my ($self, $aOutput) = @_;
# Delete tokens?
if ($self->{_doDeleteTokens}) {
# Yes, delete output;
$aOutput = '';
} # if
# Call ancestor
$self->SUPER::_writeOrBufferOutput($aOutput);
} # _writeOrBufferOutput()
#--- HTML::TocUpdator::anchorNameBegin() --------------------------------------
# function: Process 'anchor name begin' generated by HTML::Toc.
# args: - $aAnchorName: Anchor name begin tag to output.
# - $aToc: Reference to ToC to which anchorname belongs.
sub afterAnchorNameBegin {
# Get arguments
my ($self, $aAnchorNameBegin, $aToc) = @_;
# Must ToC be inserted or updated?
if ($self->{htu__Mode} != MODE_DO_NOTHING) {
# Yes, ToC must be inserted or updated;
# Surround anchor name with update tags
$aAnchorNameBegin =
$aToc->{_tokenUpdateBeginOfAnchorNameBegin} .
$aAnchorNameBegin .
$aToc->{_tokenUpdateEndOfAnchorNameBegin};
} # if
# Call ancestor
$self->SUPER::afterAnchorNameBegin($aAnchorNameBegin, $aToc);
} # afterAnchorNameBegin()
#--- HTML::TocUpdator::anchorNameEnd() ----------------------------------------
# function: Process 'anchor name end' generated by HTML::Toc.
# args: - $aAnchorNameEnd: Anchor name end tag to output.
# - $aToc: Reference to ToC to which anchorname belongs.
sub anchorNameEnd {
# Get arguments
my ($self, $aAnchorNameEnd, $aToc) = @_;
# Call ancestor
$self->SUPER::anchorNameEnd($aAnchorNameEnd);
# Must ToC be inserted or updated?
if ($self->{htu__Mode} != MODE_DO_NOTHING) {
# Yes, ToC must be inserted or updated;
# Surround anchor name with update tags
if ($self->{_outputPrefix}) {
$self->{_outputPrefix} =
$aToc->{_tokenUpdateBeginOfAnchorNameEnd} .
$self->{_outputPrefix} .
$aToc->{_tokenUpdateEndOfAnchorNameEnd};
} # if
} # if
} # anchorNameEnd()
#--- HTML::TocUpdator::comment() ----------------------------------------------
# function: Process comment.
# args: - $aComment: comment text with '' tags stripped off.
sub comment {
# Get arguments
my ($self, $aComment) = @_;
# Must ToC be updated?
if ($self->{htu__Mode} == MODE_DO_UPDATE) {
# Yes, ToC must be updated;
# Updator is currently deleting tokens?
if ($self->{_doDeleteTokens}) {
# Yes, tokens must be deleted;
# Look for update end token
# Does comment matches update end token?
if (defined(
$self->{_tokensUpdateEnd}[TUT_TOKENTYPE_COMMENT]{$aComment}
)) {
# Yes, comment matches update end token;
# Indicate to stop deleting tokens
$self->{_doDeleteTokens} = 0;
} else {
# Call ancestor
$self->SUPER::comment($aComment);
} # if
} else {
# No, tokens mustn't be deleted;
# Look for update begin token
# Does comment matches update begin token?
if (defined(
$self->{_tokensUpdateBegin}[TUT_TOKENTYPE_COMMENT]{$aComment}
)) {
# Yes, comment matches update begin token;
# Indicate to start deleting tokens
$self->{_doDeleteTokens} = 1;
} else {
# Call ancestor
$self->SUPER::comment($aComment);
} # if
} # if
} else {
# No, ToC mustn't be updated;
# Call ancestor
$self->SUPER::comment($aComment);
} # if
} # comment()
#--- HTML::TocUpdator::end() --------------------------------------------------
# function: This function is called every time a closing tag is encountered.
# args: - $aTag: tag name (in lower case).
# - $aOrigText: tag name including brackets.
sub end {
# Get arguments
my ($self, $aTag, $aOrigText) = @_;
# Call ancestor
$self->SUPER::end($aTag, $aOrigText);
# Must ToC be updated?
if ($self->{htu__Mode} == MODE_DO_UPDATE) {
# Yes, ToC must be updated;
# Updator is currently deleting tokens?
if ($self->{_doDeleteTokens}) {
# Yes, tokens must be deleted;
# Does end tag matches update end token?
if (defined(
$self->{_tokensUpdateEnd}[TUT_TOKENTYPE_END]{$aTag}
)) {
# Yes, end tag matches update end token;
# Indicate to stop deleting tokens
$self->{_doDeleteTokens} = 0;
}
}
}
} # end()
#--- HTML::TocUpdator::insert() -----------------------------------------------
# function: Insert ToC in string.
# args: - $aToc: (reference to array of) ToC object to update
# - $aString: string to insert ToC in.
# - $aOptions: optional updator options
sub insert {
# Get arguments
my ($self, $aToc, $aString, $aOptions) = @_;
# Do start insert
$self->_update(MODE_DO_INSERT, $aToc, $aString, $aOptions);
} # insert()
#--- HTML::TocUpdator::insertIntoFile() --------------------------------------
# function: Insert ToC in file.
# args: - $aToc: (reference to array of) ToC object to update
# - $aFile: File to insert ToC in.
# - $aOptions: optional updator options
sub insertIntoFile {
# Get arguments
my ($self, $aToc, $aFile, $aOptions) = @_;
# Do start insert
$self->_updateFile(MODE_DO_INSERT, $aToc, $aFile, $aOptions);
} # insertIntoFile()
#--- HTML::TocUpdator::formatNumber() ----------------------------------
# function: Process heading number generated by HTML::Toc.
# args: - $aNumber
# - $aToc: Reference to ToC to which anchorname belongs.
sub formatNumber {
# Get arguments
my ($self, $aNumber, $aToc) = @_;
# Call ancestor
my $result = $self->SUPER::formatNumber($aNumber, $aToc);
# Must ToC be inserted or updated?
if ($self->{htu__Mode} != MODE_DO_NOTHING) {
# Yes, ToC must be inserted or updated;
# Surround number with update tags
$result = $aToc->{_tokenUpdateBeginNumber} . $result . $aToc->{_tokenUpdateEndNumber};
} # if
return $result;
} # formatNumber()
#--- HTML::TocUpdator::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) = @_;
# Must ToC be updated?
if ($self->{htu__Mode} == MODE_DO_UPDATE) {
# Yes, ToC must be updated;
# Does start tag matches token update begin tag?
if (HTML::TocUpdator::_doesTagExistInArray(
$aTag, $aAttr, $self->{_tokensUpdateBegin}[TUT_TOKENTYPE_START]
)) {
# Yes, start tag matches token update tag;
# Indicate to delete tokens
$self->{_doDeleteTokens} = 1;
}
}
# Let ancestor process the start tag
$self->SUPER::start($aTag, $aAttr, $aAttrSeq, $aOrigText);
} # start()
#--- HTML::TocUpdator::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) = @_;
# Surround toc with update tokens
# Add update begin token
push(@$aScenario, \$aToc->{_tokenUpdateBeginToc});
# Call ancestor
$self->SUPER::toc($aScenario, $aToc);
# Add update end token
push(@$aScenario, \$aToc->{_tokenUpdateEndToc});
} # toc()
#--- HTML::TocUpdator::_processTocText() --------------------------------------
# function: Toc text processing function.
# args: - $aText: Text to add to ToC.
# - $aToc: ToC to add text to.
sub _processTocText {
# Get arguments
my ($self, $aText, $aToc) = @_;
# Delete output?
if (! $self->{_doDeleteTokens}) {
# No, don't delete output;
# Call ancestor
$self->SUPER::_processTocText($aText, $aToc);
}
} # _processTocText()
#--- HTML::TocUpdator::_processTocTokenChildren() ----------------------
# function: Toc token children processing function.
# args: - $aText: Text to add to ToC.
# - $aToc: ToC to which text belongs.
sub _processTocTokenChildren {
# Get arguments
my ($self, $aText, $aToc) = @_;
# Delete output?
if (! $self->{_doDeleteTokens}) {
# No, don't delete output;
# Call ancestor
$self->SUPER::_processTocTokenChildren($aText, $aToc);
} # if
} # _processTocTokenChildren()
#--- HTML::TocUpdator::_processTocTokenText() --------------------------
# function: Toc token text processing function.
# args: - $aText: Text to add to ToC.
# - $aToc: ToC to which text belongs.
sub _processTocTokenText {
# Get arguments
my ($self, $aText, $aToc) = @_;
# Delete output?
if (! $self->{_doDeleteTokens}) {
# No, don't delete output;
# Call ancestor
$self->SUPER::_processTocTokenText($aText, $aToc);
} # if
} # _processTocTokenText()
#--- HTML::TocUpdator::update() -----------------------------------------------
# function: Update ToC in string.
# args: - $aToc: (reference to array of) ToC object to update
# - $aString: string to update ToC of
# - $aOptions: optional updator options
sub update {
# Get arguments
my ($self, $aToc, $aString, $aOptions) = @_;
# Do start update
$self->_update(MODE_DO_UPDATE, $aToc, $aString, $aOptions);
} # update()
#--- HTML::TocUpdator::updateFile() -------------------------------------------
# function: Update ToC of file.
# args: - $aToc: (reference to array of) ToC object to update
# - $aFile: (reference to array of) file to parse for updating.
# - $aOptions: optional updator options
sub updateFile {
# Get arguments
my ($self, $aToc, $aFile, $aOptions) = @_;
# Do start update
$self->_updateFile(MODE_DO_UPDATE, $aToc, $aFile, $aOptions);
} # update()
#=== HTML::_TokenUpdateParser =================================================
# function: Parse 'update tokens'. 'Update tokens' mark HTML code which is
# inserted by 'HTML::TocInsertor'.
# note: Used internally.
package HTML::_TokenUpdateParser;
BEGIN {
use vars qw(@ISA);
@ISA = qw(HTML::Parser);
}
END {}
#--- HTML::_TokenUpdateParser::new() ------------------------------------------
# function: Constructor
sub new {
# Get arguments
my ($aType, $aTokenArray) = @_;
# Create instance
my $self = $aType->SUPER::new;
# Reference token array
$self->{tokens} = $aTokenArray;
# Return instance
return $self;
} # new()
#--- HTML::_TokenUpdateParser::comment() --------------------------------------
# function: Process comment.
# args: - $aComment: comment text with '' tags stripped off.
sub comment {
# Get arguments
my ($self, $aComment) = @_;
# Add token to array of update tokens
$self->{tokens}[HTML::TocUpdator::TUT_TOKENTYPE_COMMENT]{$aComment} = '';
} # comment()
#--- HTML::_TokenUpdateParser::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) = @_;
# Add token to array of update tokens
$self->{tokens}[HTML::TocUpdator::TUT_TOKENTYPE_END]{$aTag} = '';
} # end()
#--- HTML::_TokenUpdateParser::parse() ----------------------------------------
# function: Parse token.
# args: - $aToken: 'update token' to parse
sub parse {
# Get arguments
my ($self, $aString) = @_;
# Call ancestor
$self->SUPER::parse($aString);
} # parse()
#--- HTML::_TokenUpdateParser::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) = @_;
# Does token exist in array?
if (! HTML::TocUpdator::_doesTagExistInArray(
$aTag, $aAttr, $self->{tokens}[HTML::TocUpdator::TUT_TOKENTYPE_START]
)) {
# No, token doesn't exist in array;
# Add token to array of update tokens
push(
@{$self->{tokens}[HTML::TocUpdator::TUT_TOKENTYPE_START]},
[$aTag, $aAttr]
);
}
} # start()
#--- HTML::_TokenUpdateParser::text() -----------------------------------------
# function: This function is called every time plain text is encountered.
# args: - @_: array containing data.
sub text {
# Get arguments
my ($self, $aText) = @_;
# Add token to array of update tokens
$self->{tokens}[HTML::TocUpdator::TUT_TOKENTYPE_TEXT]{$aText} = '';
} # text()
1;
HTML-Toc-1.12/MANIFEST 0000644 0001750 0001750 00000001077 11234545460 013402 0 ustar freddy freddy Changes
Toc.pod
Toc.pm
TocGenerator.pm
TocInsertor.pm
TocUpdator.pm
Makefile.PL
MANIFEST
t/anchors.t
t/extend.t
t/format.t
t/generate.t
t/insert.t
t/insertionPoint.t
t/manualTest.t
t/options.t
t/podExamples.t
t/propagate.t
t/siteMap.t
t/update.t
t/ManualTest/manualTest1.htm
t/SiteMap/index.htm
t/SiteMap/SubDir1/index.htm
t/SiteMap/SubDir1/SubSubDir1/index.htm
t/SiteMap/SubDir2/index.htm
t/SiteMap/SubDir2/SubSubDir1/index.htm
t/SiteMap/SubDir2/SubSubDir2/index.htm
t/SiteMap/SubDir3/index.htm
META.yml Module meta-data (added by MakeMaker)
HTML-Toc-1.12/Toc.pm 0000755 0001750 0001750 00000037744 11234545241 013346 0 ustar freddy freddy #=== HTML::Toc ================================================================
# function: HTML Table of Contents
package HTML::Toc;
use strict;
BEGIN {
use vars qw($VERSION);
$VERSION = '1.12';
}
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 =>
'""';
use constant TEMPLATE_ANCHOR_HREF_BEGIN_FILE =>
'""';
use constant TEMPLATE_ANCHOR_HREF_END => '""';
use constant TEMPLATE_ANCHOR_NAME_BEGIN =>
'""';
use constant TEMPLATE_ANCHOR_NAME_END => '""';
use constant TOKEN_UPDATE_BEGIN_OF_ANCHOR_NAME_BEGIN =>
'';
use constant TOKEN_UPDATE_END_OF_ANCHOR_NAME_BEGIN =>
'';
use constant TOKEN_UPDATE_BEGIN_OF_ANCHOR_NAME_END =>
'';
use constant TOKEN_UPDATE_END_OF_ANCHOR_NAME_END =>
'';
use constant TOKEN_UPDATE_BEGIN_NUMBER =>
'';
use constant TOKEN_UPDATE_END_NUMBER =>
'';
use constant TOKEN_UPDATE_BEGIN_TOC =>
'';
use constant TOKEN_UPDATE_END_TOC =>
'';
use constant TEMPLATE_TOKEN_NUMBER => '"$node "';
# Level templates
use constant TEMPLATE_LEVEL => '"$text"';
use constant TEMPLATE_LEVEL_CLOSE => '"\n"';
use constant TEMPLATE_LEVEL_BEGIN => '"\n"';
use constant TEMPLATE_LEVEL_END => '"
\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 = abs($aGlobalLevel * 2 + $aAdd - 1) * $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
# - aGlobalLevel
# - aLevelIndex
# note: Recursive function this is.
sub _formatToc {
# Get arguments
my (
$self, $aPreviousLevel, $aPreviousGroupLevel, $aToc, $aHeaderLines,
$aGlobalLevel, $aLevelIndex
) = @_;
# 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;
if ($aLevelIndex) {
$$aToc .= eval($self->{_templateLevelClose});
} # if
# Format level
$$aToc .= $self->_formatLevelIndent(
ref($self->{_templateLevel}) eq "CODE" ?
&{$self->{_templateLevel}}(
$level, $groupId, $node, $sequenceNr, $text
) :
eval($self->{_templateLevel}),
0, $aGlobalLevel
);
$aLevelIndex++;
}
# Greater?
if ($compareStatus > 0) {
# Yes, new level is greater than previous level;
# Increase global level
if ($aGlobalLevel++) {
$$aToc .= "\n"
} # if
# Format begin of level
$$aToc .= $self->_formatLevelIndent(
eval($self->{_templateLevelBegin}), -1, $aGlobalLevel
);
# 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
if ($level > $aPreviousLevel + 1) {
$level = $aPreviousLevel + 1;
$text = '';
# Format level
$$aToc .= $self->_formatLevelIndent(
ref($self->{_templateLevel}) eq "CODE" ?
&{$self->{_templateLevel}}(
$level, $groupId, $node, $sequenceNr, $text
) :
eval($self->{_templateLevel}),
0, $aGlobalLevel
);
} # if
}
# Process line again
unshift @$aHeaderLines, $line;
# Assemble TOC (recursive) for next level
$self->_formatToc(
$level, $groupLevel, $aToc, $aHeaderLines, $aGlobalLevel, 0
);
# Format end of level
$$aToc .= eval($self->{_templateLevelClose});
$$aToc .= $self->_formatLevelIndent(
eval($self->{_templateLevelEnd}), -1, $aGlobalLevel
);
# Decrease global level
$aGlobalLevel--;
# Indent for line to come
if (scalar(@$aHeaderLines) && $level > 1 || $aGlobalLevel) {
$$aToc .= $self->_formatLevelIndent('', 0, $aGlobalLevel);
} # if
# 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 ',
'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' => ''
}, {
'level' => 2,
'tokenBegin' => ''
}, {
'level' => 3,
'tokenBegin' => ''
}, {
'level' => 4,
'tokenBegin' => ''
}, {
'level' => 5,
'tokenBegin' => ''
}, {
'level' => 6,
'tokenBegin' => ''
}
],
'header' =>
"\n\n",
'footer' =>
"\n\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, 0);
# Remove last newline
# $toc =~ s/\r\n$//m;
# $toc =~ s/\r$//m;
$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 close template
$self->{_templateLevelClose} =
defined($options->{'templateLevelClose'}) ?
$options->{'templateLevelClose'} :
TEMPLATE_LEVEL_CLOSE;
# 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;
HTML-Toc-1.12/TocGenerator.pm 0000755 0001750 0001750 00000157404 11234545231 015210 0 ustar freddy freddy #=== HTML::TocGenerator =======================================================
# function: Generate 'HTML::Toc' table of contents.
# note: - 'TT' is an abbrevation of 'TocToken'.
package HTML::TocGenerator;
use strict;
use HTML::Parser;
BEGIN {
use vars qw(@ISA $VERSION);
$VERSION = '1.12';
@ISA = qw(HTML::Parser);
}
# Warnings
use constant WARNING_TOC_ATTRIBUTE_PS_NOT_AVAILABLE_WITHIN_PS => 2;
use constant TOC_TOKEN_ID => 0;
use constant TOC_TOKEN_INCLUDE => 1;
use constant TOC_TOKEN_EXCLUDE => 2;
use constant TOC_TOKEN_TOKENS => 3;
use constant TOC_TOKEN_GROUP => 4;
use constant TOC_TOKEN_TOC => 5;
use constant CONTAINMENT_INCLUDE => 0;
use constant CONTAINMENT_EXCLUDE => 1;
# Token types
use constant TT_TAG_BEGIN => 0;
use constant TT_TAG_END => 1;
use constant TT_TAG_TYPE_END => 2;
use constant TT_INCLUDE_ATTRIBUTES_BEGIN => 3;
use constant TT_EXCLUDE_ATTRIBUTES_BEGIN => 4;
use constant TT_INCLUDE_ATTRIBUTES_END => 5;
use constant TT_EXCLUDE_ATTRIBUTES_END => 6;
use constant TT_GROUP => 7;
use constant TT_TOC => 8;
use constant TT_ATTRIBUTES_TOC => 9;
use constant TT_TOKENTYPE_START => 0;
use constant TT_TOKENTYPE_END => 1;
use constant TT_TOKENTYPE_TEXT => 2;
use constant TT_TOKENTYPE_COMMENT => 3;
use constant TT_TOKENTYPE_DECLARATION => 4;
END {}
#--- HTML::TocGenerator::new() ------------------------------------------------
# function: Constructor
sub new {
# Get arguments
my ($aType) = @_;
my $self = $aType->SUPER::new;
# Bias to not generate ToC
$self->{_doGenerateToc} = 0;
# Bias to not use global groups
$self->{_doUseGroupsGlobal} = 0;
# Output
$self->{_doReleaseElement} = 1;
$self->{output} = "";
# Reset internal variables
$self->_resetBatchVariables();
$self->{options} = {};
return $self;
} # new()
#--- HTML::TocGenerator::_deinitializeBatch() ---------------------------------
sub _deinitializeBatch() {
# Get arguments
my ($self) = @_;
} # _deinitializeBatch()
#--- HTML::TocGenerator::_deinitializeExtenderBatch() -------------------------
sub _deinitializeExtenderBatch() {
# Get arguments
my ($self) = @_;
# Do general batch deinitialization
$self->_deinitializeBatch();
# Indicate end of ToC generation
$self->{_doGenerateToc} = 0;
# Reset batch variables
$self->_resetBatchVariables();
} # _deinitializeExtenderBatch()
#--- HTML::TocGenerator::_deinitializeGeneratorBatch() ------------------------
sub _deinitializeGeneratorBatch() {
# Get arguments
my ($self) = @_;
# Do 'extender' batch deinitialization
$self->_deinitializeExtenderBatch();
} # _deinitializeBatchGenerator()
#--- HTML::TocGenerator::_doesHashContainHash() -------------------------------
# function: Determines whether hash1 matches regular expressions of hash2.
# args: - $aHash1
# - $aHash2
# - $aContainmentType: 0 (include) or 1 (exclude)
# returns: True (1) if hash1 satisfies hash2, 0 if not. For example, with the
# following hashes:
#
# %hash1 = { %hash2 = {
# 'class' => 'header' 'class' => '^h'
# 'id' => 'intro' }
# }
#
# the routine will return 1 if 'aContainmentType' equals 0, cause
# 'hash1' satisfies the conditions of 'hash2'. The routine will
# return 0 if 'aContainmentType' equals 1, cause 'hash1' doesn't
# exclude the conditions of 'hash2'.
# note: Class function.
sub _doesHashContainHash {
# Get arguments
my ($aHash1, $aHash2, $aContainmentType) = @_;
# Local variables
my ($key1, $value1, $key2, $value2, $result);
# Bias to success
$result = 1;
# Loop through hash2
HASH2: while (($key2, $value2) = each %$aHash2) {
# Yes, values are available;
# Get value1
$value1 = $aHash1->{$key2};
# Does value1 match criteria of value2?
if (defined($value1) && $value1 =~ m/$value2/) {
# Yes, value1 matches criteria of value2;
# Containment type was exclude?
if ($aContainmentType == CONTAINMENT_EXCLUDE) {
# Yes, containment type was exclude;
# Indicate condition fails
$result = 0;
# Reset 'each' iterator which we're going to break
keys %$aHash2;
# Break loop
last HASH2;
}
}
else {
# No, value1 didn't match criteria of value2;
# Containment type was include?
if ($aContainmentType == CONTAINMENT_INCLUDE) {
# Yes, containment type was include;
# Indicate condition fails
$result = 0;
# Reset 'each' iterator which we're going to break
keys %$aHash2;
# Break loop
last HASH2;
}
}
}
# Return value
return $result;
} # _doesHashContainHash()
#--- HTML::TocGenerator::_extend() --------------------------------------------
# function: Extend ToC.
# - $aString: String to parse.
sub _extend {
# Get arguments
my ($self, $aFile) = @_;
# Local variables
my ($file);
# Parse string
$self->parse($aFile);
# Flush remaining buffered text
$self->eof();
} # _extend()
#--- HTML::TocGenerator::_extendFromFile() ------------------------------------
# function: Extend ToC.
# - $aFile: (reference to array of) file to parse.
sub _extendFromFile {
# 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) {
# Store filename
$self->{_currentFile} = $file;
# Parse file
$self->parse_file($file);
# Flush remaining buffered text
$self->eof();
}
} # _extendFromFile()
#--- HTML::TocGenerator::_formatHeadingLevel() --------------------------------
# function: Format heading level.
# args: - $aLevel: Level of current heading
# - $aClass: Class of current heading
# - $aGroup: Group of current heading
# - $aToc: Toc of current heading
sub _formatHeadingLevel {
# Get arguments
my ($self, $aLevel, $aClass, $aGroup, $aToc) = @_;
# Local variables
my ($result, $headingNumber, $numberingStyle);
$headingNumber = $self->_getGroupIdManager($aToc)->
{levels}{$aClass}[$aLevel - 1] || 0;
# Alias numbering style of current group
$numberingStyle = $aGroup->{numberingStyle};
SWITCH: {
if ($numberingStyle eq "decimal") {
$result = $headingNumber;
last SWITCH;
}
if ($numberingStyle eq "lower-alpha") {
$result = chr($headingNumber + ord('a') - 1);
last SWITCH;
}
if ($numberingStyle eq "upper-alpha") {
$result = chr($headingNumber + ord('A') - 1);
last SWITCH;
}
if ($numberingStyle eq "lower-roman") {
require Roman;
$result = Roman::roman($headingNumber);
last SWITCH;
}
if ($numberingStyle eq "upper-roman") {
require Roman;
$result = Roman::Roman($headingNumber);
last SWITCH;
}
die "Unknown case: $numberingStyle";
}
# Return value
return $result;
} # _formatHeadingLevel()
#--- HTML::TocGenerator::_formatTocNode() -------------------------------------
# function: Format heading node.
# args: - $aLevel: Level of current heading
# - $aClass: Class of current heading
# - $aGroup: Group of current heading
# - $aToc: Toc of current heading
sub _formatTocNode {
# Get arguments
my ($self, $aLevel, $aClass, $aGroup, $aToc) = @_;
# Local variables
my ($result, $level, $levelGroups);
# Alias 'levelGroups' of right 'groupId'
$levelGroups = $aToc->{_levelGroups}{$aGroup->{'groupId'}};
# Loop through levels
for ($level = 1; $level <= $aLevel; $level++) {
# If not first level, add dot
$result = ($result ? $result . "." : $result);
# Format heading level using argument group
$result .= $self->_formatHeadingLevel(
$level, $aClass, @{$levelGroups}[$level - 1], $aToc
);
}
# Return value
return $result;
} # _formatTocNode()
#--- HTML::TocGenerator::_generate() ------------------------------------------
# function: Generate ToC.
# args: - $aString: Reference to string to parse
sub _generate {
# Get arguments
my ($self, $aString) = @_;
# Local variables
my ($toc);
# Loop through ToCs
foreach $toc (@{$self->{_tocs}}) {
# Clear ToC
$toc->clear();
}
# Extend ToCs
$self->_extend($aString);
} # _generate()
#--- HTML::TocGenerator::_generateFromFile() ----------------------------------
# function: Generate ToC.
# args: - $aFile: (reference to array of) file to parse.
sub _generateFromFile {
# Get arguments
my ($self, $aFile) = @_;
# Local variables
my ($toc);
# Loop through ToCs
foreach $toc (@{$self->{_tocs}}) {
# Clear ToC
$toc->clear();
}
# Extend ToCs
$self->_extendFromFile($aFile);
} # _generateFromFile()
#--- HTML::TocGenerator::_getGroupIdManager() ---------------------------------
# function: Get group id manager.
# args: - $aToc: Active ToC.
# returns: Group id levels.
sub _getGroupIdManager {
# Get arguments
my ($self, $aToc) = @_;
# Local variables
my ($result);
# Global groups?
if ($self->{options}{'doUseGroupsGlobal'}) {
# Yes, global groups;
$result = $self;
}
else {
# No, local groups;
$result = $aToc;
}
# Return value
return $result;
} # _getGroupIdManager()
#--- HTML::TocGenerator::_initializeBatch() -----------------------------------
# function: Initialize batch. This function is called once when a parse batch
# is started.
# args: - $aTocs: Reference to array of tocs.
sub _initializeBatch {
# Get arguments
my ($self, $aTocs) = @_;
# Local variables
my ($toc);
# Store reference to tocs
# Is ToC specification reference to array?
if (ref($aTocs) =~ m/ARRAY/) {
# Yes, ToC specification is reference to array;
# Store array reference
$self->{_tocs} = $aTocs;
}
else {
# No, ToC specification is reference to ToC object;
# Wrap reference in array reference, containing only one element
$self->{_tocs} = [$aTocs];
}
# Loop through ToCs
foreach $toc (@{$self->{_tocs}}) {
# Parse ToC options
$toc->parseOptions();
}
} # _initializeBatch()
#--- HTML::TocGenerator::_initializeExtenderBatch() --------------------------
# function: Initialize 'extender' batch. This function is called once when a
# parse batch is started.
# args: - $aTocs: Reference to array of tocs.
sub _initializeExtenderBatch {
# Get arguments
my ($self, $aTocs) = @_;
# Do general batch initialization
$self->_initializeBatch($aTocs);
# Parse ToC options
$self->_parseTocOptions();
# Indicate start of batch
$self->{_doGenerateToc} = 1;
} # _initializeExtenderBatch()
#--- HTML::TocGenerator::_initializeGeneratorBatch() --------------------------
# function: Initialize generator batch. This function is called once when a
# parse batch is started.
# args: - $aTocs: Reference to array of tocs.
# - $aOptions: optional options
sub _initializeGeneratorBatch {
# Get arguments
my ($self, $aTocs, $aOptions) = @_;
# Add invocation options
$self->setOptions($aOptions);
# Option 'doUseGroupsGlobal' specified?
if (!defined($self->{options}{'doUseGroupsGlobal'})) {
# No, options 'doUseGroupsGlobal' not specified;
# Default to no 'doUseGroupsGlobal'
$self->{options}{'doUseGroupsGlobal'} = 0;
}
# Global groups?
if ($self->{options}{'doUseGroupsGlobal'}) {
# Yes, global groups;
# Reset groups and levels
$self->_resetStackVariables();
}
# Do 'extender' batch initialization
$self->_initializeExtenderBatch($aTocs);
} # _initializeGeneratorBatch()
#--- HTML::TocGenerator::_linkTocToToken() ------------------------------------
# function: Link ToC to token.
# args: - $aToc: ToC to add token to.
# - $aFile
# - $aGroupId
# - $aLevel
# - $aNode
# - $aGroupLevel
# - $aLinkType
# - $aTokenAttributes: reference to hash containing attributes of
# start token
sub _linkTocToToken {
# Get arguments
my (
$self, $aToc, $aFile, $aGroupId, $aLevel, $aNode, $aGroupLevel,
$aDoLinkToId, $aTokenAttributes
) = @_;
# Local variables
my ($anchorName, $children, $file, $groupId, $level, $node, $text);
my ($doInsertAnchor, $doInsertId);
# Fill local arguments to be used by templates
$file = $aFile;
$groupId = $aGroupId;
$level = $aLevel;
$node = $aNode;
$text = defined($self->{_holdText}) ? $self->{_holdText} : '';
$children = defined($self->{_holdChildren}) ? $self->{_holdChildren} : '';
# Assemble anchor name
$anchorName =
ref($aToc->{_templateAnchorName}) eq "CODE" ?
&{$aToc->{_templateAnchorName}}(
$aFile, $aGroupId, $aLevel, $aNode, $text, $children
) :
eval($aToc->{_templateAnchorName});
# Bias to insert anchor name
$doInsertAnchor = 1;
$doInsertId = 0;
# Link to 'id'?
if ($aDoLinkToId) {
# Yes, link to 'id';
# Indicate to insert anchor id
$doInsertAnchor = 0;
$doInsertId = 1;
# Id attribute is available?
if (defined($aTokenAttributes->{id})) {
# Yes, id attribute is available;
# Use existing ids?
if ($aToc->{options}{'doUseExistingIds'}) {
# Yes, use existing ids;
# Use existing id
$anchorName = $aTokenAttributes->{id};
# Indicate to not insert id
$doInsertId = 0;
}
} # if
} else {
# No, link to 'name';
# Anchor name is currently active?
if (defined($self->{_activeAnchorName})) {
# Yes, anchor name is currently active;
# Use existing anchors?
if ($aToc->{options}{'doUseExistingAnchors'}) {
# Yes, use existing anchors;
# Use existing anchor name
$anchorName = $self->{_activeAnchorName};
# Indicate to not insert anchor name
$doInsertAnchor = 0;
} else {
# No, don't use existing anchors; insert new anchor;
#
}
}
}
# Add reference to ToC
$aToc->{_toc} .=
ref($aToc->{_templateAnchorHrefBegin}) eq "CODE" ?
&{$aToc->{_templateAnchorHrefBegin}}(
$aFile, $aGroupId, $aLevel, $aNode, $anchorName
) :
eval($aToc->{_templateAnchorHrefBegin});
# Bias to not output anchor name end
$self->{_doOutputAnchorNameEnd} = 0;
# Must anchor be inserted?
if ($doInsertAnchor) {
# Yes, anchor must be inserted;
# Allow adding of anchor name begin token to text by calling
# 'anchorNameBegin' method
$self->afterAnchorNameBegin(
$self->anchorNameBegin(
ref($aToc->{_templateAnchorNameBegin}) eq "CODE" ?
&{$aToc->{_templateAnchorNameBegin}}(
$aFile, $aGroupId, $aLevel, $aNode, $anchorName
) :
eval($aToc->{_templateAnchorNameBegin}),
$aToc
), $aToc
);
}
# Must anchorId attribute be inserted?
if ($doInsertId) {
# Yes, anchorId attribute must be inserted;
# Allow adding of anchorId attribute to text by calling 'anchorId'
# method
$self->anchorId($anchorName);
}
} # _linkTocToToken()
#--- HTML::TocGenerator::_outputAnchorNameEndConditionally() ------------------
# function: Output 'anchor name end' if necessary
# args: - $aToc: ToC of which 'anchor name end' must be output.
sub _outputAnchorNameEndConditionally {
# Get arguments
my ($self, $aToc) = @_;
# Must anchor name end be output?
if ($self->{_doOutputAnchorNameEnd}) {
# Yes, output anchor name end;
# Allow adding of anchor to text by calling 'anchorNameEnd'
# method
$self->anchorNameEnd(
ref($aToc->{_templateAnchorNameEnd}) eq "CODE" ?
&{$aToc->{_templateAnchorNameEnd}} :
eval($aToc->{_templateAnchorNameEnd}),
$aToc
);
}
} # _outputAnchorNameEndConditionally()
#--- HTML::TocGenerator::_parseTocOptions() -----------------------------------
# function: Parse ToC options.
sub _parseTocOptions {
# Get arguments
my ($self) = @_;
# Local variables
my ($toc, $group, $tokens, $tokenType, $i);
# Create parsers for ToC tokens
$self->{_tokensTocBegin} = [];
my $tokenTocBeginParser = HTML::_TokenTocBeginParser->new(
$self->{_tokensTocBegin}
);
my $tokenTocEndParser = HTML::_TokenTocEndParser->new();
# Loop through ToCs
foreach $toc (@{$self->{_tocs}}) {
# Reference parser ToC to current ToC
$tokenTocBeginParser->setToc($toc);
# Loop through 'tokenToToc' groups
foreach $group (@{$toc->{options}{'tokenToToc'}}) {
# Reference parser group to current group
$tokenTocBeginParser->setGroup($group);
# Parse 'tokenToToc' group
$tokenTocBeginParser->parse($group->{'tokenBegin'});
# Flush remaining buffered text
$tokenTocBeginParser->eof();
$tokenTocEndParser->parse(
$group->{'tokenEnd'},
$tokenTocBeginParser->{_lastAddedToken},
$tokenTocBeginParser->{_lastAddedTokenType}
);
# Flush remaining buffered text
$tokenTocEndParser->eof();
}
}
} # _parseTocOptions()
#--- HTML::TocGenerator::_processTocEndingToken() -----------------------------
# function: Process ToC-ending-token.
# args: - $aTocToken: token which acts as ToC-ending-token.
sub _processTocEndingToken {
# Get arguments
my ($self, $aTocToken) = @_;
# Local variables
my ($text, $toc);
# Aliases
$toc = $aTocToken->[TT_TOC];
$self->{_doReleaseElement} = 1;
# Process entire ToC element
$self->_processTocStartingToken(
$self->{_holdTocStartToken},
$self->{_holdBeginTokenType},
$self->{_holdBeginTokenAttributes},
$self->{_holdBeginTokenOrig}
);
$self->{_holdTocText} =~ s/\s*\n\s*/ /g;
$toc->{_toc} .= $self->{_holdTocText};
$self->{_holdTocStartToken} = undef;
$self->{_holdBeginTokenType} = undef;
$self->{_holdBeginTokenAttributes} = undef;
$self->{_holdBeginTokenOrig} = undef;
$self->{_holdText} = undef;
$self->{_holdTocText} = undef;
$self->{_holdChildren} = undef;
# Link ToC to tokens?
if ($toc->{options}{'doLinkToToken'}) {
# Yes, link ToC to tokens;
# Add anchor href end
$toc->{_toc} .=
(ref($toc->{_templateAnchorHrefEnd}) eq "CODE") ?
&{$toc->{_templateAnchorHrefEnd}} :
eval($toc->{_templateAnchorHrefEnd});
# Output anchor name end only if necessary
$self->_outputAnchorNameEndConditionally($toc);
}
} # _processTocEndingToken()
#--- HTML::TocGenerator::_processTocStartingToken() ---------------------------
# function: Process ToC-starting-token.
# args: - $aTocToken: token which acts as ToC-starting-token.
# - $aTokenType: type of token. Can be either TT_TOKENTYPE_START,
# _END, _TEXT, _COMMENT or _DECLARATION.
# - $aTokenAttributes: reference to hash containing attributes of
# currently parsed token
# - $aTokenOrig: reference to original token
sub _processTocStartingToken {
# Get arguments
my ($self, $aTocToken, $aTokenType, $aTokenAttributes, $aTokenOrig) = @_;
# Local variables
my ($i, $level, $doLinkToId, $node, $groupLevel);
my ($file, $tocTokenId, $groupId, $toc, $attribute);
# Aliases
$file = $self->{_currentFile};
$toc = $aTocToken->[TT_TOC];
$level = $aTocToken->[TT_GROUP]{'level'};
$groupId = $aTocToken->[TT_GROUP]{'groupId'};
$doLinkToId = (defined($aTocToken->[TT_GROUP]{'doLinkToId'})) ?
$aTocToken->[TT_GROUP]{'doLinkToId'} : $toc->{options}{'doLinkToId'};
# Link to 'id' and tokenType isn't 'start'?
if (($doLinkToId) && ($aTokenType != TT_TOKENTYPE_START)) {
# Yes, link to 'id' and tokenType isn't 'start';
# Indicate to *not* link to 'id'
$doLinkToId = 0;
}
if (ref($level) eq "CODE") {
$level = &$level($self->{_currentFile}, $node);
}
if (ref($groupId) eq "CODE") {
$groupId = &$groupId($self->{_currentFile}, $node);
}
# Determine class level
my $groupIdManager = $self->_getGroupIdManager($toc);
# Known group?
if (!exists($groupIdManager->{groupIdLevels}{$groupId})) {
# No, unknown group;
# Add group
$groupIdManager->{groupIdLevels}{$groupId} = keys(
%{$groupIdManager->{groupIdLevels}}
) + 1;
}
$groupLevel = $groupIdManager->{groupIdLevels}{$groupId};
# Increase level
$groupIdManager->{levels}{$groupId}[$level - 1] += 1;
# Reset remaining levels of same group
for ($i = $level; $i < @{$groupIdManager->{levels}{$groupId}}; $i++) {
$groupIdManager->{levels}{$groupId}[$i] = 0;
}
# Assemble numeric string indicating current level
$node = $self->_formatTocNode(
$level, $groupId, $aTocToken->[TT_GROUP], $toc
);
# Add newline if _toc not empty
if ($toc->{_toc}) {
$toc->{_toc} .= "\n";
}
# Add toc item info
$toc->{_toc} .= "$level $groupLevel $groupId $node " .
$groupIdManager->{levels}{$groupId}[$level - 1] . " ";
# Add value of 'id' attribute if available
if (defined($aTokenAttributes->{id})) {
$toc->{_toc} .= $aTokenAttributes->{id};
}
$toc->{_toc} .= " ";
# Number tokens?
if (
$aTocToken->[TT_GROUP]{'doNumberToken'} ||
(
! defined($aTocToken->[TT_GROUP]{'doNumberToken'}) &&
$toc->{options}{'doNumberToken'}
)
) {
# Yes, number tokens;
# Add number by calling 'number' method
$self->number(
$self->formatNumber(
ref($toc->{_templateTokenNumber}) eq "CODE" ?
&{$toc->{_templateTokenNumber}}(
$node, $groupId, $file, $groupLevel, $level, $toc
) :
eval($toc->{_templateTokenNumber}),
$toc
)
);
} # if
# Link ToC to tokens?
if ($toc->{options}{'doLinkToToken'}) {
# Yes, link ToC to tokens;
# Link ToC to token
$self->_linkTocToToken(
$toc, $file, $groupId, $level, $node, $groupLevel, $doLinkToId,
$aTokenAttributes, $self->{_holdChildren}
);
} # if
# Must attribute be used as ToC text?
if (defined($aTocToken->[TT_ATTRIBUTES_TOC])) {
# Yes, attribute must be used as ToC text;
# Loop through attributes
foreach $attribute (@{$aTocToken->[TT_ATTRIBUTES_TOC]}) {
# Attribute is available?
if (defined($$aTokenAttributes{$attribute})) {
# Yes, attribute is available;
# Add attribute value to ToC
$self->_processTocText($$aTokenAttributes{$attribute}, $toc);
}
else {
# No, attribute isn't available;
# Show warning
$self->_showWarning(
WARNING_TOC_ATTRIBUTE_PS_NOT_AVAILABLE_WITHIN_PS,
[$attribute, $$aTokenOrig]
);
}
# Output anchor name end only if necessary
#$self->_outputAnchorNameEndConditionally($toc);
}
}
} # _processTocStartingToken()
#--- HTML::TocGenerator::_processTocText() ------------------------------------
# function: This function processes text which must be added to the preliminary
# (non-formatted) ToC.
# args: - $aText: Text to add to ToC.
# - $aToc: ToC to add text to.
sub _processTocText {
# Get arguments
my ($self, $aText, $aToc) = @_;
# Add text to ToC
if (defined($self->{_holdTocText})) {
$self->{_holdTocText} .= $aText;
} else {
# Remove possible newlines from text
$aText =~ s/\s*\n\s*/ /g;
$aToc->{_toc} .= $aText;
} # if
} # _processTocText()
#--- HTML::TocGenerator::_processTocTokenChildren() --------------------
# function: This function processes children which resides inside a ToC token.
# args: - $aText
# - $aToc: ToC to which token belongs
sub _processTocTokenChildren {
# Get arguments
my ($self, $aText, $aToc) = @_;
# Must children be put on hold?
if (defined($self->{_holdChildren})) {
# Yes, children must be put on hold;
# Add children to hold buffer
$self->{_holdChildren} .= $aText;
} # if
} # _processTocTokenChildren()
#--- HTML::TocGenerator::_processTocTokenText() ---------------------------
# function: This function processes text which resides inside a ToC token.
# args: - $aText
# - $aToc: ToC to which token belongs
sub _processTocTokenText {
# Get arguments
my ($self, $aText, $aToc) = @_;
# Must text be put on hold?
if (defined($self->{_holdText})) {
# Yes, text must be put on hold;
# Add text to hold buffers
$self->{_holdText} .= $aText;
$self->{_holdChildren} .= $aText;
} # if
} # _processTocTokenText()
#--- HTML::TocGenerator::_processTokenAsTocEndingToken() ----------------------
# function: Check for token being a token to use for triggering the end of
# a ToC line and process it accordingly.
# args: - $aTokenType: type of token: 'start', 'end', 'comment' or 'text'.
# - $aTokenId: token id of currently parsed token
sub _processTokenAsTocEndingToken {
# Get arguments
my ($self, $aTokenType, $aTokenId) = @_;
# Local variables
my ($i, $tokenId, $toc, $tokens);
# Loop through dirty start tokens
$i = 0;
# Alias token array of right type
$tokens = $self->{_tokensTocEnd}[$aTokenType];
# Loop through token array
while ($i < scalar @$tokens) {
# Aliases
$tokenId = $tokens->[$i][TT_TAG_END];
# Does current end tag equals dirty tag?
if ($aTokenId eq $tokenId) {
# Yes, current end tag equals dirty tag;
# Process ToC-ending-token
$self->_processTocEndingToken($tokens->[$i]);
# Remove dirty tag from array, automatically advancing to
# next token
splice(@$tokens, $i, 1);
}
else {
# No, current end tag doesn't equal dirty tag;
# Advance to next token
$i++;
}
}
} # _processTokenAsTocEndingToken()
#--- HTML::TocGenerator::_processTokenAsTocStartingToken() --------------------
# function: Check for token being a ToC-starting-token and process it
# accordingly.
# args: - $aTokenType: type of token. Can be either TT_TOKENTYPE_START,
# _END, _TEXT, _COMMENT or _DECLARATION.
# - $aTokenId: token id of currently parsed token
# - $aTokenAttributes: reference to hash containing attributes of
# currently parsed token
# - $aTokenOrig: reference to original token string
# returns: 1 if successful, i.e. token is processed as ToC-starting-token, 0
# if not.
sub _processTokenAsTocStartingToken {
# Get arguments
my ($self, $aTokenType, $aTokenId, $aTokenAttributes, $aTokenOrig) = @_;
# Local variables
my ($level, $levelToToc, $groupId, $groupToToc);
my ($result, $tocToken, $tagBegin, @tokensTocBegin, $fileSpec);
# Bias to token not functioning as ToC-starting-token
$result = 0;
# Loop through start tokens of right type
foreach $tocToken (@{$self->{_tokensTocBegin}[$aTokenType]}) {
# Alias file filter
$fileSpec = $tocToken->[TT_GROUP]{'fileSpec'};
# File matches?
if (!defined($fileSpec) || (
defined($fileSpec) &&
($self->{_currentFile} =~ m/$fileSpec/)
)) {
# Yes, file matches;
# Alias tag begin
$tagBegin = $tocToken->[TT_TAG_BEGIN];
# Tag and attributes match?
if (
defined($tagBegin) &&
($aTokenId =~ m/$tagBegin/) &&
HTML::TocGenerator::_doesHashContainHash(
$aTokenAttributes, $tocToken->[TT_INCLUDE_ATTRIBUTES_BEGIN], 0
) &&
HTML::TocGenerator::_doesHashContainHash(
$aTokenAttributes, $tocToken->[TT_EXCLUDE_ATTRIBUTES_BEGIN], 1
)
) {
# Yes, tag and attributes match;
# Aliases
$level = $tocToken->[TT_GROUP]{'level'};
$levelToToc = $tocToken->[TT_TOC]{options}{'levelToToc'};
$groupId = $tocToken->[TT_GROUP]{'groupId'};
$groupToToc = $tocToken->[TT_TOC]{options}{'groupToToc'};
# Must level and group be processed?
if (
($level =~ m/$levelToToc/) &&
($groupId =~ m/$groupToToc/)
) {
# Yes, level and group must be processed;
# Indicate token acts as ToC-starting-token
$result = 1;
# Start buffering until `_processTokenAsTocEndingToken' returns true
$self->{_holdTocStartToken} = $tocToken;
$self->{_holdBeginTokenType} = $aTokenType;
$self->{_holdBeginTokenAttributes} = $aTokenAttributes;
$self->{_holdBeginTokenOrig} = $$aTokenOrig;
$self->{_holdText} = '';
$self->{_holdTocText} = '';
$self->{_holdChildren} = '';
$self->{_doReleaseElement} = 0;
# Must attribute be used as ToC text?
if (defined($tocToken->[TT_ATTRIBUTES_TOC])) {
# Yes, attribute must be used as ToC text;
# # Indicate to not hold element
#$self->{_doReleaseElement} = 1;
# # Process ToC-starting-token
#$self->_processTocStartingToken(
# $tocToken, $aTokenType, $aTokenAttributes, $aTokenOrig
#);
# End attribute
$self->_processTocEndingToken($tocToken);
} else {
# No, attribute mustn't be used as ToC text;
# Add end token to 'end token array'
push(
@{$self->{_tokensTocEnd}[$tocToken->[TT_TAG_TYPE_END]]}, $tocToken
);
} # if
}
}
}
}
# Return value
return $result;
} # _processTokenAsTocStartingToken()
#--- HTML::TocGenerator::_resetBatchVariables() -------------------------------
# function: Reset variables which are set because of batch invocation.
sub _resetBatchVariables {
# Get arguments
my ($self) = @_;
# Filename of current file being parsed, empty string if not available
$self->{_currentFile} = "";
# Arrays containing start, end, comment, text & declaration tokens which
# must trigger the ToC assembling. Each array element may contain a
# reference to an array containing the following elements:
#
# TT_TAG_BEGIN => 0;
# TT_TAG_END => 1;
# TT_TAG_TYPE_END => 2;
# TT_INCLUDE_ATTRIBUTES_BEGIN => 3;
# TT_EXCLUDE_ATTRIBUTES_BEGIN => 4;
# TT_INCLUDE_ATTRIBUTES_END => 5;
# TT_EXCLUDE_ATTRIBUTES_END => 6;
# TT_GROUP => 7;
# TT_TOC => 8;
# TT_ATTRIBUTES_TOC => 9;
#
$self->{_tokensTocBegin} = [
[], # TT_TOKENTYPE_START
[], # TT_TOKENTYPE_END
[], # TT_TOKENTYPE_COMMENT
[], # TT_TOKENTYPE_TEXT
[] # TT_TOKENTYPE_DECLARATION
];
$self->{_tokensTocEnd} = [
[], # TT_TOKENTYPE_START
[], # TT_TOKENTYPE_END
[], # TT_TOKENTYPE_COMMENT
[], # TT_TOKENTYPE_TEXT
[] # TT_TOKENTYPE_DECLARATION
];
# TRUE if ToCs have been initialized, FALSE if not.
$self->{_doneInitializeTocs} = 0;
# Array of ToCs to process
$self->{_tocs} = [];
# Active anchor name
$self->{_activeAnchorName} = undef;
# Hold space for toc triggering element
# The element will be processed as soon as the element ends
$self->{_holdTocStartToken} = undef;
$self->{_holdBeginTokenType} = undef;
$self->{_holdBeginTokenAttributes} = undef;
$self->{_holdBeginTokenOrig} = undef;
$self->{_holdText} = undef;
$self->{_holdTocText} = undef;
$self->{_holdChildren} = undef;
} # _resetBatchVariables()
#--- HTML::TocGenerator::_resetStackVariables() -------------------------------
# function: Reset variables which cumulate during ToC generation.
sub _resetStackVariables {
# Get arguments
my ($self) = @_;
# Reset variables
$self->{levels} = undef;
$self->{groupIdLevels} = undef;
} # _resetStackVariables()
#--- HTML::TocGenerator::_setActiveAnchorName() -------------------------------
# function: Set active anchor name.
# args: - aAnchorName: Name of anchor name to set active.
sub _setActiveAnchorName {
# Get arguments
my ($self, $aAnchorName) = @_;
# Set active anchor name
$self->{_activeAnchorName} = $aAnchorName;
} # _setActiveAnchorName()
#--- HTML::TocGenerator::_showWarning() ---------------------------------------
# function: Show warning.
# args: - aWarningNr: Number of warning to show.
# - aWarningArgs: Arguments to display within the warning.
sub _showWarning {
# Get arguments
my ($self, $aWarningNr, $aWarningArgs) = @_;
# Local variables
my (%warnings);
# Set warnings
%warnings = (
WARNING_TOC_ATTRIBUTE_PS_NOT_AVAILABLE_WITHIN_PS() =>
"ToC attribute '%s' not available within token '%s'.",
);
# Show warning
print STDERR "warning ($aWarningNr): " . sprintf($warnings{"$aWarningNr"}, @$aWarningArgs) . "\n";
} # _showWarning()
#--- HTML::TocGenerator::afterAnchorNameBegin() ------------------------
# function: After anchor name begin processing method. Leave it up to the
# descendant to do something useful with it.
# args: - $aAnchorName
# - $aToc: Reference to ToC to which anchorname belongs.
sub afterAnchorNameBegin {
} # anchorNameBegin()
#--- HTML::TocGenerator::anchorId() -------------------------------------------
# function: Anchor id processing method. Leave it up to the descendant to do
# something useful with it.
# args: - $aAnchorId
# - $aToc: Reference to ToC to which anchorId belongs.
sub anchorId {
} # anchorId()
#--- HTML::TocGenerator::anchorNameBegin() ------------------------------------
# function: Anchor name begin processing method. Leave it up to the descendant
# to do something useful with it.
# args: - $aAnchorName
# - $aToc: Reference to ToC to which anchorname belongs.
sub anchorNameBegin {
# Get arguments
my ($self, $aAnchorName, $aToc) = @_;
return $aAnchorName;
} # anchorNameBegin()
#--- HTML::TocGenerator::anchorNameEnd() --------------------------------------
# function: Anchor name end processing method. Leave it up to the descendant
# to do something useful with it.
# args: - $aAnchorName
# - $aToc: Reference to ToC to which anchorname belongs.
sub anchorNameEnd {
} # anchorNameEnd()
#--- HTML::TocGenerator::comment() --------------------------------------------
# function: Process comment.
# args: - $aComment: comment text with '' tags stripped off.
sub comment {
# Get arguments
my ($self, $aComment) = @_;
# Bias to token not functioning as ToC-starting-token
$self->{_isTocToken} = 0;
# Must a ToC be generated?
if ($self->{_doGenerateToc}) {
# Yes, a ToC must be generated;
# Process comment as ToC-starting-token
# Is comment a ToC-starting-token?
if (! ($self->{_isTocToken} = $self->_processTokenAsTocStartingToken(
TT_TOKENTYPE_COMMENT, $aComment, undef, \$aComment
))) {
# No, comment isn't a ToC starting token;
$self->_processTocTokenChildren('');
} # if
# Process end tag as token which ends ToC registration
$self->_processTokenAsTocEndingToken(
TT_TOKENTYPE_COMMENT, $aComment
);
}
} # comment()
#--- HTML::TocGenerator::declaration() -----------------------------------------
# function: This function is called every time a declaration is encountered
# by HTML::Parser.
sub declaration {
# Get arguments
my ($self, $aDeclaration) = @_;
# Bias to token not functioning as ToC-starting-token
$self->{_isTocToken} = 0;
# Must a ToC be generated?
if ($self->{_doGenerateToc}) {
# Yes, a ToC must be generated
# Process declaration as ToC-starting-token
# Is declaration a ToC-starting-token?
if (! ($self->{_isTocToken} = $self->_processTokenAsTocStartingToken(
TT_TOKENTYPE_DECLARATION, $aDeclaration, undef, \$aDeclaration
))) {
# No, declaration isn't a ToC-starting-token
$self->_processTocTokenChildren('');
} # if
# Process end tag as token which ends ToC registration
$self->_processTokenAsTocEndingToken(
TT_TOKENTYPE_DECLARATION, $aDeclaration
);
}
} # declaration()
#--- HTML::TocGenerator::end() ------------------------------------------------
# function: This function is called every time a closing tag is encountered.
# args: - $aTag: tag name (in lower case).
# - $aOrigText: tag name including brackets.
sub end {
# Get arguments
my ($self, $aTag, $aOrigText) = @_;
# Local variables
my ($tag, $toc, $i);
# Must a ToC be generated?
if ($self->{_doGenerateToc}) {
# Yes, a ToC must be generated
# Process end tag as ToC-starting-token
$self->{_isTocToken} = $self->_processTokenAsTocStartingToken(
TT_TOKENTYPE_END, $aTag, undef, \$aOrigText
);
# Process end tag as ToC-ending-token
$self->_processTokenAsTocEndingToken(
TT_TOKENTYPE_END, $aTag
);
# Tag is of type 'anchor'?
if (defined($self->{_activeAnchorName}) && ($aTag eq "a")) {
# Yes, tag is of type 'anchor';
# Reset dirty anchor
$self->{_activeAnchorName} = undef;
}
if (! $self->{_isTocToken}) {
$self->_processTocTokenChildren($aOrigText);
} # if
}
} # end()
#--- HTML::TocGenerator::extend() ---------------------------------------------
# function: Extend ToCs.
# args: - $aTocs: Reference to array of ToC objects
# - $aString: String to parse.
sub extend {
# Get arguments
my ($self, $aTocs, $aString) = @_;
# Initialize TocGenerator batch
$self->_initializeExtenderBatch($aTocs);
# Extend ToCs
$self->_extend($aString);
# Deinitialize TocGenerator batch
$self->_deinitializeExtenderBatch();
} # extend()
#--- HTML::TocGenerator::extendFromFile() -------------------------------------
# function: Extend ToCs.
# args: - @aTocs: Reference to array of ToC objects
# - @aFiles: Reference to array of files to parse.
sub extendFromFile {
# Get arguments
my ($self, $aTocs, $aFiles) = @_;
# Initialize TocGenerator batch
$self->_initializeExtenderBatch($aTocs);
# Extend ToCs
$self->_extendFromFile($aFiles);
# Deinitialize TocGenerator batch
$self->_deinitializeExtenderBatch();
} # extendFromFile()
#--- HTML::TocGenerator::generate() -------------------------------------------
# function: Generate ToC.
# args: - $aToc: Reference to (array of) ToC object(s)
# - $aString: Reference to string to parse
# - $aOptions: optional options
sub generate {
# Get arguments
my ($self, $aToc, $aString, $aOptions) = @_;
# Initialize TocGenerator batch
$self->_initializeGeneratorBatch($aToc, $aOptions);
# Do generate ToC
$self->_generate($aString);
# Deinitialize TocGenerator batch
$self->_deinitializeGeneratorBatch();
} # generate()
#--- HTML::TocGenerator::generateFromFile() -----------------------------------
# function: Generate ToC.
# args: - $aToc: Reference to (array of) ToC object(s)
# - $aFile: (reference to array of) file to parse.
# - $aOptions: optional options
sub generateFromFile {
# Get arguments
my ($self, $aToc, $aFile, $aOptions) = @_;
# Initialize TocGenerator batch
$self->_initializeGeneratorBatch($aToc, $aOptions);
# Do generate ToC
$self->_generateFromFile($aFile);
# Deinitialize TocGenerator batch
$self->_deinitializeGeneratorBatch();
} # generateFromFile()
#--- HTML::TocGenerator::formatNumber() --------------------------------
# function: Heading number formatting method. Leave it up to the descendant
# to do something useful with it.
# args: - $aNumber
# - $aToc: Reference to ToC to which anchorname belongs.
sub formatNumber {
# Get arguments
my ($self, $aNumber, $aToc) = @_;
return $aNumber;
} # number()
#--- HTML::TocGenerator::number() ---------------------------------------------
# function: Heading number processing method. Leave it up to the descendant
# to do something useful with it.
# args: - $aNumber
# - $aToc: Reference to ToC to which anchorname belongs.
sub number {
# Get arguments
my ($self, $aNumber, $aToc) = @_;
} # number()
#--- HTML::TocGenerator::parse() ----------------------------------------------
# function: Parse scalar.
# args: - $aString: string to parse
sub parse {
# Get arguments
my ($self, $aString) = @_;
# Call ancestor
$self->SUPER::parse($aString);
} # parse()
#--- HTML::TocGenerator::parse_file() -----------------------------------------
# function: Parse file.
sub parse_file {
# Get arguments
my ($self, $aFile) = @_;
# Call ancestor
$self->SUPER::parse_file($aFile);
} # parse_file()
#--- HTML::TocGenerator::setOptions() -----------------------------------------
# function: Set options.
# args: - aOptions: Reference to hash containing options.
sub setOptions {
# Get arguments
my ($self, $aOptions) = @_;
# Options are defined?
if (defined($aOptions)) {
# Yes, options are defined; add to options
%{$self->{options}} = (%{$self->{options}}, %$aOptions);
}
} # setOptions()
#--- HTML::TocGenerator::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
# - $aTokenOrig: the original token string
sub start {
# Get arguments
my ($self, $aTag, $aAttr, $aAttrSeq, $aTokenOrig) = @_;
# Bias to token not functioning as ToC-starting-token
$self->{_isTocToken} = 0;
# Must a ToC be generated?
if ($self->{_doGenerateToc}) {
# Yes, a ToC must be generated
# Process start tag as ToC token
# Is start tag a ToC token?
if (! ($self->{_isTocToken} = $self->_processTokenAsTocStartingToken(
TT_TOKENTYPE_START, $aTag, $aAttr, \$aTokenOrig
))) {
# No, start tag isn't ToC token
$self->_processTocTokenChildren($aTokenOrig);
}
# Process end tag as ToC-ending-token
$self->_processTokenAsTocEndingToken(
TT_TOKENTYPE_START, $aTag
);
}
} # start()
#--- HTML::TocGenerator::text() -----------------------------------------------
# function: This function is called every time plain text is encountered.
# args: - @_: array containing data.
sub text {
# Get arguments
my ($self, $aText) = @_;
# Local variables
my ($text, $toc, $i, $token, $tokens);
# Must a ToC be generated?
if ($self->{_doGenerateToc}) {
# Yes, a ToC must be generated
# Are there dirty start tags?
# Loop through token types
foreach $tokens (@{$self->{_tokensTocEnd}}) {
# Loop though tokens
foreach $token (@$tokens) {
# Add text to toc
# Alias
$toc = $token->[TT_TOC];
# Add text to ToC
$self->_processTocText($aText, $toc);
# Process text inside token
$self->_processTocTokenText($aText, $toc);
}
}
}
} # text()
#=== HTML::_TokenTocParser ====================================================
# function: Parse 'toc tokens'. 'Toc tokens' mark HTML code which is to be
# inserted into the ToC.
# note: Used internally.
package HTML::_TokenTocParser;
BEGIN {
use vars qw(@ISA);
@ISA = qw(HTML::Parser);
}
END {}
#--- HTML::_TokenTocParser::new() ---------------------------------------------
# function: Constructor
sub new {
# Get arguments
my ($aType) = @_;
# Create instance
my $self = $aType->SUPER::new;
# Return instance
return $self;
} # new()
#--- HTML::_TokenTocParser::_parseAttributes() --------------------------------
# function: Parse attributes.
# args: - $aAttr: Reference to hash containing all tag attributes (in lower
# case).
# - $aIncludeAttributes: Reference to hash to which 'include
# attributes' must be added.
# - $aExcludeAttributes: Reference to hash to which 'exclude
# attributes' must be added.
# - $aTocAttributes: Reference to hash to which 'ToC attributes'
# must be added.
sub _parseAttributes {
# Get arguments
my (
$self, $aAttr, $aIncludeAttributes, $aExcludeAttributes,
$aTocAttributes
) = @_;
# Local variables
my ($key, $value);
my ($attributeToExcludeToken, $attributeToTocToken);
# Get token which marks attributes which must be excluded
$attributeToExcludeToken = $self->{_toc}{options}{'attributeToExcludeToken'};
$attributeToTocToken = $self->{_toc}{options}{'attributeToTocToken'};
# Loop through attributes
while (($key, $value) = each %$aAttr) {
# Attribute value equals 'ToC token'?
if ($value =~ m/$attributeToTocToken/) {
# Yes, attribute value equals 'ToC token';
# Add attribute to 'ToC attributes'
push @$aTocAttributes, $key;
}
else {
# No, attribute isn't 'ToC' token;
# Attribute value starts with 'exclude token'?
if ($value =~ m/^$attributeToExcludeToken(.*)/) {
# Yes, attribute value starts with 'exclude token';
# Add attribute to 'exclude attributes'
$$aExcludeAttributes{$key} = "$1";
}
else {
# No, attribute key doesn't start with '-';
# Add attribute to 'include attributes'
$$aIncludeAttributes{$key} = $value;
}
}
}
} # _parseAttributes()
#=== HTML::_TokenTocBeginParser ===============================================
# function: Parse 'toc tokens'. 'Toc tokens' mark HTML code which is to be
# inserted into the ToC.
# note: Used internally.
package HTML::_TokenTocBeginParser;
BEGIN {
use vars qw(@ISA);
@ISA = qw(HTML::_TokenTocParser);
}
END {}
#--- HTML::_TokenTocBeginParser::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::_TokenTocBeginParser::_processAttributes() -------------------------
# function: Process attributes.
# args: - $aAttributes: Attributes to parse.
sub _processAttributes {
# Get arguments
my ($self, $aAttributes) = @_;
# Local variables
my (%includeAttributes, %excludeAttributes, @tocAttributes);
# Parse attributes
$self->_parseAttributes(
$aAttributes, \%includeAttributes, \%excludeAttributes, \@tocAttributes
);
# Include attributes are specified?
if (keys(%includeAttributes) > 0) {
# Yes, include attributes are specified;
# Store include attributes
@${$self->{_lastAddedToken}}[
HTML::TocGenerator::TT_INCLUDE_ATTRIBUTES_BEGIN
] = \%includeAttributes;
}
# Exclude attributes are specified?
if (keys(%excludeAttributes) > 0) {
# Yes, exclude attributes are specified;
# Store exclude attributes
@${$self->{_lastAddedToken}}[
HTML::TocGenerator::TT_EXCLUDE_ATTRIBUTES_BEGIN
] = \%excludeAttributes;
}
# Toc attributes are specified?
if (@tocAttributes > 0) {
# Yes, toc attributes are specified;
# Store toc attributes
@${$self->{_lastAddedToken}}[
HTML::TocGenerator::TT_ATTRIBUTES_TOC
] = \@tocAttributes;
}
} # _processAttributes()
#--- HTML::_TokenTocBeginParser::_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::TocGenerator::TT_TAG_BEGIN] = $aTag;
$$tokenArray[$index][HTML::TocGenerator::TT_GROUP] = $self->{_group};
$$tokenArray[$index][HTML::TocGenerator::TT_TOC] = $self->{_toc};
} # _processToken()
#--- HTML::_TokenTocBeginParser::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::_TokenTocBeginParser::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::_TokenTocBeginParser::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, $aTokenOrig) = @_;
# Process token
$self->_processToken(HTML::TocGenerator::TT_TOKENTYPE_END, $aTag);
} # end()
#--- HTML::_TokenTocBeginParser::parse() --------------------------------------
# function: Parse begin token.
# args: - $aToken: 'toc token' to parse
sub parse {
# Get arguments
my ($self, $aString) = @_;
# Call ancestor
$self->SUPER::parse($aString);
} # parse()
#--- HTML::_TokenTocBeginParser->setGroup() -----------------------------------
# function: Set current 'tokenToToc' group.
sub setGroup {
# Get arguments
my ($self, $aGroup) = @_;
# Set current 'tokenToToc' group
$self->{_group} = $aGroup;
} # setGroup()
#--- HTML::_TokenTocBeginParser->setToc() -------------------------------------
# function: Set current ToC.
sub setToc {
# Get arguments
my ($self, $aToc) = @_;
# Set current ToC
$self->{_toc} = $aToc;
} # setToc()
#--- HTML::_TokenTocBeginParser::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::_TokenTocBeginParser::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()
#=== HTML::_TokenTocEndParser =================================================
# function: Parse 'toc tokens'. 'Toc tokens' mark HTML code which is to be
# inserted into the ToC.
# note: Used internally.
package HTML::_TokenTocEndParser;
BEGIN {
use vars qw(@ISA);
@ISA = qw(HTML::_TokenTocParser);
}
END {}
#--- HTML::_TokenTocEndParser::new() ------------------------------------------
# function: Constructor
# args: - $aType: Class type.
sub new {
# Get arguments
my ($aType) = @_;
# Create instance
my $self = $aType->SUPER::new;
# Reference to last added token
$self->{_lastAddedToken} = undef;
# Return instance
return $self;
} # new()
#--- HTML::_TokenTocEndParser::_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->{_Token}}[
HTML::TocGenerator::TT_INCLUDE_ATTRIBUTES_END
] = \%includeAttributes;
}
# Exclude attributes are specified?
if (keys(%excludeAttributes) > 0) {
# Yes, exclude attributes are specified;
# Store exclude attributes
@${$self->{_Token}}[
HTML::TocGenerator::TT_EXCLUDE_ATTRIBUTES_END
] = \%excludeAttributes;
}
} # _processAttributes()
#--- HTML::_TokenTocEndParser::_processToken() --------------------------------
# function: Process token.
# args: - $aTokenType: Type of token to process.
# - $aTag: Tag of token.
sub _processToken {
# Get arguments
my ($self, $aTokenType, $aTag) = @_;
# Update token
@${$self->{_token}}[HTML::TocGenerator::TT_TAG_TYPE_END] = $aTokenType;
@${$self->{_token}}[HTML::TocGenerator::TT_TAG_END] = $aTag;
# Indicate token type which has been processed
$self->{_lastAddedTokenType} = $aTokenType;
} # _processToken()
#--- HTML::_TokenTocEndParser::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::_TokenTocEndParser::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::_TokenTocEndParser::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::_TokenTocEndParser::parse() ----------------------------------------
# function: Parse token.
# args: - $aString: 'toc token' to parse
# - $aToken: Reference to token
# - $aTokenTypeBegin: Type of begin token
sub parse {
# Get arguments
my ($self, $aString, $aToken, $aTokenTypeBegin) = @_;
# Token argument specified?
if (defined($aToken)) {
# Yes, token argument is specified;
# Store token reference
$self->{_token} = $aToken;
}
# End tag defined?
if (! defined($aString)) {
# No, end tag isn't defined;
# Last added tokentype was of type 'start'?
if (
(defined($aTokenTypeBegin)) &&
($aTokenTypeBegin == HTML::TocGenerator::TT_TOKENTYPE_START)
) {
# Yes, last added tokentype was of type 'start';
# Assume end tag
$self->_processToken(
HTML::TocGenerator::TT_TAG_END,
@${$self->{_token}}[HTML::TocGenerator::TT_TAG_BEGIN]
);
}
}
else {
# Call ancestor
$self->SUPER::parse($aString);
}
} # parse()
#--- HTML::_TokenTocEndParser::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::_TokenTocEndParser::text() -----------------------------------------
# function: This function is called every time plain text is encountered.
# args: - @_: array containing data.
sub text {
# Get arguments
my ($self, $aText) = @_;
# Is token already created?
if (defined($self->{_lastAddedTokenType})) {
# Yes, token is already created;
# Add tag to existing token
@${$self->{_token}}[HTML::TocGenerator::TT_TAG_END] .= $aText;
}
else {
# No, token isn't created;
# Process token
$self->_processToken(HTML::TocGenerator::TT_TOKENTYPE_TEXT, $aText);
}
} # text()
#=== HTML::_AnchorNameAssembler =============================================
# function: Parse 'toc tokens'. 'Toc tokens' mark HTML code which is to be
# inserted into the ToC.
# note: Used internally.
package HTML::_AnchorNameAssembler;
#--- HTML::_AnchorNameAssembler::new() ---------------------------------
# function: Constructor
# args: - $aType: Class type.
sub new {
my $class = shift;
my $self = {};
bless ($self, $class);
# Return instance
return $self;
} # new()
1;
HTML-Toc-1.12/Toc.pod 0000755 0001750 0001750 00000154351 11170602511 013477 0 ustar freddy freddy =head1 NAME
HTML::Toc - Generate, insert and update HTML Table of Contents.
=head1 DESCRIPTION
Generate, insert and update HTML Table of Contents (ToC).
=head1 Introduction
The HTML::Toc consists out of the following packages:
HTML::Toc
HTML::TocGenerator
HTML::TocInsertor
HTML::TocUpdator
HTML::Toc is the object which will eventually hold the Table of Contents. HTML::TocGenerator does the actual generation of the ToC. HTML::TocInsertor handles the insertion of the ToC in the source. HTML::TocUpdator takes care of updating previously inserted ToCs.
HTML::Parser is the base object of HTML::TocGenerator, HTML::TocInsertor and HTML::TocUpdator. Each of these objects uses its predecessor as its ancestor, as shown in the UML diagram underneath:
+---------------------+
| HTML::Parser |
+---------------------+
+---------------------+
| +parse() |
| +parse_file() |
+----------+----------+
/_\
|
+----------+----------+ <> +-----------+
| HTML::TocGenerator + - - - - - -+ HTML::Toc |
+---------------------+ +-----------+
+---------------------+ +-----------+
| +extend() | | +clear() |
| +extendFromFile() | | +format() |
| +generate() | +-----+-----+
| +generateFromFile() | :
+----------+----------+ :
/_\ :
| :
+----------+----------+ <> :
| HTML::TocInsertor + - - - - - - - - -+
+---------------------+ :
+---------------------+ :
| +insert() | :
| +insertIntoFile() | :
+----------+----------+ :
/_\ :
| :
+----------+----------+ <> :
| HTML::TocUpdator + - - - - - - - - -+
+---------------------+
+---------------------+
| +insert() |
| +insertIntoFile() |
| +update() |
| +updateFile() |
+---------------------+
When generating a ToC you'll have to decide which object you want to use:
TocGenerator:
for generating a ToC without inserting the ToC into the source
TocInsertor:
for generating a ToC and inserting the ToC into the source
TocUpdator:
for generating and inserting a ToC, removing any previously
inserted ToC elements
Thus in tabular view, each object is capable of:
generating inserting updating
---------------------------------
TocGenerator X
TocInsertor X X
TocUpdator X X X
=head2 Generating
The code underneath will generate a ToC of the HTML headings C<