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 {
  my $orig = shift;
  my $self = shift;
  my $output = $self->$orig(@_);
  my $extras = delete $self->{__extra_ids}
    or return $output;

  # search for any of the tags we found when preprocessing
  my $match = join '|', map quotemeta, keys %$extras;
  # inject extra links for each tag found
  $output =~ s{($match)}{
    join '', $1,
      map '<a id="'.encode_entities($_).'"></a>',
      $self->id_extras(@{ $extras->{$1} });
  }ge;
  return $output;
};

sub id_extras {
  my ( $self, $t, @existing ) = @_;

  my @ids;

  # our preferred linking style, with very little filtering
  my $ours = $t;
  $ours =~ s/^\s+//;
  $ours =~ s/\s+$//;
  $ours =~ s/[\s-]+/-/g;
  push @ids, $ours;

  # first word, stripping off $self type invocants
  my ($first) = $t =~ /^\s*(?:\$\w+->)?(\w+)/;
  push @ids, $first
    if defined $first;

  # the way this id would be generated by Pod::Simple::XHTML
  my $maybe_encoded = $t;
  $maybe_encoded = encode_entities($maybe_encoded)
    if BAD_LINK_ENCODING;
  push @ids, $self->Pod::Simple::XHTML::idify($maybe_encoded, 1);

  # don't try to generate ids we've already seen
  my %s = map { $_ => 1 } @existing;

  #warn "original: $filtered_id\n";
  #warn "  adding: $_\n" for @ids;

  my $ids = $self->{ids};
  return (
    map {
      my $i = '';
      $i++ while $ids->{"$_$i"}++;
      "$_$i";
    }
    grep !$s{$_}++,
    @ids
  );
}

after reinit => sub {
  my $self = shift;
  delete $self->{__more_ids_for};
  delete $self->{__extra_ids};
};

1;
__END__

=head1 NAME

Pod::Simple::Role::XHTML::WithExtraTargets - Add additional useful link targets

=head1 SYNOPSIS

  package MyPodParser;
  with 'Pod::Simple::Role::XHTML::WithAccurateTargets';

  my $parser = MyPodParser->new;
  $parser->output_string(\my $html);
  $parser->parse_string_document($pod);

=head1 DESCRIPTION

Adds multiple link targets to rendered headings to allow more useful linking.

Many headings for functions and methods include the function signature.  This
makes linking to the headings awkward.  Link targets based on the first word
of headings will be added to make linking easier.  This form of linking is
very common when linking to sections of L<perlfunc>, allowing links like
C<< LE<lt>perlfunc/openE<gt> >>.

Also adds link targets compatible with standard L<Pod::Simple::XHTML>.

=head1 SUPPORT

See L<MetaCPAN::Pod::XHTML> for support and contact information.

=head1 AUTHORS

See L<MetaCPAN::Pod::XHTML> for authors.

=head1 COPYRIGHT AND LICENSE

See L<MetaCPAN::Pod::XHTML> for the copyright and license.

=cut
