#!/usr/bin/env perl
# html-update-toc
# Update (in place) table of contents for an HTML document.
# Michael Ernst <mernst@csail.mit.edu>
# Time-stamp: <2006-05-14 14:35:53 mernst>

# This script edits a HTML file in place to modify an existing table of
# contents.  The contents start (and end, respectively) with "<!-- start
# toc -->" and "<!-- end toc -->".  There may be extra text in the
# comments; for example,
#   <p>Contents:</p>
#   <!-- start toc.  do not edit; run html-update-toc instead -->
#   <!-- end toc -->
# To get started, just add those three lines near the top of the file.

# The table of contents contains links to header lines of the form
#   <h3><a name="key">Subheading</a></h3>
# Header lines without "<a name=...>" anchor tags are ignored (and a warning
# is generated).
# Header lines are omitted if they contain
#   <!-- omit from toc -->
# For instance, this would not appear:
#   <h1>The title of the document</h1>			<!-- omit from toc -->

# This script does not fully parse the HTML document; instead, it
# pattern-matches against specific lines in the document.  That means that
# it will generate table-of-contents lines for commented-out sections of a
# document.  To ensure that a header line doesn't appear in the table of
# contents, start a comment startss on that line, such as:
#   <!-- <h2>...</h2>  ...


# As noted above, header lines should contain anchor tags.
# Here is Emacs code to add anchor names:
#   (defun html-add-heading-anchors ()
#     "Add anchors to section headings in an HTML document."
#     (interactive)
#     (save-excursion
#       (goto-char (point-min))
#       (query-replace-regexp "^\\(<h[1-6]>\\)\\([^<>\n]*\\)\\(</h[1-6]>\\)\\s-*$"
#                             "\\1<a name=\"\\2\">\\2</a>\\3")
#       ;; now convert spaces to underscores in anchors
#       (require 'dired)
#       (goto-char (point-min))
#       (while (re-search-forward "^\\(<h[1-6]><a name=\"\\)\\([^<> \"\n]* [^<>\"\n]*\\)\\(\">\\)" nil t)
#         (let ((s1 (match-string 1))
#               (s2 (match-string 2))
#               (s3 (match-string 3)))
#           (replace-match
#            (concat s1
#                    (save-match-data (dired-replace-in-string " " "_" s2))
#                    s3)
#            nil nil)))))


use strict;
use English;
$WARNING = 1;

my $debug = 0;
# $debug = 1;

my $quiet = 0;

# read by paragraphs (remember that this is a string, not a regexp)
# (Warning: this doesn't work for DOS files, but I hack around that via
# the $contents_end regexp.)
$INPUT_RECORD_SEPARATOR = "\n\n";

# TODO:
# These regexps support backward compatibility.  As of Feb 2004, we will very
# soon require the "<!-- toc --> ... <!-- /toc -->" versions.
my $contents_start = "<!-- start (?:toc|contents)\\b[^>]*-->(?:\r?\n)?|(?:Table of )?Contents:[ \t]*(?:<!-- auto-generated by html-toc -->|<!-- do not edit; run html-update-toc -->)(?:\r?\n)?";
# Second alternative used to be "\r?\n$" to avoid grabbing too much DOS text.
my $contents_end = "<!-- end (?:toc|contents)\\b[^>]*-->|<p>([ \t]*<!-- auto-generated by html-toc -->\r?\n|\r?\n)";
my $contents_start_quoted = $contents_start;
$contents_start_quoted =~ s/\n/\\n/g;
$contents_start_quoted =~ s/\r/\\r/g;
my $contents_end_quoted = $contents_end;
$contents_end_quoted =~ s/\n/\\n/g;
$contents_end_quoted =~ s/\r/\\r/g;

FILELOOP: for my $file (@ARGV) {
  # print STDERR "Examining $file\n";
  if (($file eq "-q") || ($file eq "--quiet") || ($file eq "-quiet")) {
    $quiet = 1;
  }
  if ($file !~ /\.html?$/) {
    next;
  }
  if (! open(FILE, $file)) {
    print STDERR "Skipping $file:  can't open\n";
    next;
  }
  # Only check the first 10 paragraphs
  for (my $i=0; $i<10; $i++) {
    my $line = <FILE>;
    if (! defined($line)) {
      # past end of file
      next;
    }
    if ($debug) { print STDERR "line: $line"; }
    # ".*?" means a minimal match
    if ($line =~ /($contents_start)(.*?)($contents_end)/is) {
      my $oldcontent = $2;
      my $newcontent = `html-toc $file`;
      if ($newcontent eq "\n") {
        $newcontent = "";
      }
      if ($oldcontent eq $newcontent) {
	if (! $quiet) {
          print STDERR "$file has up-to-date table of contents\n";
        }
	close(FILE);
	next FILELOOP;
      }
      close(FILE);

      print STDERR "html-update-toc: updating $file\n";

      # I would like to just call Perl with
      #   "perl -pi.bak -e '\$/ = \"\\n\\n\"; s/($contents_start_quoted)(.*?)($contents_end_quoted)/\$1$newcontent_quoted\$3/s'"
      # but that doesn't work:  the shell says "word too long".
      rename($file,"$file.bak") or die "Can't make backup of $file";
      open(OLDFILE, "$file.bak") or die "Can't read backup I just made: $file.bak";
      open(FILE, ">$file") or die "Can't write $file; old version in $file.bak";
      while (defined($line = <OLDFILE>)) {
	$line =~ s/($contents_start)(.*?)($contents_end)/$1$newcontent$3/si;
	print FILE $line;
      }
      close(OLDFILE);
      close(FILE);
      unlink("$file.bak");

      # I could now reset the write date, but the file *has* changed,
      # so don't bother.

      next FILELOOP;
    }

  }
  # It's not clear whether this is helpful formatting or annoying.
  print STDERR "No table of contents found in $file\n";
}