#!/usr/bin/perl

# jan grant, 2002-04 (for the W3C)
# Quick and dirty, like all my Perl, with good reason:
# @{$$ isn't syntax, it's what I said when dealing with
# perl's notion of "data structures".
# XSLT would probably be simpler - but this can be used
# to drive scripts that run cases, rather than just
# outputting markup.

require "skeleton/readManifest.pl";

my $ALL;
my $PEND;
my $fn = "testCaseTable.html";

if ($ARGV[0] eq "all") {
	$ALL = 1;
	$fn = "allTestCases.html";
	$PEND = 0;
} elsif ($ARGV[0] eq "pend") {
	$ALL = 0;
	$PEND = 1;
} else {
	$ALL = 0;
	$PEND = 0;
}

print "Reading manifest file:\n";
my %tests = readManifest();
print "Done, there are ", scalar keys %tests, " tests defined\n";

my %issues = ();
my $approved = 0;

my $NONE = '-no issue-';

my $RULE_RDF = 'http://www.w3.org/1999/02/22-rdf-syntax-ns#';
my $RULE_RDFS = 'http://www.w3.org/2000/01/rdf-schema#';
my $RULE_DT = 'http://www.w3.org/2000/10/rdf-tests/rdfcore/datatypes#';
my $DT_XSD = 'http://www.w3.org/2001/XMLSchema#';
my $DT_RDF = 'http://www.w3.org/1999/02/22-rdf-syntax-ns#';
my $RDF_TEST = 'http://www.w3.org/2000/10/rdf-tests/rdfcore/';

my $noissapp = 0;
my $noiss = 0;
my $issapp = 0;
my $iss = 0;
my $numtcs = 0;

foreach $testname ( keys %tests ) {

	#print "Processing test $testname\n";

	$test = $tests{$testname};

	# comment this out to produce the full list.
	if ($$test{status} ne 'APPROVED') {
		if ($$test{status} eq 'PENDING' and $PEND) {
			# do nothing
		} else {
			print STDERR "Skipping test $testname, its status is $$test{status}\n";
			next unless $ALL;
		}
	} else {
		$approved ++;
	}
	$numtcs ++;

	#print "Checking name = ", $$test{name}, "\n";
	@iss = @{$$test{issues}};
	if (scalar @iss == 0) {
		push @{$issues{$NONE}}, $testname;
		if ($$test{status} eq 'APPROVED') { $noissapp ++; }
		$noiss ++;
	}
	foreach $is (@iss) {
		#print "Issue: $is\n";
		push @{$issues{$is}}, $testname;
		if ($$test{status} eq 'APPROVED') { $issapp ++; }
		$iss ++;
	}

}

my $nissues = (scalar keys %issues) - (exists $issues{$NONE});

sub bleah($) {
	my ($uri) = @_;
	my ($w) = ($uri);

	if ($uri !~ /^http:/) {
		return $uri;
	}
	if ($uri =~ m|^http://www.w3.org/2000/10/rdf-tests/rdfcore/(.*)$| ) {
		$w = $1;
	}

	return "<a href=\"$uri\">$w</a>";
}

