mktoc

#! /usr/bin/perl

# Update a TOC in a .md file.  The TOC has to be under a headline that collapses into
# an anchor that is 'table-of-contents'.
#
# This only understands '#' headline format.

use strict;
use warnings;

my $skip = 0;
my $in_place = 0;

sub anchor($)
{
    my ($k) = @_;
    $k =~ s(/)()g;
    $k =~ s/[^0-9a-z_]+/-/gi;
    $k =~ s/^-//;
    $k =~ s/-$//;
    return lc($k);
}

sub insert_toc($)
{
    my ($fn) = @_;

    # load:
    my @sec = ('');
    open(my $f, '<', $fn) or die "Error: $fn: $@\n";
    my $pre = 0;
    while (<$f>) {
        if ($pre) {
            if (/^```/) {
                $pre = 0;
            }
        }
        else {
            if (/^```/) {
                $pre = 1;
            }
            elsif (/^#/) {
                push @sec,'';
            }
        }
        $sec[-1] .= $_;
    }
    close $f;

    # make toc:
    my $toc = '';
    for my $sec (@sec) {
        if ($sec =~ /^(#+)([^#].*)\n/) {
            my ($i,$h) = ($1,$2);
            $h =~ s/^\s+//;
            $h =~ s/\s+$//;
            my $k = anchor($h);
            my $l = length($i);
            if ($l > $skip) {
                $toc .= ('    ' x ($l - $skip - 1))."  * [$h](#$k)\n";
            }
        }
    }

    # replace toc:
    my $change = 0;
    for my $sec (@sec) {
        if ($sec =~ /^(#+([^#].*))\n/) {
            my ($h, $k) = ($1, anchor($2));
            if ($k eq 'table-of-contents') {
                my $new_sec = "$h\n\n$toc\n";
                if ($sec ne $new_sec) {
                    $sec = $new_sec;
                    $change = 1;
                }
            }
        }
    }

    # do not save unless there was a change:
    return unless $change;

    # save:
    open(my $g, '>', "$fn.new") or die "Error: $fn.new: $@\n";
    for my $sec (@sec) {
        print {$g} $sec;
    }
    close $g;

    # rename:
    if ($in_place) {
        rename("$fn.new", "$fn") or die "Error: $fn.new -> $fn: $@\n";
    }
}

my @file = ();
for my $arg (@ARGV) {
    if ($arg =~ /^-/) {
        if ($arg =~ /^-+skip([0-6])$/) {
            $skip = $1;
        }
        elsif ($arg =~ /^-+in-place$/) {
            $in_place = 1;
        }
        else {
            die "Error: '$arg': unrecognised option\n";
        }
    }
    else {
        push @file, $arg;
    }
}

for my $file (@file) {
    insert_toc($file);
}