use strict;
use warnings;
use JSON;
use File::Find qw(finddepth);
use Encode qw(decode);

#### START OF GLOBAL VARS

my $fh;  # Output file handle
my $imgDirectory = 'C:/Users/Owner/My Website/img/covers';
my $respJsonData;
my @unknownIDs = ();
my @unknownFields = ();
my @mismatchedTags = ();
my @missingFields = ();
my @badFields = ();
my @warnings = ();
my @emptyFieldsByType = ();
my @emptyFieldsByWork = ();
my @missingFors = ();
my @aboutTodos = ();

#### END OF GLOBAL VARS

#### START OF MAIN PROGRAM ####
# For each .json file, analyze it. Then make your report.

my $gameJsonData = loadJson("../IFIndexer/gamejson.txt");
my @files = <./json/*.json>;
foreach my $file (@files) {
	$respJsonData = loadJson($file);
	analyzeJson($file);
}
makeQCPages();

#### END OF MAIN PROGRAM ####

sub loadJson {
   my $inname = $_[0];
   my $jsondata = '';
   open(my $jinfh, "<", $inname) || die("can't open $inname: $!");
   print "*** reading $inname ... ";
   while ( <$jinfh> ) {
     $jsondata .= $_; 
   }
   close $jinfh;
   print "DONE!\n";

   print "*** parsing $inname ... ";
   $jsondata =~ s/^\x{ef}\x{bb}\x{bf}//;  # decode_json doesn't like these leading bytes, the "Byte Order Mark" aka BOM.
   print STDERR "$inname\n";
   my $hashref = decode_json $jsondata;
   print "DONE!\n";
   return $hashref;
}

sub analyzeJson {
   my $fname = $_[0];
   $fname =~ /json\/(.*?)\.json/;
   my $type = $1;

   testUnknownIDs( $type );
   testUnknownFields( $type );
   testFields( $type );   # Missing, Empty, Bad
   # testTodoFields();
   testMismatchedHtmlTags( $type );
   # testMissingImages();
}

sub testUnknownIDs {
   my $type = $_[0];
   my $tmp = {};
   foreach my $k (keys %{$respJsonData->{'works'}}) {
      if (!exists($gameJsonData->{'games'}{$k})) {
         # push @unknownIDs, "$type :: $k";
		 if (!exists($tmp->{$k})) {
			 $tmp->{$k} = [ $type ];
		 }
		 else {
			 push @{$tmp->{$k}}, $type;
		 }
      }
   }
   while (my ($k,$v) = each %{$tmp}) {
	   my $s = join(', ', @{$v});
	   push @unknownIDs, "$k :: $s";
   }
}

sub testUnknownFields {
	my $type = $_[0];
	foreach my $k (keys %{$respJsonData}) {
		if ($k !~ /^(type|supers|search|aliases|about|icon|works)$/) {
			push @unknownFields, "$type :: $k";
		}
	}
	if (exists($respJsonData->{'icon'})) { foreach my $k (keys %{$respJsonData->{'icon'}}) {
		if ($k !~ /^(img|attrib|lic)$/) {
			push @unknownFields, "$type :: icon :: $k";
		}
	}}
	if (exists($respJsonData->{'works'})) { foreach my $wid (keys %{$respJsonData->{'works'}}) {
		my $work = $respJsonData->{'works'}->{$wid};
		foreach my $wk (keys %{$work}) {
			if ($wk !~ /^(title|sfx|year|things|notes|x||dont\-list)$/) {
				push @unknownFields, "$type :: $wid : $wk";
			}
		}
		if (exists($work->{'things'})) { foreach my $t (@{$work->{'things'}}) {
			foreach my $tk (keys %{$t}) {
				if ($tk !~ /^(name|type|loc|desc|note|list\-as|for)$/) {
					push @unknownFields, "$type :: $wid : things[].$tk";
				}
			}
		}}
	}}
}

sub testFields {
	my $type = $_[0];
	my @reqMainFields = ( 'type', 'icon', 'search', 'works' );
	foreach my $f (@reqMainFields) {
		if (!exists($respJsonData->{$f})) {
			push @missingFields, "$type :: $f";
		}
	}
	if (exists($respJsonData->{'about'})) {
		if ($respJsonData->{'about'} =~ /TODO/) {
			push @aboutTodos, "$type";
		}
	}
	if (exists($respJsonData->{'icon'})) {
		if (!exists($respJsonData->{'icon'}{'img'})) {
			push @missingFields, "$type :: icon : img";
		}
		elsif ($respJsonData->{'icon'}{'img'} eq '') {
			push @emptyFieldsByType, "$type :: icon :: img";
		}
	}
	if (exists($respJsonData->{'works'})) { foreach my $wid (keys %{$respJsonData->{'works'}}) {
		my $work = $respJsonData->{'works'}->{$wid};
		if (!exists($work->{'title'})) {
			push @missingFields, "$type :: $wid : title";
		}
		elsif ($work->{'title'} eq '') {
			push @emptyFieldsByType, "$type :: $wid : title";
			push @emptyFieldsByWork, "$wid :: $type : title";
		}
		
		if (exists($work->{'title'})) {
			if ($work->{'title'} =~ /^(The |A |An )[^\|]/) {
				push @badFields, "$type :: $wid : title // " . $work->{'title'}; # Missing an or-bar in the title.
			}
		}
		
		my $ndirections = 0;
		if (exists($work->{'dont-list'})) { $ndirections++; }
		if (exists($work->{'things'})) { $ndirections++; }
		if ($ndirections == 0) {
			push @missingFields, "$type :: $wid : things or dont-list";
		}
		elsif ($ndirections > 1) {
			push @badFields, "$type :: $wid : two or more of [things, dont-list]";
		}

		if (exists($work->{'things'})) {
			my $n = 0;
			foreach my $th (@{$work->{'things'}}) {
				# CAREFUL. Don't over-report a missing/empty thing.
				if (!exists($th->{'name'})) {
					push @missingFields, "$type :: $wid : things[$n].name";
				}
				elsif ($th->{'name'} eq '') {
					push @emptyFieldsByType, "$type :: $wid : things[$n].name";
					push @emptyFieldsByWork, "$wid :: $type : things[$n].name";
				}
				elsif (!exists($th->{'type'})) {
					push @missingFields, "$type :: $wid : things[$n].type";
				}
				elsif ($th->{'type'} eq '') {
					push @emptyFieldsByType, "$type :: $wid : things[$n].type";
					push @emptyFieldsByWork, "$wid :: $type : things[$n].type";
				}
				elsif (!exists($th->{'loc'})) {
					push @missingFields, "$type :: $wid : things[$n].loc";
				}
				elsif ($th->{'loc'} eq '') {
					push @emptyFieldsByType, "$type :: $wid : things[$n].loc";
					push @emptyFieldsByWork, "$wid :: $type : things[$n].loc";
				}
				elsif (!exists($th->{'desc'}) && !exists($th->{'list-as'})) {
					push @missingFields, "$type :: $wid : things[$n].desc or list-as";
				}
				elsif (exists($th->{'desc'}) && $th->{'desc'} eq '') {
					push @emptyFieldsByType, "$type :: $wid : things[$n].desc";
					push @emptyFieldsByWork, "$wid :: $type : things[$n].desc";
				}
				if ($th->{'name'} =~ /\,/ && $th->{'name'} !~ /^TODO/) {
					push @warnings, "$type :: $wid : things[$n].name contains comma.";
				}
				if (exists($th->{'desc'}) && $th->{'desc'} =~ /NOTE/) {
					push @warnings, "$type :: $wid : things[$n].desc contains \"NOTE\"";
				}
				if (exists($th->{'list-as'})) {
					if ($th->{'list-as'} !~ /(cameo|default|deflected|empty|no\-examine|synonym|unimportant)/) {
						push @badFields, "$type :: $wid : things[$n].list-as";
					}
					if (($th->{'list-as'} eq 'synonym') && !exists($th->{'for'})) {
						push @missingFors, "$type :: $wid : things[$n]";
					}
				}

				$n++;
			}
		}
	}}
}

sub testMismatchedHtmlTags {
	my $type = $_[0];
	my @tags = ('b', 'div', 'em', 'i', 'ins', 'li', 'p', 'pre', 'span', 'ul', 'var');
	if (exists($respJsonData->{'works'})) { foreach my $wid (keys %{$respJsonData->{'works'}}) {
		my $work = $respJsonData->{'works'}->{$wid};
		my $thingNum = 0;
		if (exists($work->{'things'})) { foreach my $th (@{$work->{'things'}}) {
			if (exists($th->{'desc'})) {
				my $v = $th->{'desc'};
				foreach my $t (@tags) {

					my $nleft = 0;  my $nright = 0;
					while ($v =~ /<$t\b.*?>/gs) { $nleft++; }
					while ($v =~ /<\/$t>/gs) { $nright++; }
					if ($nleft != $nright) {
						my $err = "Unbalanced <code>&lt;$t&gt;</code> tag.";
						push @mismatchedTags, "$type :: $wid : things[$thingNum].desc : $err";
					}

				}
			}
			$thingNum++;
		}}
	}}
}

sub makeQCPages {
	@emptyFieldsByType = sort @emptyFieldsByType;
	@emptyFieldsByWork = sort @emptyFieldsByWork;
		
	# Splitting what was one report page into seven pages.
	makeQCpage(0);		# QC0 (the problems)
	makeQCpage(1);		# QC1 (by type, 1 to 4 instances)
	makeQCpage(2);		# QC2 (by type, 5 to 9 instances)
	makeQCpage(3);		# QC3 (by type, 10+ instances)
	makeQCpage(4);		# QC4 (by work, 1 to 4 instances)
	makeQCpage(5);		# QC5 (by work, 5 to 9 instances)
	makeQCpage(6);		# QC6 (by work, 10+ instances)
}

sub makeQCpage {
	my $pg = $_[0];
	
	open($fh, ">:encoding(UTF-8)", "qc$pg.html");
	print $fh "<!DOCTYPE html>\n<html lang=\"en\">\n<head>\n";
	print $fh "<meta charset=\"UTF-8\">\n";
	print $fh "<meta name=\"Author\" content=\"David Welbourn\">\n";
	print $fh "<title>Thinger Quality Control Page $pg</title>\n";
	print $fh "</head>\n\n";
	print $fh "<body>\n<h1><img src=\"../img/kaclogo.svg\" width=\"50\" height=\"50\" alt=\"\" style=\"vertical-align:middle\"> <span id=\"h1\">Thinger Quality Control Page $pg</span></h1>\n\n";
	
	my $f0 = ($pg == 0 ? '' : 'qc0.html');
	my $f1 = ($pg == 1 ? '' : 'qc1.html');
	my $f2 = ($pg == 2 ? '' : 'qc2.html');
	my $f3 = ($pg == 3 ? '' : 'qc3.html');
	my $f4 = ($pg == 4 ? '' : 'qc4.html');
	my $f5 = ($pg == 5 ? '' : 'qc5.html');
	my $f6 = ($pg == 6 ? '' : 'qc6.html');

	print $fh "<nav><p>";
	print $fh "<a href=\"$f0#unknown_ids\">Unknown IDs</a>";
	print $fh " &bull; <a href=\"$f0#unknown_fields\">Unknown Fields</a>" if scalar(@unknownFields) > 0;
	print $fh " &bull; <a href=\"$f0#mismatched_tags\">Mismatched Tags</a>" if scalar(@mismatchedTags) > 0;
	print $fh " &bull; <a href=\"$f0#about_todos\">About TODOs</a>" if scalar(@aboutTodos) > 0;
	print $fh " &bull; <a href=\"$f0#missing_fields\">Missing Fields</a>" if scalar(@missingFields) > 0;
	print $fh " &bull; <a href=\"$f0#warnings\">Warnings</a>" if scalar(@warnings) > 0;
	print $fh " &bull; <a href=\"$f0#bad_fields\">Bad Fields</a>" if scalar(@badFields) > 0;
	print $fh " &bull; <a href=\"$f0#missing_fors\">Missing Fors</a>" if scalar(@missingFors) > 0;
	print $fh "<br>Empty Fields by Type:";	
	print $fh " <a href=\"$f1#type1to4\">1 to 4</a>";
	print $fh " &bull; <a href=\"$f2#type5to9\">5 to 9</a>";
	print $fh " &bull; <a href=\"$f3#type10plus\">10+</a>";
	print $fh "<br>Empty Fields by Work:";	
	print $fh " <a href=\"$f4#work1to4\">1 to 4</a>";
	print $fh " &bull; <a href=\"$f5#work5to9\">5 to 9</a>";
	print $fh " &bull; <a href=\"$f6#work10plus\">10+</a>";
	print $fh "</p></nav>\n\n";

	if ($pg == 0) {
		reportUnknownIDs();
		reportUnknownFields() if scalar(@unknownFields) > 0;
		reportMismatchedTags() if scalar(@mismatchedTags) > 0;
		reportAboutTodos() if scalar(@aboutTodos) > 0;
		reportMissingFields() if scalar(@missingFields) > 0;
		reportWarnings() if scalar(@warnings) > 0;
		reportBadFields() if scalar(@badFields) > 0;
		reportMissingFors() if scalar(@missingFors) > 0;
	}
	else {
		reportEmptyFields($pg);
	}

	doFooter();
	print $fh "</body>\n</html>\n";
	close $fh;
}

sub reportUnknownIDs {
   print $fh "<h2 id=\"unknown_ids\">Unknown IDs</h2>\n\n";
   print $fh "<p>Either the things file is using the wrong ID, or the work needs to be added to the games file.</p>\n";
   print $fh "<ul>\n";
   @unknownIDs = sort @unknownIDs;
   foreach my $r (@unknownIDs) {
      print $fh "<li>$r</li>\n"; 
   }
   print $fh "</ul>\n\n";
}

sub reportUnknownFields {
   print $fh "<h2 id=\"unknown_fields\">Unknown Fields</h2>\n\n<ul>\n";
   @unknownFields = sort @unknownFields;
   foreach my $r (@unknownFields) {
      print $fh "<li>$r</li>\n"; 
   }
   print $fh "</ul>\n\n";
}

sub reportMissingFields {
   print $fh "<h2 id=\"missing_fields\">Missing Fields</h2>\n\n<ul>\n";
   @missingFields = sort @missingFields;
   foreach my $r (@missingFields) {
      print $fh "<li>$r</li>\n"; 
   }
   print $fh "</ul>\n\n";
}

sub reportAboutTodos {
   print $fh "<h2 id=\"about_todos\">About TODOs</h2>\n<p>The about field has the word TODO in it.</p>\n<ul>\n";
   @aboutTodos = sort @aboutTodos;
   foreach my $r (@aboutTodos) {
      print $fh "<li>$r</li>\n"; 
   }
   print $fh "</ul>\n\n";
}

sub reportWarnings {
   print $fh "<h2 id=\"warnings\">Warnings</h2>\n\n<ul>\n";
   @warnings = sort @warnings;
   foreach my $r (@warnings) {
      print $fh "<li>$r</li>\n"; 
   }
   print $fh "</ul>\n\n";
}

sub reportBadFields {
   print $fh "<h2 id=\"bad_fields\">Bad Fields</h2>\n\n<ul>\n";
   @badFields = sort @badFields;
   foreach my $r (@badFields) {
      print $fh "<li>$r</li>\n"; 
   }
   print $fh "</ul>\n\n";
}

sub reportEmptyFields {
	my $pg = $_[0];
	if ($pg == 1) {	reportEmptyFieldsByType( $pg, 'type1to4', 'Empty Fields by Type (1 to 4)' ); }
	elsif ($pg == 2) { reportEmptyFieldsByType( $pg, 'type5to9', 'Empty Fields by Type (5 to 9)' ); }
	elsif ($pg == 3) { reportEmptyFieldsByType( $pg, 'type10plus', 'Empty Fields by Type (10+)' ); }
	elsif ($pg == 4) { reportEmptyFieldsByWork( $pg, 'work1to4', 'Empty Fields by Work (1 to 4)' ); }
	elsif ($pg == 5) { reportEmptyFieldsByWork( $pg, 'work5to9', 'Empty Fields by Work (5 to 9)' ); }
	elsif ($pg == 6) { reportEmptyFieldsByWork( $pg, 'work10plus', 'Empty Fields by Work (10+)' ); }
}

sub countOkay {
	my ($pg, $count) = @_;
	if ($pg == 1 || $pg == 4) {
		return ($count >= 1 && $count <= 4);
	}
	elsif ($pg == 2 || $pg == 5) {
		return ($count >= 5 && $count <= 9);
	}
	elsif ($pg == 3 || $pg == 6) {
		return ($count >= 10);
	}
	else {
		return 1;
	}
}

sub reportEmptyFieldsByType {
	my ($pg, $id, $as) = @_;
   my $cur; my $last;
   my %counts;

   %counts = ();
   foreach my $r (@emptyFieldsByType) {
      $r =~ /^(.*?)\s\:/;
      my $cur = $1;
      if (exists($counts{$cur})) {
         $counts{$cur}++;
      }
      else {
         $counts{$cur} = 1;
      }
   }
   
   print $fh "<h2 id=\"$id\">$as</h2>\n\n<ul>\n";
   
	$last = '';
	foreach my $r (@emptyFieldsByType) {
		$r =~ /^(.*?)\s\:/;
		my $cur = $1;
		if (countOkay($pg, $counts{$cur})) {
			if ($cur ne $last) {
				print $fh "  </ul>\n  </details></li>\n" if $last ne '';
				print $fh "<li><details>\n  <summary>$cur (" . $counts{$cur} . ")</summary>\n  <ul>\n";
				$last = $cur;
			}
			print $fh "  <li>$r</li>\n";
		}
	}
	print $fh "  </ul>\n  </details></li>\n" if $last ne '';
	print $fh "</ul>\n\n";
}

sub reportEmptyFieldsByWork {
	my ($pg, $id, $as) = @_;
	my $cur; my $last;
	
	# TODO add count code in here
	
	$last = '';
	print $fh "<h2 id=\"$id\">$as</h2>\n\n<ul>\n";
	foreach my $r (@emptyFieldsByWork) {
		$r =~ /^(.*?)\s\:/;
		my $cur = $1;
		if ($cur ne $last) {
			print $fh "  </ul>\n" if $last ne '';
			print $fh "<li>$cur\n  <ul>\n";
			$last = $cur;
		}
		print $fh "  <li>$r</li>\n";
	}
	print $fh "  </ul>\n" if $last ne '';
	print $fh "</ul>\n\n";
}

sub reportMismatchedTags {
   print $fh "<h2 id=\"mismatched_tags\">Mismatched Tags</h2>\n\n<ul>\n";
   @mismatchedTags = sort @mismatchedTags;
   foreach my $r (@mismatchedTags) {
      print $fh "<li>$r</li>\n"; 
   }
   print $fh "</ul>\n\n";
}

sub reportMissingFors {
   print $fh "<h2 id=\"missing_fors\">Missing Fors</h2>\n\n\n";
   print $fh "<p>These things are marked as synonyms, but their \"for\" fields are missing.</p>\n";
   print $fh "<ul>\n";
   @missingFors = sort @missingFors;
   foreach my $r (@missingFors) {
      print $fh "<li>$r</li>\n"; 
   }
   print $fh "</ul>\n\n";
}

# Want to make sure every <li> tag is balanced with a </li> tag and so on,
# in any particular response field.
sub collectUnbalancedTagProblems {
   my ($id, $k, $v, $records) = @_;
   my @tags = ('b', 'div', 'em', 'i', 'ins', 'li', 'p', 'pre', 'span', 'ul', 'var');
   foreach my $t (@tags) {
      my $nleft = 0;  my $nright = 0;
      while ($v =~ /<$t\b.*?>/gs) { $nleft++; }
      while ($v =~ /<\/$t>/gs) { $nright++; }
      if ($nleft != $nright) {
         my $p = "Unbalanced <code>&lt;$t&gt;</code> tag in \"$k\" field.";
         push @{$records}, { 'sort' => "$id $p",
                             'id' => $id, 'problem' => $p };
      }
   }
}

sub imageExists {
   my $id = $_[0];
   if (-e "$imgDirectory/$id.png") { return 1; }
   elsif (-e "$imgDirectory/$id.jpg") { return 1; }
   elsif (-e "$imgDirectory/$id.gif") { return 1; }
   else { return 0; }
}

sub hasCoverTag {
   my $id = $_[0];
   if (!exists($gameJsonData->{'games'}{$id})) { return 0; }
   if (!exists($gameJsonData->{'games'}{$id}{'tags'})) { return 0; }
   foreach my $tag (@{$gameJsonData->{'games'}{$id}{'tags'}}) {
      if ($tag eq 'cover') { return 1; }
   }
   return 0;
}

sub getCurrentYear {
   my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
   return 1900 + $year;
}

sub isEnglish {
   # return 1 if there's an English version of the work; otherwise, return 0.
   my $gVersions = $_[0];
   foreach my $ver (@{$gVersions}) {
     if (exists($ver->{'lang'}) and ($ver->{'lang'} =~ /^en/)) {
        return 1;
     }
   }
   return 0;
}

sub reportField {
   my ($fldname, $records) = @_;
   if (scalar(@{$records}) == 0) {
      print $fh "<p>No \"$fldname\" fields found.</p>\n";
   }
   else {
      print $fh "<ul>\n";
      foreach my $r (@{$records}) {
         print $fh "<li>[" . $r->{'id'} . "] " . $r->{$fldname} . "</li>\n";
      }
      print $fh "</ul>\n\n";
   }
}

sub doFooter {
   my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
   my $dd = substr('0' . $mday,-2);
   my $mmm = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec')[$mon];
   my $yyyy = 1900 + $year;
   print $fh "<footer>\n";
   print $fh "<hr>\n";
   print $fh "<p style=\"font-size:small;text-align:center;\">\n";
   print $fh " <a href=\"html\\index.html\">IF Things</a>\n";
   print $fh " <span style=\"float:left;\">Last updated: $dd $mmm $yyyy</span>\n";
   print $fh " <span style=\"float:right;\">davidwelbourn(a)hotmail*com</span>\n";
   print $fh "</p>\n";
   print $fh "</footer>\n";
}