mkidx

#!/usr/local/bin/perl

use DB_File;
#use Getopt::Std;

$PROG = substr($0, rindex($0, "/") + 1);
$USAGE = "Usage: $PROG indexdb [output]\n";

@indent = ('  ','    ','      ','        ');


sub cmp_entry {
    $terms_a = lc($a);
    $terms_b = lc($b);
    $terms_a =~ s/\&[a-z#0-9]+;?//sio;
    $terms_b =~ s/\&[a-z#0-9]+;?//sio;
    $terms_a =~ s/^[^a-z0-9\@:=]+//sio;
    $terms_b =~ s/^[^a-z0-9\@:=]+//sio;
    return $terms_a cmp $terms_b;
}

if ($#ARGV >= 0) {$db = $ARGV[0]; shift;} else {die $USAGE;}
if ($#ARGV >= 0) {$output = $ARGV[0]; shift;} else {$output = '-';}
if ($#ARGV >= 0) {die $USAGE;}

dbmopen(%index, $db, 0666) || die "$PROG: cannot open database $db\n;";
open(OUTPUT, ">$output") || die "$PROG: cannot create file $output\n";

# Slurp it all into memory, and sort...
@sorted = sort cmp_entry (values %index);

# Write it out
@prev = ('', '', '', '', '', '');
$prevletter = '`';
#print OUTPUT "<ul class=\"index\">";
$lvl = 0;			# Number of open <ul>'s
$seqno = 1;			# Number within an entry
foreach $e (@sorted) {
    ($entry, $prefix, $class, $anchor) = split(/\t/, $e);
    @subs = split(/::/, $entry);

    # Check to what level this entry is the same as the last one
    # Entry is the same up to and including level i-1
    $i = 0;
    while (($i <= $#subs) && ($subs[$i] eq $prev[$i])) {$i++;}

    # If not completely the same, reset $seqno, else increment
    if ($i != $lvl) {$seqno = 1;} else {$seqno++;}

    # Close lists to the required level
    while ($lvl > $i + 1) {
	$lvl--;
	print OUTPUT "\n$indent[$lvl-1]</ul>";
    }

    # If new first letter, insert an anchor
    if ($lvl <= 1) {
	$letter = $subs[0];
	$letter =~ s/\&[a-z\#0-9]+;?//sio;
	$letter =~ s/^[^a-z0-9\@:]+//sio;
	$letter = lc(substr($letter, 0, 1));
	if ($letter && $letter ne $prevletter) {
	    if ($lvl == 1) {
		print OUTPUT "\n</ul>";
		$lvl--;
	    }
	    print OUTPUT "\n<p>";
	    # Note: The magic autoincrement for letters does not
	    #       work on non-alphanumeric!
	    foreach (ord($prevletter)+1 .. ord($letter)) {
		# Be careful about quotes and double quotes.
	        # Also skip uppercase, since we have
	        # sorted case-insensitively.
		unless ($_ == 34 || $_ == 38 || $_ == 39
			|| (ord('A') <= $_ && $_ <= ord('Z'))) {
		    print OUTPUT "<a name=\"index-" . chr($_) . "\">&nbsp;</a>";
		}
	    }
	    print OUTPUT "\n<ul class=\"index\">";
	    $prevletter = $letter;
	    $lvl++;
	}
    }

    # Write the subterms that are different
    for ($j = $i; $j <= $#subs; $j++) {
	if ($lvl <= $j) {
	    print OUTPUT "\n$indent[$lvl-1]<ul class=\"index\">";
	    $lvl++;
	    $seqno = 1;		# Reset seqno if more levels than before
	}
	print OUTPUT "\n$indent[$j]<li>$subs[$j]";
    }

    # Link to given anchor
    my $s = $entry;
    $s =~ s/::/, /go;
    $s =~ s/"/\&quot;/go;
    print OUTPUT ", <a href=\"$prefix#$anchor\" title=\"$s\" ";
    if ($class eq 'index-def') {
	print OUTPUT "class=\"index-def\"><strong>$seqno</strong>";
    } else {
	print OUTPUT "class=\"index-inst\"><span>$seqno</span>";
    }
    print OUTPUT "</a>";

    for ($j = 0; $j <= $#subs; $j++) {$prev[$j] = $subs[$j];}
    $prev[$j] = '';
}
while ($lvl > 0) {
    print OUTPUT "\n</ul>";
    $lvl--;
}
#print OUTPUT "\n</ul>\n";

close(OUTPUT);