Permalink
Browse files

Added ToC anchors to all headings.

Made tests pass.
  • Loading branch information...
chromatic committed Mar 17, 2012
1 parent 3603e60 commit 7f087eec5955d66cb3f1f72fe2c1ee749849989b
Showing with 23 additions and 16 deletions.
  1. +8 −2 lib/Pod/PseudoPod/DOM.pm
  2. +5 −5 t/html/basic.t
  3. +8 −7 t/html/sections.t
  4. +2 −2 t/html/tags.t
View
@@ -139,10 +139,12 @@ sub push_heading_element
sub push_link_element
{
my ($self, $class, %args) = @_;
+ my $heading = $self->{latest_heading};
my $child = $self->push_element(
- $class, heading => $self->{latest_heading}, %args
+ $class, heading => $heading, %args
);
+ $heading->anchor( $child ) if $heading and $args{type} eq 'anchor';
$self->add_link( $args{type} => $child );
}
@@ -197,7 +199,11 @@ BEGIN
my $end_meth = sub
{
my $self = shift;
- $self->reset_to_item( Heading => level => $heading );
+ my $head = $self->reset_to_item( Heading => level => $heading );
+
+ $self->start_Z;
+ $self->handle_text( $head->emit_kids( encode => 'index_anchor' ) );
+ $self->end_Z;
};
do
View
@@ -13,20 +13,20 @@ my $parser = Pod::PseudoPod::DOM->new(
isa_ok $parser, 'Pod::PseudoPod::DOM';
my $result = parse( "=head0 Narf!" );
-is $result, qq|<a name="Narf!"></a><h1>Narf!</h1>\n\n|, "head0 level output";
+like $result, qr|<a name="Narf!"></a><h1>Narf!</h1>\n\n|, "head0 level output";
$result = parse( "=head1 Poit!" );
-is $result, qq|<a name="Poit!"></a><h2>Poit!</h2>\n\n|, "head1 level output";
+like $result, qr|<a name="Poit!"></a><h2>Poit!</h2>\n\n|, "head1 level output";
$result = parse( "=head2 I think so Brain." );
-is $result, qq|<a name="IthinksoBrain."></a><h3>I think so Brain.</h3>\n\n|,
+like $result, qr|<a name="IthinksoBrain."></a><h3>I think so Brain.</h3>\n\n|,
"head2 level output";
$result = parse( "=head3 I say, Brain..." );
-is $result, qq|<a name="Isay,Brain..."></a><h4>I say, Brain...</h4>\n\n|,
+like $result, qr|<a name="Isay,Brain..."></a><h4>I say, Brain...</h4>\n\n|,
"head3 level output";
$result = parse( "=head4 Zort!" );
-is $result, qq|<a name="Zort!"></a><h5>Zort!</h5>\n\n|, "head4 level output";
+like $result, qr|<a name="Zort!"></a><h5>Zort!</h5>\n\n|, "head4 level output";
$result = parse( <<'EOPOD' );
View
@@ -33,20 +33,20 @@ like_string $result, qr!<h4>c heading</h4>!,
like_string $result, qr!<h1>Another Suppressed Heading</h1>!,
'... chapter title TOC suppression should create heading';
-unlike_string $result, qr/<a name="AnotherSuppressedHeading">/,
- '... without anchor';
+like_string $result, qr/<a name="AnotherSuppressedHeading">/,
+ '... but with anchor';
like_string $result, qr!<h2>A Suppressed Heading</h2>!,
'... section title suppression should create heading';
-unlike_string $result, qr/<a name="ASuppressedHeading">/,
- '... without anchor';
+like_string $result, qr/<a name="ASuppressedHeading">/,
+ '... but with anchor';
like_string $result, qr!<h3>Yet Another Suppressed Heading</h3>!,
'... subsection title suppression should create heading';
-unlike_string $result, qr/<a name="YetAnotherSuppressedHeading">/,
- '... without anchor';
+like_string $result, qr/<a name="YetAnotherSuppressedHeading">/,
+ '... but with anchor';
like_string $result,
qr/<pre><code>\s*&quot;This text.+--.+ \$text.&quot;\n/s,
@@ -66,7 +66,8 @@ like_string $result, qr!<ul>\s*<li>Verbatim</li>!s,
like_string $result, qr!<li>items</li>\s*</ul>!,
'... and to end';
-like_string $result, qr!rule too:</p>\s*<ul>!s;
+like_string $result, qr!rule too:</p>\s*<ul>!s,
+ 'bulleted lists need to start as unordered lists';
like_string $result, qr!<ul>\s*<li>BANG</li>!s,
'bulleted lists need itemized formatting to start';
View
@@ -14,10 +14,10 @@ use_ok( 'Pod::PseudoPod::DOM' ) or exit;
my $file = read_file( catfile( qw( t test_file.pod ) ) );
my $result = parse_with_anchors( $file );
-like_string $result, qr!^<a name="startofdocument"></a>!m,
+like_string $result, qr!<a name="startofdocument"></a>!m,
'Z<> tags should become anchors';
-like_string $result, qr!^<a name="next_heading"></a>!m,
+like_string $result, qr!<a name="next_heading"></a>!m,
'... without normal escaping';
like_string $result, qr!<a name="slightlycomplex\?heading"></a>!,

0 comments on commit 7f087ee

Please sign in to comment.