csswg-drafts/css2/bin/chkrefs at 72acb70bf145f3d455bcac730a1325b69265d827 · 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
#!/usr/local/bin/perl
# sub TOC builder
#
# Arnaud Le Hors - lehors@w3.org
# $Id: chkrefs,v 1.4 2006-10-09 18:55:52 ihickson Exp $


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

if ($#ARGV < 1) {
    print STDERR "Usage: $PROGNAME refdb file1 file2 ...\n";
    exit 1;
} else {
    $refdb = $ARGV[0];
    shift;
}

# copy file in memory
sub readdb {
    # Keys in rdbase{} are reference keys (e.g., HTML40).
    $rdbase = {};
    $buf = "";
    if (!open(DBASE, $_[0])) {
	print STDERR "$PROGNAME Error: Cannot open file: $_[0]\n";
	return;
    }
    while (<DBASE>) {
	chop;
	($key, $data) = split(";", $_, 2);
	$rdbase{$key} = $data . ";False";
    }
    close(DBASE);
}

# 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);
}

# read reference database
$anchorpre="ref-";
$pattern = "(href=\"[^#>]*#$anchorpre([^\" ]*)\"[ \t\n]*(class=\"[^\"]*\")?).[^>]*?>";

readdb($refdb);
foreach $file (@ARGV) {
    print STDOUT "Checking $file\n";
    if (readfile($file)) {
	$_ = $buf;
	while (/$pattern/sio) {
	    $continue = $';
	    $refkey  = uc($2);
	    if ( ! (exists $rdbase{$refkey}) ) {
		print STDERR "Undefined reference $refkey in $file\n";
	    } else {
		# This key is referenced from the spec, so set to true
		$rdbase{$refkey} =~ s/False/True/si;
	    }
	    $_ = $continue;
	}
    }
}

# For each key in the hash table, see if used in the spec.

while ($key = each %rdbase) {
    ($anchor, $reffile, $norm, $referenced) = split (";", $rdbase{$key});
    if ($referenced eq "False") {
	if ($norm eq "informref") {
	    print STDOUT "No instances of $key\n";
	} else {
	    print STDOUT "WARNING: No instance of normative $key\n";
	}
    }
}