package EPICS::PodHtml;

use strict;
use warnings;

use base 'Pod::Simple::HTML';

sub encode_entities {
    my ($self, $str) = @_;
    my %entities = (
        q{>} => 'gt',
        q{<} => 'lt',
        q{'} => '#39',
        q{"} => 'quot',
        q{&} => 'amp'
    );
    my $ents = join '', keys %entities;
    $str =~ s/([$ents])/'&' . $entities{$1} . ';'/ge;
    return $str;
}

# Translate L<link text|filename/Section name>
# into <a href="filename.html#Section-name">link text</a>

sub do_pod_link {
    # EPICS::PodHtml object and Pod::Simple::PullParserStartToken object
    my ($self, $link) = @_;

    my $ret;

    # Links to other EPICS POD files
    if ($link->tagname eq 'L' and $link->attr('type') eq 'pod') {
        my $to = $link->attr('to');
        my $section = $link->attr('section');
        $section = $self->section_escape($section)
            if defined $section and length($section .= ''); # (stringify)

        $ret = (defined $to and length $to) ? "$to.html" : '';
        $ret .= "#$section" if defined $section and length $section;
    }
    else {
        # all other links are generated by the parent class
        $ret = $self->SUPER::do_pod_link($link);
    }

    return $ret;
}

# Generate legal section IDs

sub section_name_tidy {
    my($self, $t) = @_;
    for ($t) {
        s/<[^>]+>//g;            # Strip HTML.
        s/&[^;]+;//g;            # Strip entities.
        s/^\s+//; s/\s+$//;      # Strip white space.
        s/^([^a-zA-Z]+)$/pod$1/; # Prepend "pod" if no valid chars.
        s/^[^a-zA-Z]+//;         # First char must be a letter.
        s/[^-a-zA-Z0-9_:.]+/-/g; # All other chars must be valid.
        s/[-:.]+$//;             # Strip trailing punctuation.
    }
    return $t;
}

1;