1use strict;
2use warnings;
3use Test::More;
4
5BEGIN {
6    package MyXHTML;
7    use base 'Pod::Simple::XHTML';
8
9    sub new {
10        my $class = shift;
11        my $self = $class->SUPER::new(@_);
12        $self->html_header('');
13        $self->html_footer('');
14        $self->index(1);
15        $self->anchor_items(1);
16        return $self;
17    }
18
19    sub parse_to_string {
20        my $self = shift;
21        my $pod = shift;
22        my $output = '';
23        $self->output_string( \$output );
24        $self->parse_string_document($pod);
25        return $output;
26    }
27
28    sub idify {
29        my ($self, $t, $not_unique) = @_;
30        for ($t) {
31            $t =~ s/\A\s+//;
32            $t =~ s/\s+\z//;
33            $t =~ s/[\s-]+/-/g;
34        }
35        return $t if $not_unique;
36        my $i = '';
37        $i++ while $self->{ids}{"$t$i"}++;
38        return "$t$i";
39    }
40}
41
42
43my @tests = (
44    # Pod                   id                        link (url encoded)
45    [ 'Foo',                'Foo',                    'Foo'                       ],
46    [ '$@',                 '$@',                     '%24%40'                    ],
47    [ 'With C<Formatting>', 'With-Formatting',        'With-Formatting'           ],
48    [ '$obj->method($foo)', '$obj->method($foo)',     '%24obj-%3Emethod(%24foo)'  ],
49);
50
51plan tests => 5 * scalar @tests;
52
53my $parser = MyXHTML->new;
54
55for my $names (@tests) {
56    my ($heading, $id, $link) = @$names;
57
58    is $link, $parser->encode_url($id),
59        'assert correct encoding of url fragment';
60
61    my $html_id = $parser->encode_entities($id);
62
63    {
64        my $result = MyXHTML->new->parse_to_string(<<"EOT");
65=head1 $heading
66
67L<< /$heading >>
68
69EOT
70        like $result, qr{<h1 id="\Q$html_id\E">},
71            "heading id generated correctly for '$heading'";
72        like $result, qr{<li><a href="\#\Q$link\E">},
73            "index link generated correctly for '$heading'";
74        like $result, qr{<p><a href="\#\Q$link\E">},
75            "L<> link generated correctly for '$heading'";
76    }
77    {
78        my $result = MyXHTML->new->parse_to_string(<<"EOT");
79=over 4
80
81=item $heading
82
83=back
84
85EOT
86        like $result, qr{<dt id="\Q$html_id\E">},
87            "item id generated correctly for '$heading'";
88    }
89}
90