66 lines
1.7 KiB
Perl
66 lines
1.7 KiB
Perl
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;
|