%approvals = (
	"http://lists.w3.org/Archives/Public/w3c-rdfcore-wg/2003Oct/0071.html" => "RDFCore Telecon 2003-10-03",
	"http://lists.w3.org/Archives/Public/w3c-rdfcore-wg/2003Sep/0093.html" => "RDFCore Telecon 2003-09-05",
	"http://lists.w3.org/Archives/Public/w3c-rdfcore-wg/2003Sep/0003.html" => "RDFCore Telecon 2003-08-29",
	"http://lists.w3.org/Archives/Public/www-rdf-comments/2003AprJun/0080.html" => "Editorial fix for issue PFPS-10",
	"http://lists.w3.org/Archives/Public/w3c-rdfcore-wg/2003Aug/0138.html" => "RDFCore Telecon 2003-08-08",
	"http://lists.w3.org/Archives/Public/w3c-rdfcore-wg/2003Jul/0263.html" => "RDFCore Telecon 2003-07-18",
	"http://lists.w3.org/Archives/Public/w3c-rdfcore-wg/2003Jan/0025.html" => "RDFCore Telecon 2003-01-10",
	"http://lists.w3.org/Archives/Public/w3c-rdfcore-wg/2002Nov/0611.html" => "RDFCore Telecon 2002-11-22",
	"http://lists.w3.org/Archives/Public/w3c-rdfcore-wg/2002Oct/0131.html" => "RDFCore Telecon 2002-10-11",
	"http://lists.w3.org/Archives/Public/w3c-rdfcore-wg/2002Jun/0034.html" => "RDFCore Telecon 2002-06-07",
    "http://lists.w3.org/Archives/Public/w3c-rdfcore-wg/2002May/0159.html" => "RDFCore Telecon 2002-05-31",
	"http://lists.w3.org/Archives/Public/w3c-rdfcore-wg/2002May/0028.html" => "RDFCore Telecon 2002-05-03",
	"http://lists.w3.org/Archives/Public/w3c-rdfcore-wg/2002Apr/0474.html" => "RDFCore Telecon 2002-04-26",
	"http://lists.w3.org/Archives/Public/w3c-rdfcore-wg/2002Apr/0406.html" => "RDFCOre Telecon 2002-04-19",
	"http://lists.w3.org/Archives/Public/w3c-rdfcore-wg/2002Apr/0166.html" => "RDFCore Telecon 2002-04-12",
	"http://lists.w3.org/Archives/Public/w3c-rdfcore-wg/2002Apr/0056.html" => "RDFCore Telecon 2002-04-05",
	"http://lists.w3.org/Archives/Public/w3c-rdfcore-wg/2002Apr/0008.html" => "RDFCore Telecon 2002-03-22",
	"http://lists.w3.org/Archives/Public/w3c-rdfcore-wg/2002Mar/0235.html" => "RDFCore Telecon 2002-03-15",
	"http://lists.w3.org/Archives/Public/w3c-rdfcore-wg/2002Mar/0125.html" => "RDFCore Telecon 2002-03-08",
	"http://www.w3.org/2001/sw/RDFCore/20020225-f2f/" => "RDFCore Face-to-face, Feb 2002",
	"http://lists.w3.org/Archives/Public/w3c-rdfcore-wg/2002Feb/0656.html" => "RDFCore Telecon 2002-02-22",
	"http://lists.w3.org/Archives/Public/w3c-rdfcore-wg/2002Feb/0476.html" => "RDFCore Telecon 2002-02-15",
	"http://lists.w3.org/Archives/Public/w3c-rdfcore-wg/2002Feb/0263.html" => "RDFCore Telecon 2002-02-08",
	"http://lists.w3.org/Archives/Public/w3c-rdfcore-wg/2002Feb/0010.html" => "RDFCore Telecon 2002-02-01",
	"http://lists.w3.org/Archives/Public/w3c-rdfcore-wg/2002Jan/0428.html" => "RDFCore Telecon 2002-01-25",
	"http://lists.w3.org/Archives/Public/w3c-rdfcore-wg/2002Jan/0152.html" => "RDFCore Telecon 2002-01-18",
	"http://lists.w3.org/Archives/Public/w3c-rdfcore-wg/2002Jan/0095.html" => "RDFCore Telecon 2002-01-11",
	"http://lists.w3.org/Archives/Public/w3c-rdfcore-wg/2001Dec/0108.html" => "RDFCore Telecon 2001-12-14",
	"http://lists.w3.org/Archives/Public/w3c-rdfcore-wg/2001Dec/0089.html" => "RDFCore Telecon 2001-12-07",
	"http://lists.w3.org/Archives/Public/w3c-rdfcore-wg/2001Nov/0651.html" => "RDFCore Telecon 2001-11-30",
	"http://lists.w3.org/Archives/Public/w3c-rdfcore-wg/2001Nov/0561.html" => "RDFCore Telecon 2001-11-16",
	"http://lists.w3.org/Archives/Public/w3c-rdfcore-wg/2001Nov/0294.html" => "RDFCore Telecon 2001-11-09",
	"http://lists.w3.org/Archives/Public/w3c-rdfcore-wg/2001Nov/0036.html" => "RDFCore Telecon 2001-11-02",
	"http://lists.w3.org/Archives/Public/w3c-rdfcore-wg/2001Oct/0581.html" => "RDFCore Telecon 2001-10-26",
	"http://lists.w3.org/Archives/Public/w3c-rdfcore-wg/2001Oct/0405.html" => "RDFCore Telecon 2001-10-19",
	"http://lists.w3.org/Archives/Public/w3c-rdfcore-wg/2001Oct/0249.html" => "RDFCore Telecon 2001-10-12",
	"http://lists.w3.org/Archives/Public/w3c-rdfcore-wg/2001Oct/0005.html" => "RDFCore Telecon 2001-09-28",
	"http://lists.w3.org/Archives/Public/w3c-rdfcore-wg/2001Sep/0326.html" => "RDFCore Telecon 2001-09-21",
	"http://lists.w3.org/Archives/Public/w3c-rdfcore-wg/2001Sep/0180.html" => "RDFCore Telecon 2001-09-14",
	"http://lists.w3.org/Archives/Public/w3c-rdfcore-wg/2001Sep/0120.html" => "RDFCore Telecon 2001-09-07",
	"http://lists.w3.org/Archives/Public/w3c-rdfcore-wg/2001Aug/0255.html" => "RDFCore Telecon 2001-08-31",
	"http://lists.w3.org/Archives/Public/w3c-rdfcore-wg/2001Aug/0149.html" => "RDFCore Telecon 2001-08-24",
	"http://lists.w3.org/Archives/Public/w3c-rdfcore-wg/2001Aug/0141.html" => "RDFCore Telecon 2001-08-17",
	"http://www.w3.org/2001/sw/RDFCore/20010801-f2f/" => "RDFCore Face-to-face, August 2001",
	"http://lists.w3.org/Archives/Public/w3c-rdfcore-wg/2001Aug/0065.html" => "RDFCore Telecon 2001-07-27",
	"http://lists.w3.org/Archives/Public/w3c-rdfcore-wg/2001Jul/0267.html" => "RDFCore Telecon 2001-07-20",
	"http://lists.w3.org/Archives/Public/w3c-rdfcore-wg/2001Jul/0148.html" => "RDFCore Telecon 2001-07-13",
	"http://lists.w3.org/Archives/Public/w3c-rdfcore-wg/2001Jul/0052.html" => "RDFCore Telecon 2001-07-06",
	"http://lists.w3.org/Archives/Public/w3c-rdfcore-wg/2001Jul/0000.html" => "RDFCore Telecon 2001-06-29",
	"http://lists.w3.org/Archives/Public/w3c-rdfcore-wg/2001Jun/0422.html" => "RDFCore Telecon 2001-06-22",
	"http://lists.w3.org/Archives/Public/w3c-rdfcore-wg/2001Jun/0471.html" => "RDFCore Telecon 2001-06-15",
	"http://lists.w3.org/Archives/Public/w3c-rdfcore-wg/2001Jun/0109.html" => "RDFCore Telecon 2001-06-08",
	"http://lists.w3.org/Archives/Public/w3c-rdfcore-wg/2001Jun/0008.html" => "RDFCore Telecon 2001-06-01",
	"http://lists.w3.org/Archives/Public/w3c-rdfcore-wg/2001May/att-0195/01-rdfc25May.html" => "RDFCore Telecon 2001-05-25",
	"http://www.w3.org/2000/11/mr76/rdfc25May.html" => "RDFCore Telecon 2001-05-25",
	"http://lists.w3.org/Archives/Public/w3c-rdfcore-wg/2001May/0122.html" => "RDFCore Telecon 2001-05-18",
	"http://lists.w3.org/Archives/Public/w3c-rdfcore-wg/2001May/att-0060/01-2001-05-11.html" => "RDFCore Telecon 2001-05-11",
	"http://lists.w3.org/Archives/Public/w3c-rdfcore-wg/2001May/att-0017/01-2001-04-27.html" => "RDFCore Telecon 2001-04-27",
);

