view release on metacpan or  search on metacpan

lib/Pod/Simple/Role/XHTML/WithExtraTargets.pm  view on Meta::CPAN

package Pod::Simple::Role::XHTML::WithExtraTargets;
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 Pod::Simple::XHTML ();

use constant BAD_LINK_ENCODING => !defined &Pod::Simple::XHTML::decode_entities;

use namespace::clean;

with qw(Pod::Simple::Role::XHTML::WithPostProcess);

# we're using around to ensure proper ordering when combined with
# RepairLinkEncoding
around _end_head => sub {
  my $orig = shift;
  my $self = shift;
  my $link_text = $self->{htext};
  my $filtered_id = $self->idify($link_text, 1);

  # old Pod::Simple::XHTML
  if (BAD_LINK_ENCODING) {
    # will be encoded, but without formatting
    $link_text = decode_entities($link_text);
    $filtered_id = decode_entities($filtered_id);
  }

  $self->{__more_ids_for} = [ $link_text, $filtered_id ];
  $self->$orig(@_);
};

around end_item_text => sub {
  my $orig = shift;
  my $self = shift;
  if ( $self->{anchor_items} ) {
    my $link_text = BAD_LINK_ENCODING ? $self->{scratch} : $self->{itext};
    my $filtered_id = $self->idify($link_text, 1);

    # old Pod::Simple::XHTML
    if (BAD_LINK_ENCODING) {
      # will be encoded, but also include tags
      $link_text =~ s/<[^>]+>//g;
      $link_text = decode_entities($link_text);
      $filtered_id = decode_entities($filtered_id);
    }

    $self->{__more_ids_for} = [ $link_text, $filtered_id ];
  }
  $self->$orig(@_);
};

after pre_process => sub {
  my ($self, $content) = @_;
  if (my $for = delete $self->{__more_ids_for}) {
    # match the first tag in the content being added. this will contain the
    # primary id to use for links, so it should be unique. we'll be searching
    # for it later to add the additional link targets.
    my ($tag) = $content =~ /(<\w[^>]*>)/s;
    if ($tag && $tag =~ /id=/) {
      $self->{__extra_ids}{$tag} = $for;
    }
  }
};

around post_process => sub {