#!/usr/bin/perl

# ls ../tests-ttl/*.ttl | grep -v bad | grep -v manifest | xargs ./coverage > report.html

use strict;
my ($Vol, $Dir);
BEGIN {
    # Use File::Spec to tweak @INC to look for turtleAwesome in the $0 dir.
    use File::Spec;
    ($Vol, $Dir, $_) = File::Spec->splitpath($0);
    push(@INC, $Dir);
}

use constant HTML => 1;
use constant WRITE_TESTS => 1;
use constant DEBUG => 0;
use constant ESCAPE => '回';
use turtleAwesome;
use XML::XPath;
use XML::XPath::XMLParser;
use XML::LibXML::XPathContext;
use CGI;
use Data::Dumper;

sub turtleToXML {
    my ($turtle) = @_;
    &utf8::decode($turtle);
    my $parser = turtleAwesome->new();
    my $text = $parser->parse($turtle)->toXML('', { '' => 'http://www.w3.org/2005/01/yacker/uploads/turtleAwesome/', 'yacker' => 'http://www.w3.org/2005/01/yacker/'});
    return $text;
}

sub noNamespaces {
    my ($turtleXML) = @_;
    $turtleXML =~ s{ xmlns="http://www.w3.org/2005/01/yacker/uploads/turtleAwesome/"}{};
    $turtleXML =~ s{ xmlns:yacker="http://www.w3.org/2005/01/yacker/"}{};
    $turtleXML =~ s{yacker:}{}g;
    # $turtleXML =~ s/\x08/&#8;/g;
    return $turtleXML;
}

sub lowEscape {
    my ($xmlish) = @_;
    # $xmlish =~ s/([\x00-\x08\x0b-\x0c\x0e-\x1f])/'回'.sprintf("%02x", ord($1))/eg;
    $xmlish =~ s/([\x00-\x09\x0b-\x1f])/ESCAPE.sprintf("%02x", ord($1))/eg;    
    return $xmlish;
}

sub unescape {
    my ($str, $lineno) = @_;
    $str =~ s/\$/\\\$/g;
    $str =~ s/\@/\\\@/g;
    # print "$lineno: $str\n";
    $str = eval ('"'.$str.'"');
    if ($@) {
	die "error at $lineno: \"$str\" got $@";
    }
    return $str;
}

sub HTMLescape {
    my ($str) = @_;
    $str =~ s/&/&amp;/g;
    $str =~ s/</&lt;/g;
    $str =~ s/>/&gt;/g;
    $str =~ s/"/&quot;/g;
    return $str;
}

sub utf8encode {
    my ($str) = @_;
    utf8::encode($str);
    return $str;
}

sub writeFile {
    my ($name, $content) = @_;
    open(OUT, ">$name") || die "unable to open \"$name\" for writing\n";
    print OUT &utf8encode($content);
    close OUT;
}

