pod2html-tobyink.pl

#!/usr/bin/env perl

use 5.010;
use strict;
use warnings;   

use HTML::HTML5::Parser;
use HTML::HTML5::Writer;
use Pod::Simple;
use Syntax::Highlight::Engine::Kate;
use XML::LibXML::PrettyPrint;
use XML::LibXML::QuerySelector;

package Pod::Simple::HTML::MetaCPAN
{
	use base 'Pod::Simple::HTML';
	sub new
	{
		my $class = shift;
		my $self  = $class->SUPER::new(@_);
		$self->perldoc_url_prefix('https://metacpan.org/module/');
		return $self;
	}
}

my $hl = Syntax::Highlight::Engine::Kate->new(
	language      => 'Perl',
	substitutions => {
		"<"          => "&lt;",
		"&"          => "&amp;",
	},
	format_table  => {
      Alert => ["<span style=\"color:#0000ff\">", "</span>"],
      BaseN => ["<span style=\"color:#007f00\">", "</span>"],
      BString => ["<span style=\"color:#c9a7ff\">", "</span>"],
      Char => ["<span style=\"color:#ff00ff\">", "</span>"],
      Comment => ["<span style=\"color:#7f7f7f\"><i>", "</i></span>"],
      DataType => ["<span style=\"color:#0000ff\">", "</span>"],
      DecVal => ["<span style=\"color:#00007f\">", "</span>"],
      Error => ["<span style=\"color:#ff0000\"><b><i>", "</i></b></span>"],
      Float => ["<span style=\"color:#00007f\">", "</span>"],
      Function => ["<span style=\"color:#007f00\">", "</span>"],
      IString => ["<span style=\"color:#ff0000\">", ""],
      Keyword => ["<b>", "</b>"],
      Normal => ["", ""],
      Operator => ["<span style=\"color:#ffa500\">", "</span>"],
      Others => ["<span style=\"color:#b03060\">", "</span>"],
      RegionMarker => ["<span style=\"color:#96b9ff\"><i>", "</i></span>"],
      Reserved => ["<span style=\"color:#9b30ff\"><b>", "</b></span>"],
      String => ["<span style=\"color:#ff0000\">", "</span>"],
      Variable => ["<span style=\"color:#0000ff\"><b>", "</b></span>"],
      Warning => ["<span style=\"color:#0000ff\"><b><i>", "</b></i></span>"],
	},
);
$hl->listAdd(functions => qw< say state given when fc >);
$hl->listAdd(operators => qw< // ~~ >);

my $markup = do
{
	my $tmp;
	my $p = Pod::Simple::HTML::MetaCPAN->new;
	$p->output_string(\$tmp);
	$p->parse_file(shift);
	$tmp;
};

my $dom = HTML::HTML5::Parser->load_html(string => $markup);

$dom->querySelectorAll('a[name]')->foreach(sub
{
	$_->setNodeName('span');
	%$_ = ();
});

$dom->querySelectorAll('pre')->foreach(sub
{
	my $pre = $_;
	my $highlighted = $hl->highlightText($pre->textContent);
	$pre->removeChild($_) for $pre->childNodes;
	$highlighted =~ s{\b(say|state|given|when|fc)\b}{<b>$1</b>}g;
	$pre->appendWellBalancedChunk($highlighted);
	
	# Fix inadvertantly highlighted keywords within strings.
	for my $span ($pre->getChildrenByTagName('span'))
	{
		for ($span->getChildrenByTagName('b'))
		{
			/(?:say|state|given|when|fc)/ and $_->setNodeName('span');
		}
	}
});

$_->parentNode->removeChild($_) for $dom->findnodes('//comment()');

print HTML::HTML5::Writer
	-> new(polyglot => 1)
	-> document(
		XML::LibXML::PrettyPrint
			-> new_for_html
			-> pretty_print($dom)
	);