File Coverage

blib/lib/Pod/Simple/Role/XHTML/RepairLinkEncoding.pm
Criterion Covered Total %
statement 12 12 100.0
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 16 16 100.0


line stmt bran cond sub pod time code
1             package Pod::Simple::Role::XHTML::RepairLinkEncoding;
2 2     2   814 use Moo::Role;
  2         4  
  2         10  
3              
4             our $VERSION = '0.003000';
5             $VERSION =~ tr/_//d;
6              
7 2     2   577 use HTML::Entities qw(decode_entities encode_entities);
  2         4  
  2         110  
8 2     2   382 use URL::Encode qw(url_encode_utf8);
  2         4119  
  2         81  
9              
10 2     2   10 use namespace::clean;
  2         16  
  2         14  
11              
12             around resolve_pod_page_link => sub {
13             my $orig = shift;
14             my $self = shift;
15             local $self->{__resolving_link} = 1;
16             $self->$orig(@_);
17             };
18              
19             around end_item_text => sub {
20             my $orig = shift;
21             my $self = shift;
22             local $self->{__in_end_item_text} = 1;
23             $self->$orig(@_);
24             };
25              
26             around _end_head => sub {
27             my $orig = shift;
28             my $self = shift;
29             local $self->{__in_end_head} = 1;
30             $self->$orig(@_);
31             my $index_entry = $self->{'to_index'}[-1];
32              
33             # the index entry added by default has the id of the link target, and uses
34             # it directly as a URL fragment. we need to re-encode it to a proper form.
35             $index_entry->[1] = encode_entities(
36             url_encode_utf8( decode_entities( $index_entry->[1] ) ) );
37             };
38              
39             around idify => sub {
40             my $orig = shift;
41             my $self = shift;
42             my ($text, $not_unique) = @_;
43              
44             $text = decode_entities($text)
45             if $self->{__in_end_item_text} || $self->{__in_end_head};
46             $text =~ s/<[^>]+>//g
47             if $self->{__in_end_item_text};
48              
49             my $id = $self->$orig($text, $not_unique);
50              
51             $id = url_encode_utf8($id)
52             if $self->{__resolving_link};
53              
54             $id = encode_entities($id);
55             return $id;
56             };
57              
58             1;
59             __END__