sub main {
    my (@paths, @tests, %turtleNames, %ntriplesNames, $manifestOrder, $manifestEntries, $listTSV);
    my $pathspec = File::Spec->catpath($Vol, $Dir, 'paths');
    open(PATHS, $pathspec) || die "unable to open \"$pathspec\" for reading\n";
    my $lineno = 0;
    my ($thead, $tests) = HTML ? ("<th>file</th>", "") : (undef, undef);

    if (HTML) {
	print "<!DOCTYPE html>
<html content='en' property='dcterms:language' about='' dir='ltr' xmlns='http://www.w3.org/1999/xhtml' lang='en'>
  <head>
    <title>Turtle</title>
    <meta http-equiv='Content-Type' content='text/html; charset=UTF-8'/>
    <style type='text/css'>
th { vertical-align: bottom; border-right: 1px solid black; font-size: smaller; }
pre999 { background-color: #eef; display:table; border: .1em solid #dde; margin-left: 1em; margin-top: -1.1em; }
pre.turtle { background-color: #eef; float:left; border: .1em solid #dde; margin-left: 1em; margin-top: -1.1em; }
pre.ntriples { background-color: #efe; float:left; border: .1em solid #ded; margin-left: 1em; margin-top: -1.1em; }
.clear { clear:both; }
.n { background-color: #fee; }
.y { color: #eef; }
.y a { text-decoration: none; }
.missing { color: red; }
.total { font-size: smaller; }
#box { display: none; position: fixed; background-color: white; padding: 1ex; border: 1px solid black; }
    </style>
    <script type='text/javascript'>
<!--
var win2;
var cache = new Array();
function writeit(element, path) {
    if (!!cache[path]) {
       // console.log('cache hit');
       element.textContent = cache[path];
       return;
    }

    var xhr = new XMLHttpRequest();

    xhr.onreadystatechange = function () {
      if (this.readyState == 4
          && this.status == 200) {    
	element.textContent = cache[path] = this.responseText;
        // console.log('GET ' + path + ': ' + this.responseText);
      }
    };
    try {
      xhr.open('GET', path, true);
      xhr.send(null);
    } catch (e) {
      element.textContent = e;
    }
}
function coveragePopup(event) {
  // console.log('coveragePopup ' + event.target.href.substr(event.target.href.indexOf('#')+1));
  var thebox = document.getElementById('box');
  var fragid = event.target.href.substr(event.target.href.indexOf('#')+1);
  var featureElement = document.getElementById(fragid);

  var featureDiv = document.createElement('div');
  featureDiv.appendChild(featureElement.firstChild.cloneNode(true));
  featureDiv.appendChild(featureElement.firstChild.nextSibling.cloneNode(true));

  thebox.replaceChild(featureDiv, thebox.firstChild);
  var absoluteURI = event.target.parentNode.parentNode.querySelector('a');
  featureDiv.nextSibling.nextSibling.textContent = ''; // clear out debris while waiting for download
  writeit(featureDiv.nextSibling.nextSibling, absoluteURI.href);

  thebox.style.display = 'block';

  var rect = event.target.getBoundingClientRect();
  width = document.body.getBoundingClientRect().width;
  if (rect.left > width/2)
    thebox.style.left = (rect.left - thebox.getBoundingClientRect().width - 4) + 'px';
  else
    thebox.style.left = (rect.left+15) + 'px';
  thebox.style.top = (rect.top-10) + 'px';

}
function redundantPopup(event) {
  // console.log('redundantPopup ' + event.target.href.substr(event.target.href.indexOf('#')+1));
  var thebox = document.getElementById('box');
  var h2 = document.createElement('h2');
  h2.textContent = event.target.href;
  thebox.replaceChild(h2, thebox.firstChild);
  // thebox.firstChild.firstChild.textContent = event.target.href;
  thebox.firstChild.nextSibling.nextSibling.textContent = '';
  writeit(thebox.firstChild.nextSibling.nextSibling, event.target.href);

  thebox.style.display = 'block';

  var rect = event.target.getBoundingClientRect();
  width = document.body.getBoundingClientRect().width;
  if (rect.left > width/2)
    thebox.style.left = (rect.left - thebox.getBoundingClientRect().width - 4) + 'px';
  else
    thebox.style.left = (rect.left+15) + 'px';
  // console.log('rect.top: ' + rect.top + 'rect.height: ' + (thebox.getBoundingClientRect().height));
  thebox.style.top = (rect.top-thebox.getBoundingClientRect().height) + 'px';

}
function popdown() {
  var thebox = document.getElementById('box');
  thebox.style.display = 'none';
  // console.log('popdown' + event);
}
//-->
    </script>
  </head>

  <body style='display: inherit;'>
    <div id='box'><p>x</p><h2>on test</h2><pre>asdf</pre></div>
    <h1>feature coverage in existing tests:</h1>
";
    }
    foreach my $line (<PATHS>) {
	++$lineno;
	$line =~ s{(?<!\\)#.*}{};
	next if ($line =~ m/^\s*$/);
	my ($name, $path, $turtle, $ntriples) = split(/\t+/, $line);
	&utf8::decode($name);
	my $id = $name;
	$id =~ s/ /_/g;
	$id =~ s/-/_/g;
	$id =~ s/[^a-zA-Z0-9_].*//;
	$id =~ s/_$//;

	chomp($path);
	$path = unescape($path, $lineno);

	chomp($turtle);
	$turtle = unescape($turtle."\n", $lineno);

	chomp($ntriples);
	$ntriples = unescape($ntriples."\n", $lineno);

	if (WRITE_TESTS && !exists $turtleNames{$turtle}) {
	    # create a new test.
	    $turtleNames{$turtle} = $id;
	    &writeFile("tests/$id.ttl", $turtle);

	    if (!exists $ntriplesNames{$ntriples}) {
		# create a new ntriples file.
		$ntriplesNames{$ntriples} = $id;
		&writeFile("tests/$id.nt", $ntriples);
	    }
	    $manifestOrder .= "    <#$id>\n";
	    $name =~ s/\\/\\\\/g;
	    $name =~ s/\"/\\\"/g;
	    $manifestEntries .= "<#$id> rdf:type rdft:TestTurtleEval ;
   mf:name    \"$id\" ;
   rdfs:comment \"$name\" ;
   mf:action    <$id.ttl> ;
   mf:result    <$ntriplesNames{$ntriples}.nt> ;
   .

";

	    $listTSV .= "$id\t$id.ttl\t$ntriplesNames{$ntriples}.nt\n";
	}
	    
	eval {
	    my $turtleText = &lowEscape(&noNamespaces(&turtleToXML($turtle)));
	    my $xp = XML::LibXML->load_xml(string => $turtleText);
	    my $matches = $xp->find($path)->size();
	    if ($matches != 1) {
		my $s = join("\n--\n", map {$_->toString()} @{$xp->find($path)});
		print STDERR "$lineno: $name - $matches matches: $s\n";
	    }

	    push (@paths, [$name, $path, $lineno, $id, $turtle, $ntriples]);
	    if (HTML) {
		$tests .= "    <div id='$id'>"
		    . "<h2>" . &HTMLescape($name) . "</h2>"
		    . "<pre class='turtle'>" . &HTMLescape($turtle) . "</pre>"
		    . "<pre class='ntriples'>" . &HTMLescape($ntriples) . "</pre>"
		    . "<div class='clear'/>"
		    . "</div>\n";
		my $stacked = join('<br />', map { &HTMLescape($_) } split(//, $name));
		$thead .= "<th><a href='#$id'>$stacked</a></th>";
	    }
	}; if ($@) {
	    print STDERR "$lineno: skipping \"$name\" because $@\n";
	}
    }

    if (WRITE_TESTS) {
	&writeFile("tests/manifest.ttl", "# Turtle atomic test manifest

\@prefix rdf:    <http://www.w3.org/1999/02/22-rdf-syntax-ns#> .
\@prefix rdfs:    <http://www.w3.org/2000/01/rdf-schema#> .
\@prefix mf: <http://www.w3.org/2001/sw/DataAccess/tests/test-manifest#> .
\@prefix rdft:   <http://www.w3.org/ns/rdftest#> .

<>  rdf:type mf:Manifest ;
    rdfs:comment \"Atomic Turtle tests\" ;
    mf:entries
    (
" . $manifestOrder . "    ) .

" . $manifestEntries);
	&writeFile("list.tsv", $listTSV);
    }

    my %coverage;
    my %tests;
    my %grouped;
    if (HTML) {
	print "    <table>\n      <thead>\n        <tr>".&utf8encode($thead)."</tr>\n      </thead>\n      <tbody>\n";
    }
    foreach my $file (@ARGV) {
	&testFile($file, \@paths, \%coverage, \%tests, \%grouped);
    }
    if (HTML) {
	print "        <tr><td class='total'>", scalar @ARGV, "</td>";
    foreach my $pathPair (@paths) {
	my ($name, $path, $lineno, $id, $exturtle) = @$pathPair;
	if (!exists $coverage{$name}) {
	    print "<td class='missing'><a href='#$id'>0</a></td>";
	} else {
	    print "<td class='total'><a href='#$id'>" . scalar @{$coverage{$name}} . "</a></td>";
	}
    }
	print "</tr>\n";
	print "      </tbody>\n    </table>\n";
    }

#    print Dumper(%coverage);

    # Aspects missing from coverage.
    print "    <h1>missing features</h1>\n    <ul>\n" if (HTML);
    foreach my $pathPair (@paths) {
	my ($name, $path, $lineno, $id, $exturtle) = @$pathPair;
	if (!exists $coverage{$name}) {
	    print HTML ? "      <li><a href='#$id'>".&HTMLescape(&utf8encode($name))."</a><p></p><pre>".&HTMLescape($exturtle)."</pre></li>\n" : "no $name\n";
	}
    }
    print "    </ul>\n" if (HTML);

    # Apparently redundant tests.
    print "    <h1>redundant tests</h1>\n    <ul>\n" if (HTML);
    foreach my $bits (keys %grouped) {
	my @same = @{$grouped{$bits}};
	if (@same > 1) {
	    print HTML ? "      <li>\n	" : "equivalent tests: ";
	    for (my $i = 0; $i < @same; ++$i) {
		if ($i != 0) {
		    print ' ';
		}
		print HTML ? "<a href='$same[$i]' onmouseover='redundantPopup(event);' onmouseout='popdown();'>$same[$i]</a>" : "$same[$i]";
	    }
	    print HTML ? "\n	<ul>\n" : "\n";

	    for (my $row = 0; $row < @paths; ++$row) {
		if (vec($bits, $row, 1)) {
		    my ($name, $path, $lineno, $id) = @{$paths[$row]};
		    print HTML ? "          <li><a href='#$id'>".&HTMLescape(&utf8encode($name))."</a></li>\n" : " - - $name\n"
		}
	    }
	    print HTML ? "	</ul>\n      </li>\n" : "";
	}
    }
    print "    </ul>\n" if (HTML);
    if (HTML) {
	print "<h1 id='tests'>Facets</h1>\n".&utf8encode($tests)."\n  </body>\n</html>\n"
    }
}

sub testFile {
    my ($file, $pathList, $coverage, $tests, $grouped) = @_;

    # print "$file\n";
    open(TTL, $file) || die "unable to open input $file: $!\n";
    local $/ = undef;
    my $text = &lowEscape(&noNamespaces(&turtleToXML(<TTL>)));
    close (TTL);
    my $bits;

    # my $xp = XML::XPath->new(xml => $text);
    my $xp = XML::LibXML->load_xml(string => $text);
    print "      <tr><td class='file'><a href='$file'>$file</a></td>" if (HTML);
    for (my $row = 0; $row < @$pathList; ++$row) {
	my ($name, $path, $lineno, $id) = @{$pathList->[$row]};
	print "testing path \"$path\" on --\n$text\n--\n" if (DEBUG);
	my $nodeset = $xp->find($path);
	my $size = $nodeset->size();
	if ($size > 0) {
	    print "<td class='y'><a href='#$id' onmouseover='coveragePopup(event);' onmouseout='popdown();'>$size</a></td>";
	    vec($bits, $row, 1) = 1;
	    foreach my $node ($nodeset->get_nodelist()) {
		# push (@{$coverage->{$name}}, XML::XPath::XMLParser::as_string($node));
		push (@{$coverage->{$name}}, $node->to_literal);
	    }
	} elsif (HTML) {
	    print "<td class='n'> </td>";
	}
    }
    print "</tr>\n" if (HTML);
    $tests->{$file} = $bits;
    push (@{$grouped->{$bits}}, $file);
}


# print turtlePath("<http://example/s> <http://example/p> '''ab\ncd''' .", "//String");
&main;

### debugging toys ###

sub tryPath {
    my ($xp, $path) = @_;
    # return join("\n--\n", map {XML::XPath::XMLParser::as_string($_)} @{$xp->find($path)});
    return join("\n--\n", map {$_->toString()} @{$xp->find($path)});
}

sub turtlePath {
    my ($turtle, $path) = @_;
    my $text = noNamespaces(turtleToXML($turtle));
    # my $xp = XML::XPath->new(xml => $text);
    my $xp = XML::LibXML->load_xml(string => $text);
    return tryPath($xp, $path);
}

__END__

