#!/usr/bin/env perl
|
|
|
|
use strict;
|
|
use warnings;
|
|
no warnings 'uninitialized';
|
|
use 5.14.0;
|
|
use utf8;
|
|
|
|
use open qw(:std :utf8);
|
|
|
|
use Carp;
|
|
use Mojo::DOM;
|
|
|
|
my $input;
|
|
{
|
|
# line separator:
|
|
local $/ = undef;
|
|
$input = <>;
|
|
}
|
|
|
|
my $entry = '';
|
|
if (exists $ENV{'WRT_ENTRY'}) {
|
|
$entry = $ENV{'WRT_ENTRY'};
|
|
}
|
|
|
|
my @headers;
|
|
my $dom;
|
|
|
|
eval {
|
|
local $SIG{__WARN__} = sub { die; };
|
|
$dom = Mojo::DOM->new($input);
|
|
};
|
|
if ($@) {
|
|
carp("Parsing issues for $input: $@");
|
|
}
|
|
|
|
eval {
|
|
local $SIG{__WARN__} = sub { die; };
|
|
$dom = Mojo::DOM->new($input);
|
|
};
|
|
if ($@) {
|
|
carp("Parsing issues for $entry $@");
|
|
}
|
|
|
|
my $entry_toc_id = "${entry}-toc";
|
|
my $toc = Mojo::DOM->new("<p>Contents</p> <ul id=${entry_toc_id}></ul>");
|
|
|
|
foreach my $e ($dom->find('h1, h2, h3, h4, h5, h6')->each) {
|
|
my $header_id = make_header_id($entry, $e->text);
|
|
$e->attr->{id} = $header_id;
|
|
$toc->at('ul')->append_content('<li><a href="#' . $header_id . '">' . $e->text . "</a></li>\n");
|
|
}
|
|
|
|
print "${toc}" . "${dom}";
|
|
|
|
sub make_header_id {
|
|
my ($prefix, $text) = @_;
|
|
$text =~ s/[^a-z0-9]+/-/g;
|
|
return $prefix . '-' . $text;
|
|
}
|