From a1aeb23314ba35960d43ebb7f78bce11e1e2553f Mon Sep 17 00:00:00 2001
From: Andrew Johnson <anj@anl.gov>
Date: Fri, 3 Apr 2020 00:29:22 -0500
Subject: [PATCH] Modify POD to HTML tools to better support links

Introduce derived classes to process links the way we need them.
Unify the generation of an ID from a section heading.
---
 src/tools/EPICS/PodHtml.pm  | 46 +++++++++++++++++++++++++++++++++++++
 src/tools/EPICS/PodXHtml.pm | 21 +++++++++++++++++
 src/tools/Makefile          |  7 +++---
 src/tools/dbdToHtml.pl      |  8 +++----
 src/tools/podToHtml.pl      |  9 ++++----
 5 files changed, 80 insertions(+), 11 deletions(-)
 create mode 100644 src/tools/EPICS/PodHtml.pm
 create mode 100644 src/tools/EPICS/PodXHtml.pm

diff --git a/src/tools/EPICS/PodHtml.pm b/src/tools/EPICS/PodHtml.pm
new file mode 100644
index 000000000..ccfbe4729
--- /dev/null
+++ b/src/tools/EPICS/PodHtml.pm
@@ -0,0 +1,46 @@
+package EPICS::PodHtml;
+
+use strict;
+use warnings;
+
+use base 'Pod::Simple::HTML';
+
+# 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');
+
+        $ret = $to ? "$to.html" : '';
+        $ret .= "#$section" if $section;
+    }
+    else {
+        # all other links are generated by the parent class
+        $ret = $self->SUPER::do_pod_link($link);
+    }
+
+    return $ret;
+}
+
+# Generate the same section IDs as Pod::Simple::XHTML
+
+sub section_name_tidy {
+    my($self, $section) = @_;
+    $section =~ s/^\s+//;
+    $section =~ s/\s+$//;
+    $section =~ tr/ /-/;
+    $section =~ s/[[:cntrl:][:^ascii:]]//g; # drop crazy characters
+    $section = $self->unicode_escape_url($section);
+    $section = '_' unless length $section;
+    return $section;
+}
+
+1;
diff --git a/src/tools/EPICS/PodXHtml.pm b/src/tools/EPICS/PodXHtml.pm
new file mode 100644
index 000000000..d922c0645
--- /dev/null
+++ b/src/tools/EPICS/PodXHtml.pm
@@ -0,0 +1,21 @@
+package EPICS::PodXHtml;
+
+use strict;
+use warnings;
+
+use base 'Pod::Simple::XHTML';
+
+# Translate L<link text|filename/Section name>
+# into <a href="filename.html#Section-name">link text</a>
+
+sub resolve_pod_page_link {
+    my ($self, $to, $section) = @_;
+
+    my $ret = $to ? "$to.html" : '';
+    $ret .= '#' . $self->idify($self->encode_entities($section), 1)
+        if $section;
+
+    return $ret;
+}
+
+1;
diff --git a/src/tools/Makefile b/src/tools/Makefile
index 636717d90..26c0ed99a 100644
--- a/src/tools/Makefile
+++ b/src/tools/Makefile
@@ -2,7 +2,7 @@
 # Copyright (c) 2012 UChicago Argonne LLC, as Operator of Argonne
 #     National Laboratory.
 # EPICS BASE is distributed subject to a Software License Agreement found
-# in file LICENSE that is included with this distribution. 
+# in file LICENSE that is included with this distribution.
 #*************************************************************************
 TOP=../..
 
@@ -17,6 +17,8 @@ PERL_MODULES += EPICS/Release.pm
 PERL_MODULES += EPICS/Readfile.pm
 PERL_MODULES += EPICS/Getopts.pm
 PERL_MODULES += EPICS/macLib.pm
+PERL_MODULES += EPICS/PodHtml.pm
+PERL_MODULES += EPICS/PodXHtml.pm
 
 PERL_MODULES += DBD.pm
 PERL_MODULES += DBD/Base.pm
@@ -82,8 +84,7 @@ EXPAND += $(PKGCONFIG:%=%@)
 CLEANS += epics-base-$(T_A).pc@
 
 include $(TOP)/configure/RULES
- 
+
 epics-base-$(T_A).pc@: ../epics-base-arch.pc@
 	@$(RM) $@
 	@$(CP) $< $@
-
diff --git a/src/tools/dbdToHtml.pl b/src/tools/dbdToHtml.pl
index 7a80dec4c..afbb0a601 100644
--- a/src/tools/dbdToHtml.pl
+++ b/src/tools/dbdToHtml.pl
@@ -18,10 +18,10 @@ use EPICS::macLib;
 use EPICS::Readfile;
 
 BEGIN {
-    $::XHTML = eval "require Pod::Simple::XHTML; 1";
+    $::XHTML = eval "require EPICS::PodXHtml; 1";
     $::ENTITIES = eval "require HTML::Entities; 1";
     if (!$::XHTML) {
-        require Pod::Simple::HTML;
+        require EPICS::PodHtml;
     }
     if (!$::ENTITIES) {
         my %entities = (
@@ -130,7 +130,7 @@ my $contentType =
     '<meta http-equiv="Content-Type" content="text/html; charset=UTF-8" >';
 
 if ($::XHTML) {
-    $podHtml = Pod::Simple::XHTML->new();
+    $podHtml = EPICS::PodXHtml->new();
     $podHtml->html_doctype(<< '__END_DOCTYPE');
 <?xml version='1.0' encoding='UTF-8'?>
 <!DOCTYPE html PUBLIC '-//W3C//DTD XHTML 1.0 Transitional//EN'
@@ -152,7 +152,7 @@ __END_DOCTYPE
     }
 } else { # Fall back to HTML
     $Pod::Simple::HTML::Content_decl = $contentType;
-    $podHtml = Pod::Simple::HTML->new();
+    $podHtml = EPICS::PodHtml->new();
     $podHtml->html_css('style.css');
 
     $idify = sub {
diff --git a/src/tools/podToHtml.pl b/src/tools/podToHtml.pl
index 99ee5b426..21bf3a161 100644
--- a/src/tools/podToHtml.pl
+++ b/src/tools/podToHtml.pl
@@ -9,8 +9,11 @@
 use strict;
 use warnings;
 
+use FindBin qw($Bin);
+use lib "$Bin/../../lib/perl";
+
 use Getopt::Std;
-use Pod::Simple::HTML;
+use EPICS::PodHtml;
 
 our ($opt_o);
 
@@ -27,11 +30,9 @@ if (!$opt_o) {
 open my $out, '>', $opt_o or
     die "Can't create $opt_o: $!\n";
 
-my $podHtml = Pod::Simple::HTML->new();
+my $podHtml = EPICS::PodHtml->new();
 
 $podHtml->html_css('style.css');
-$podHtml->perldoc_url_prefix('');
-$podHtml->perldoc_url_postfix('.html');
 $podHtml->set_source($infile);
 $podHtml->output_string(\my $html);
 $podHtml->run;