chkprops

#!/usr/local/bin/perl
# Check validity of property instances in sepc.
# Ian Jacobs - ij@w3.org
# $Id: chkprops,v 1.6 2007-04-16 12:43:46 bbos Exp $

$PROGNAME = substr($0, rindex($0, "/") + 1);
if ($#ARGV < 1) {
    warn "Usage: $PROGNAME propdb prefix file1 file2 ...\n";
    exit 1;
} else {
    $propdb = $ARGV[0];
    shift;
    $prefix = $ARGV[0];
    shift;
}


$blockst = "[/][*]";
$blocket = "[*][/]";
sub readpropdb {
    if (!open(DBASE, $_[0])) {
	warn "$PROGNAME Error: Cannot open dbfile: $_[0]\n";
	return;
    }
    $dbbuf = "";
    while (<DBASE>) {
	$dbbuf .= $_;
    }
    $_ = $dbbuf;
    while (/$blockst\s*([\w-\s]+)\s*;;.*?$blocket/so) {
	$placeholder = $';
	foreach $prop (split(/[, \t\n]+/, $1)) {
	    $prop =~ s/^\s+//;
	    # Initialize each property to "False"
	    $propdb{$prop} = "False";
	}
	$_ = $placeholder;
    }
}


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

readpropdb($propdb);
foreach $file (@ARGV) {
    print STDOUT "Checking $file\n";
    if (readfile($file)) {
	$_ = $buf;
	while (/<span\s*\bclass\s*=\s*(?:\"$prefix-([^\"]+)\"|$prefix-([^\s>]+))\s*>(.*?)<\/span>/sio) {
	    $continue = $';
	    # One of $1 and $2 will be non-empty.
	    $propkey = "$1$2";
	    $content = "$3";
	    if ( ! (exists $propdb{$propkey}) ) {
		warn "Undefined name $propkey in $file\n";
	    } else {
		# This key is referenced from the spec, so set to true
		$propdb{$propkey} =~ s/False/True/si;
	    }
	    if ( $content !~ /\s*'$propkey'\s*/ ) {
		warn "$PROGNAME:$file:1:1:W: Content of SPAN is \"$content\" but should be \"'$propkey'\"\n";
	    }
	    $_ = $continue;
	}
    }
}

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

while ($key = each %propdb) {
    if ($propdb{$key} eq "False") {
	print STDOUT "No instances of property $key in document\n";
    }
}