mkanchdb

#!/usr/local/bin/perl
# Extract all the anchors that have a name of the form: "<prefix>-<name>"
# and build a database for it.
#
# Arnaud Le Hors - lehors@w3.org
# Modified by Bert Bos <bert@w3.org>
# $Id: mkanchdb,v 2.4 2006-10-09 18:55:52 ihickson Exp $

use DB_File;
use Getopt::Std;
use lib 'bin';
use utils;

$PROG = substr($0, rindex($0, "/") + 1);
$USAGE = "Usage: $PROG [-r realname] prefix dbase [file]\n";


### main

getopts('r:') || die $USAGE;
if ($#ARGV >= 0) {$prefix = $ARGV[0]; shift;} else {die $USAGE;}
if ($#ARGV >= 0) {$dbase = $ARGV[0]; shift;} else {die $USAGE;}
if ($#ARGV >= 0) {$file = $ARGV[0]; shift;} else {$file = '-';}
if ($#ARGV >= 0) {die $USAGE;}

$hfil = defined $opt_r ? $opt_r : $file;

dbmopen(%anchors, $dbase, 0666) || die "$PROG: cannot open database $dbase\n";

my $buf = readfile($file);	# Read file
$buf =~ s/<!--.*?-->//sgio;	# Remove comments

# Loop over all anchors, store them in database, prefixed with filename
while ($buf =~ /(?:<a\s+[^>]*?\bname|<[^>]*\bid)\s*=\s*[\"\']?($prefix[^\s\"\'>]+)[\"\']?.*?>/sio) {
    $buf = $';
    $anch = "$hfil#$1";
    if (($anchors{$1} ne "") && ($anchors{$1} ne $anch)) {
	warn "$PROG: duplicated index \"$1\":
\t\"$anchors{$1}\" and \"$anch\"";
    }
    $anchors{$1} = $anch;
}