sub approval($) {
	my ($test) = @_;
	my ($uri) = ($$test{approval});
	my ($d) = $uri;

	if (not defined $uri or $$test{status} ne 'APPROVED') {
		return "Status: $$test{status}";
	}

	if (exists($approvals{$uri})) {
		$d = $approvals{$uri};
	}

	return "<a href=\"$uri\">$d</a>";
}

sub rules($$) {
	my ($rrules, $rdt) = @_;

	my @rules = sort @$rrules;
	my @dts = sort @$rdt;
	if ((scalar @rules) == 0) { return "Simple"; }
	my ($rdf, $rdfs, $dt);

	foreach my $i (@rules) {
		if ($i eq $RULE_RDF) { $rdf = 1; }
		if ($i eq $RULE_RDFS) { $rdfs = 1; }
		if ($i eq $RULE_DT) { $dt = 1; }
    }

	my $rules = "";

	if ($rdf) {
		$rules = "+ RDF ";
	}
	if ($rdfs) {
		$rules .= "+ RDFS ";
	}
	if ($dt) {
		$rules .= "+ DT(";
		my $d = "";
		foreach my $dt (@dts) {
			if (substr($dt, 0, length($DT_XSD)) eq $DT_XSD) {
				$d .= ", xsd:" . substr($dt, length($DT_XSD));
			} elsif (substr($dt, 0, length($DT_RDF)) eq $DT_RDF) {
				$d .= ", rdf:" . substr($dt, length($DT_RDF));
			} else {
				$d .= ", " . $dt;
			}
		}
		$rules .= substr($d, 2);
		$rules .= ") ";
	}

	return substr($rules, 2);
}

