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