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

package Pod::Simple::Role::XHTML::RepairLinkEncoding;
use Moo::Role;

our $VERSION = '0.003002';
$VERSION =~ tr/_//d;

use HTML::Entities qw(decode_entities encode_entities);
use URL::Encode qw(url_encode_utf8);

use namespace::clean;

around resolve_pod_page_link => sub {
  my $orig = shift;
  my $self = shift;
  local $self->{__resolving_link} = 1;
  $self->$orig(@_);
};

around end_item_text => sub {
  my $orig = shift;
  my $self = shift;
  local $self->{__in_end_item_text} = 1;
  $self->$orig(@_);
};

around _end_head => sub {
  my $orig = shift;
  my $self = shift;
  local $self->{__in_end_head} = 1;
  $self->$orig(@_);
  my $index_entry = $self->{'to_index'}[-1];

  # the index entry added by default has the id of the link target, and uses
  # it directly as a URL fragment. we need to re-encode it to a proper form.
  $index_entry->[1] = encode_entities(
    url_encode_utf8( decode_entities( $index_entry->[1] ) ) );
};

around idify => sub {
  my $orig = shift;
  my $self = shift;
  my ($text, $not_unique) = @_;

  $text = decode_entities($text)
    if $self->{__in_end_item_text} || $self->{__in_end_head} || $self->{__resolving_link};
  $text =~ s/<[^>]+>//g
    if $self->{__in_end_item_text};

  my $id = $self->$orig($text, $not_unique);

  $id = url_encode_utf8($id)
    if $self->{__resolving_link};

  $id = encode_entities($id);
  return $id;
};

1;
__END__