print "There are $nissues issues containing $issapp approved test cases, and $noissapp test cases without an associated issue:\n";

foreach $is ( sort keys %issues ) {

	print "Issue: $is has ", scalar @{$issues{$is}}, " tests\n";

	foreach $testname (sort @{$issues{$is}}) {
		print "  $testname\n";
	}

}

print "Producing table...\n";

open (TABLE, ">$fn") or die "Can't open $fn";

if ($ALL) {
print TABLE <<"__END";
<table border="1" class="tcList">
<caption>There are $nissues issues containing $iss test cases (of which $issapp are approved), and
	$noiss test cases without an associated issue (of which $noissapp are approved).
	Relative URLs listed in this table should be resolved against the base URI http://www.w3.org/2000/10/rdf-tests/rdfcore/</caption>
__END
} else {
print TABLE <<"__END";
<table border="1" class="tcList">
<caption>There are $nissues issues containing $issapp approved test cases, and $noissapp test cases without an associated issue.
	Relative URLs listed in this table should be resolved against the base URI http://www.w3.org/2000/10/rdf-tests/rdfcore/</caption>
__END
}

foreach $is ( sort keys %issues ) {

	$ntc = scalar @{$issues{$is}};

	if ($is eq $NONE) {
	print TABLE <<"__END";
  <tr><th colspan="8" style="background-color:lightgrey; text-align:left">Test cases without an issue: $ntc tests</th></tr>
__END
	} else {
		if ($is =~ /^(.*#)(.*)$/) {
			$short = $2;
		} else {
			$short = $is;
		}
	print TABLE <<"__END";
  <tr><th colspan="8" style="background-color:lightgrey; text-align:left"><a name="$short">Issue:</a> <a href="$is">$short</a> has $ntc tests</th></tr>
__END
	}

	my @ppt = ();	# positive parser tests
	my @npt = ();	# negative parser tests
	my @pet = ();	# positive entailment tests (all)
	my @net = ();	# negative entailment tests (all)
	my @misct = ();	# miscellaneous tests

	foreach $testname (sort @{$issues{$is}}) {
		$test = $tests{$testname};

		if ($$test{type} eq "test:PositiveParserTest") {
			push @ppt, $testname;
		} elsif ($$test{type} eq "test:NegativeParserTest") {
			push @npt, $testname;
		} elsif ($$test{type} eq "test:PositiveEntailmentTest") {
			push @pet, $testname;
		} elsif ($$test{type} eq "test:NegativeEntailmentTest") {
			push @net, $testname;
		} elsif ($$test{type} eq "test:MiscellaneousTest") {
			push @misct, $testname;
		} else {
			print "WARNING! Can't produce HTML for test $testname: unrecognised type\n";
		}
	}

	if (scalar @ppt > 0) {
		$nppt = scalar @ppt;
		print TABLE <<"__END";
  <tr><th colspan="8" style="text-align:left">Positive parser tests (test cases: $nppt)</th></tr>
  <tr><th colspan="3">Input files</th><th colspan="3">Output file</th><th>Warning?</th><th>Approved</th></tr>
__END
		foreach $testname (@ppt) {

			$test = $tests{$testname};

			print TABLE "  <tr><td colspan=\"3\">";

			foreach $in (sort @{$$test{inputDocs}}) {
				print TABLE bleah(${$in}{where}), " ";
			}

			print TABLE "</td><td colspan=\"3\">", bleah(${$$test{outputDoc}}{where}), "</td><td>";
			print TABLE (defined($$test{warn}) ? $$test{warn} : "&nbsp;");
			print TABLE "</td><td>", approval($test), "</td></tr>\n";

		} # foreach $testname (@ppt)
	} # if (scalar @ppt)

	if (scalar @npt > 0) {
		$nnpt = scalar @npt;
		print TABLE <<"__END";
  <tr><th colspan="8" style="text-align:left">Negative parser tests (test cases: $nnpt)</th></tr>
  <tr><th colspan="7">Input file</th><th>Approved</th></tr>
__END
		foreach $testname (@npt) {

			$test = $tests{$testname};

			print TABLE "  <tr><td colspan=\"7\">", bleah(${$$test{inputDoc}}{where});
			print TABLE "</td><td>", approval($test), "</td></tr>\n";

		} # foreach $testname (@npt)
	} # if (scalar @npt)

	if (scalar @pet > 0) {
		$n = scalar @pet;
		print TABLE <<"__END";
  <tr><th colspan="8" style="text-align:left">Positive Entailment tests (test cases: $n)</th></tr>
  <tr><th colspan="2">Rules</th><th colspan="2">Premise files</th><th colspan="2">Conclusion file</th><th>Warning?</th><th>Approved</th></tr>
__END
		foreach $testname (@pet) {

			$test = $tests{$testname};

			print TABLE "  <tr><td colspan=\"2\">";

			# Figure out entailment rules to use.
			my @rules = sort @{$$test{entailmentRules}};
			my @dts = sort @{$$test{datatypeSupport}};
            print TABLE rules(\@rules,\@dts);

			print TABLE "</td><td colspan=\"2\">";

			foreach $in (sort @{$$test{premiseDocs}}) {
				print TABLE bleah(${$in}{where});
			}

			print TABLE "</td><td colspan=\"2\">", bleah(${$$test{conclusionDoc}}{where}), "</td><td>";
			print TABLE (defined($$test{warn}) ? $$test{warn} : "&nbsp;");
			print TABLE "</td><td>", approval($test), "</td></tr>\n";

		} # foreach $testname (@pet)
	} # if (scalar @pet)

	if (scalar @net > 0) {
		$n = scalar @net;
		print TABLE <<"__END";
  <tr><th colspan="8" style="text-align:left">Negative Entailment tests (test cases: $n)</th></tr>
  <tr><th colspan="2">Rules</th><th colspan="2">Premise files</th><th colspan="2">Conclusion file</th><th>Warning?</th><th>Approved</th></tr>
__END
		foreach $testname (@net) {

			$test = $tests{$testname};

			print TABLE "  <tr><td colspan=\"2\">";

			# Figure out entailment rules to use.
			my @rules = sort @{$$test{entailmentRules}};
			my @dts = sort @{$$test{datatypeSupport}};
            print TABLE rules(\@rules,\@dts);

			print TABLE "</td><td colspan=\"2\">";

			foreach $in (sort @{$$test{premiseDocs}}) {
				print TABLE bleah(${$in}{where});
			}

			print TABLE "</td><td colspan=\"2\">", bleah(${$$test{conclusionDoc}}{where}), "</td><td>";
			print TABLE (defined($$test{warn}) ? $$test{warn} : "&nbsp;");
			print TABLE "</td><td>", approval($test), "</td></tr>\n";

		} # foreach $testname (@net)
	} # if (scalar @net)

	if (scalar @misct > 0) {
		$n = scalar @misct;
		print TABLE <<"__END";
  <tr><th colspan="8" style="text-align:left">Miscellaneous tests (test cases: $n)</th></tr>
  <tr><th colspan="7">Related documents</th><th>Approved</th></tr>
__END
		foreach $testname (@misct) {

			$test = $tests{$testname};

			print TABLE "  <tr><td colspan=\"7\">";

			foreach $in (sort @{$$test{docs}}) {
				print TABLE bleah(${$in}{where}), " ";
			}

			print TABLE "</td><td>", approval($test), "</td></tr>\n";

		} # foreach $testname (@misct)
	} # if (scalar @misct)


}


print TABLE <<"__END";
</table>
__END

close(TABLE);

