csswg-drafts/css2/bin/mkanchdb at 396a3e911fac1d7220b743ac83e09f3b1ac783b6 · w3c/csswg-drafts · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
#!/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
# $Id: mkanchdb,v 1.2 1997-11-20 23:56:46 ian Exp $

$PROGNAME = substr($0, rindex($0, "/") + 1);

if (!$ARGV[0] || !$ARGV[1]) {
    print "Usage: $PROGNAME prefix dbase src1 src2 ...\n";
    exit 1;
} else {
    $prefix = $ARGV[0];
    shift;
    $dbasef = $ARGV[0];
    shift;
}

# copy file in memory
sub readfile {
    $buf = "";
    if (!open(INPUT, $_[0])) {
	print STDERR "$PROGNAME Error: Cannot open file: $_[0]\n";
	return;
    }
    while (<INPUT>) {
	$buf .= $_;
    }
    close(INPUT);
}

# store anchor
sub addanchor {
    if ($anchors{$_[0]}) {
	print STDERR "$PROGNAME Warning: duplicated index: \"$_[0]\" found both @\n";
	print STDERR "\t    $anchors{$_[0]}\n";
	print STDERR "\tand $_[1]\n";
    } else {
	$anchors{$_[0]} = $_[1];
    }
}

$sp = "[ \t\n]*";               # space
$ws = "[ \t\n]+";               # word separator
# look for index anchors
$banchorp = "<a(?:$ws)name=$sp";
$eanchorp = ".*?>";
# non quoted name
$namep = "$prefix-([^\"][^ \t\n>]+)";
# quoted name
$qnamep = "\"$prefix-([^\"]+)\"";
sub seekanchors {
    $_ = $buf;
    while (/$banchorp$namep$eanchorp/sio) {
	addanchor($1, "$file#$prefix-$1");
	$_ = $';
    }
    $_ = $buf;
    while (/$banchorp$qnamep$eanchorp/sio) {
	addanchor($1, "$file#$prefix-$1");
	$_ = $';
    }
}


### main

# search for all the anchors
@anchors = ();
foreach $file (@ARGV) {
    readfile($file);
    seekanchors();
}

# print out database
if (!open(DBASE, "> $dbasef")) {
    print STDERR "$PROGNAME Error: Cannot open dbfile: $dbasef\n";
} else {
    foreach $key (sort(keys %anchors)) {
	print DBASE "$key;$anchors{$key}\n";
    }
    close(DBASE);
}