#!/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 "";
$lvl = 0; # Number of open '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]
";
}
# 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
";
$lvl--;
}
print OUTPUT "\n";
# 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 " ";
}
}
print OUTPUT "\n
";
$prevletter = $letter;
$lvl++;
}
}
# Write the subterms that are different
# class="tocline*" directs our patched html2ps to omit the bullet
for ($j = $i; $j <= $#subs; $j++) {
if ($lvl <= $j) {
print OUTPUT "\n$indent[$lvl-1]";
$lvl--;
}
#print OUTPUT "\n
\n";
close(OUTPUT);