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 $sug_sys = '';
my $sug_ev = '';

#### END OF GLOBAL VARS

#### START OF MAIN PROGRAM ####

my $respJsonData = loadJson("responses.json.txt");
my $gameJsonData = loadJson("../IFIndexer/gamejson.txt");
makeQCPage();

#### 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.
   my $hashref = decode_json $jsondata;
   print "DONE!\n";
   return $hashref;
}

sub makeQCPage {
   open($fh, ">:encoding(UTF-8)", "qc.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>Responser Quality Control</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\">Responser Quality Control</span></h1>\n\n";

   print $fh "<p><a href=\"#problem\">Problem Fields</a>";
   print $fh " | <a href=\"#imgs\">Missing Images</a>";
   print $fh " | <a href=\"#incomplete\">Incomplete Entries</a>";
   print $fh " | <a href=\"#sug\">Suggestions</a>";
   print $fh " | <a href=\"#nbs\">NB Fields</a>";
   print $fh " | <a href=\"#errs\">Error Fields</a>";
   print $fh " | <a href=\"#nas\">N/A Fields</a>";
   print $fh "</p>\n";

   reportProblemFields();
   reportMissingImages();
   reportIncompleteEntries();
   reportSuggestions();
   reportNbFields();
   reportErrorFields();
   reportNaFields();
   doFooter();
   print $fh "</body>\n</html>\n";
   close $fh;
}

sub reportProblemFields {
   print $fh "<hr><h2 id=\"problem\">Problem Fields</h2>\n";

   # Collect the info into an array of {sort, id, problem} records.
   my @records = ();
   # First look for unknown fields.
   foreach my $id (keys %{$respJsonData->{'works'}}) {
      my $v = $respJsonData->{'works'}{$id};
      foreach my $fld (keys %{$v}) {
         if (isUnknownField($fld)) {
            my $p = "Unknown \"$fld\" field. Possible typo?";
            push @records, { 'sort' => "$id $p",
                             'id' => $id, 'problem' => $p };
         }
         if ($v->{$fld} =~ /^\s*$/) {
            my $p = "Empty \"$fld\" field.";
            push @records, { 'sort' => "$id $p",
                             'id' => $id, 'problem' => $p };
         }
         if ($fld =~ /^(pet|plover|plugh|pray|sing|think|xyzzy|no\-do|notunderstood)$/) {
            collectUnbalancedTagProblems( $id, $fld, $v->{$fld}, \@records );
         }
      }
   }

   # Sort the records.
   @records = sort { $a->{'sort'} cmp $b->{'sort'} } @records;

   # Report the records.
   reportField( 'problem', \@records );
}

sub isUnknownField {
   my $s = $_[0];
   if ($s =~ /^(title|sfx|nb|error|variants|n\/a)$/) { return 0; }
   if ($s =~ /^(pet|plover|plugh|pray|sing|think|xyzzy|no\-do|notunderstood)(_nb)?$/) { return 0; }
   return 1;
}

# 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 reportMissingImages {
   print $fh "<hr id=\"imgs\"><h2>Missing Images</h2>\n";

   # Collect the info into an array of {id, title} records.
   my @records = ();
   foreach my $id (keys %{$respJsonData->{'works'}}) {
      if (hasOwnResp($id) && !imageExists($id) && hasCoverTag($id)) {
         push @records, { 'id' => $id,
                          'title' => $respJsonData->{'works'}{$id}{'title'} };
      }
   }

   # Sort the records by their id.
   @records = sort { $a->{'id'} cmp $b->{'id'} } @records;

   # Report the id's.
   if (scalar(@records) == 0) {
      print $fh "<p>No missing images.</p>\n";
   }
   else {
      print $fh "<p>Find cover art for the following works:</p>\n";
      print $fh "<ul>\n";
      foreach my $r (@records) {
         print $fh "<li>[" . $r->{'id'} . "] " . $r->{'title'} . "</li>\n";
      }
      print $fh "</ul>\n\n";
   }
}

sub hasOwnResp {
   # Does this work have a response of its own?
   my $id = $_[0];
   my $r = $respJsonData->{'works'}{$id};
   foreach my $fld (keys %{$r}) {
      if ($fld !~ /^(title|sfx|nb|error)$/ and $fld !~ /_nb$/) {
         my $fldval = $r->{$fld};
         if ($fldval ne '-' and $fldval !~ /^!! /) {
            return 1;
         }
      }
   }
   return 0;
}

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 reportIncompleteEntries {
   print $fh "<hr id=\"incomplete\"><h2>Incomplete Entries</h2>\n";

   # Collect the info into array of {id, missing, isnb, iserror, sort} records.
   my @records = ();
   my @cmds = ( 'pet', 'plover', 'plugh', 'pray', 'sing', 'think', 'xyzzy', 'notunderstood' );
   foreach my $id (keys %{$respJsonData->{'works'}}) {
      my $r = $respJsonData->{'works'}{$id};
      if (exists($r->{'n/a'})) { next; } # Skip this record if it has a 'n/a' field.
      my @missing = ();
      foreach my $cmd (@cmds) {
         if (!exists($r->{$cmd})) {
            push @missing, $cmd;
         }
      }
      if (scalar(@missing) > 0) {
         my $isnb = 0 + exists($r->{'nb'});
         my $iserror = 0 + exists($r->{'error'});
         my $sort = '' . $iserror . $isnb . (9 - scalar(@missing)) . $id;
         push @records, { 'id' => $id, 'missing' => \@missing,
                          'isnb' => $isnb, 'iserror' => $iserror,
                          'sort' => $sort };
      }
   }

   # Sort the records.
   @records = sort {$a->{'sort'} cmp $b->{'sort'}} @records;

   # Report the records.
   if (scalar(@records) == 0) {
      print $fh "<p>No incomplete entries found! (I disbelieve.)</p>\n";
   }
   else {
      print $fh "<ol>\n";
      foreach my $r (@records) {
         print $fh "<li>[" . $r->{'id'} . "] Missing";
         foreach my $cmd (@{$r->{'missing'}}) {
            print $fh " " . $cmd;
         }
         print $fh ".";
         if ($r->{'isnb'} || $r->{'iserror'}) {
            print $fh " <span style=\"color:red;\">Has";
            print $fh " nb" if $r->{'isnb'};
            print $fh " error" if $r->{'iserror'};
            print $fh ".</span>";
         }
         print $fh "</li>\n";
      }
      print $fh "</ol>\n\n";
   }
}

sub reportSuggestions {
   print $fh "<hr id=\"sug\"><h2>Suggestions</h2>\n";

   # Collect the info into an array of {id, title, score, sort} records.
   my @records = ();
   foreach my $id (keys %{$gameJsonData->{'games'}}) {
      next if exists($respJsonData->{'works'}{$id});  # skip this work if it's already in the responses file.

      my $grec = $gameJsonData->{'games'}{$id};
      my $title = $grec->{'titles'}[0];

      my $ascore = 0;  my $escore = 1;  my $lscore = 0;
      if (exists($grec->{'versions'})) {
         $lscore = isEnglish( $grec->{'versions'} );
         $ascore = calcAScore( $grec->{'versions'} );
         $escore = calcEScore( $grec->{'versions'} );
		 if ($escore == 0) {
			 print "Undefined Event Error for id = $id. [Press SPACE]\n";
			 getc; # Wait until I press a key.
		 }
      }
      next if $lscore == 0;  # skip this work if there's no English version.
      next if $ascore == 0;  # skip this work if authsys/platform info is unfavorable.

      my $yscore = 0;
      if (exists($grec->{'year'})) {
         $yscore = calcYScore( $grec->{'year'} );
      }
      next if $yscore == 0;  # skip this work if it doesn't even have a year field.

      my $score = $ascore + $escore + $yscore;
      push @records, { 'id' => $id, 'title' => $title, 'score' => $score, 'sort' => (200 - $score) . ' ' . $id, 'sys' => $sug_sys, 'ev' => $sug_ev };
   }

   # Sort the records.
   @records = sort { $a->{'sort'} cmp $b->{'sort'} } @records;

   # Report the top 40 works.
   if (scalar(@records) == 0) {
      print $fh "<p>No suggestions. (That's really unlikely.)</p>\n";
   }
   else {
      print $fh "<p>Consider adding the following works to <code>responses.json.txt</code>:</p>\n";
      print $fh "<ul>\n";
      my $i = 0;
      foreach my $r (@records) {
         print $fh "<li><code>\"" . $r->{'id'} . "\":{\"title\":\"" . $r->{'title'} . "\"</code>  (score: " . $r->{'score'};
		 print $fh ';' . $r->{'sys'} unless $r->{'sys'} eq '';
		 print $fh ';' . $r->{'ev'} unless $r->{'ev'} eq '';
		 print $fh ")</li>\n";
         $i++;  last if $i >= 40;
      }
      print $fh "</ul>\n\n";
   }
}

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 calcAScore {
   # return a value from 0 to 10 based on the work's authsys and platform fields.
   my $gVersions = $_[0];
   my $sysList = '';
   foreach my $ver (@{$gVersions}) {
      if (exists($ver->{'authsys'})) { $sysList .= ' ' . lc($ver->{'authsys'}); }
      if (exists($ver->{'platform'})) { $sysList .= ' ' . lc($ver->{'platform'}); }
   }
   $sug_sys = $sysList;
   if ($sysList =~ /(twine|undum|choicescript|adventure book)/) {
      return 0;  # Filter out choice games. Responser isn't interested in them.
   }
   elsif ($sysList =~ /(z\-code|glulx|inform|tads)/) {
      return 10;
   }
   elsif ($sysList =~ /hugo/) {
      return 8;
   }
   elsif ($sysList =~ /(alan|adrift|quest)/) {
      return 5;
   }
   else {
      return 3;
   }
}

sub calcEScore {
   # return a value from 0 to 10 based on the work's events participation.
   my $gVersions = $_[0];
   my $escore = 3;  # The base escore is 3 for noncomp works.
   $sug_ev = '';
   foreach my $ver (@{$gVersions}) {
      if (exists($ver->{'events'})) { foreach my $ev (@{$ver->{'events'}}) {
         $escore = 6 if $escore < 5;    # Just for having an event of any kind boosts the escore up to 5.
		 if (!defined($ev->{'event'})) {
			 return 0; # ERROR!
		 }
	     $sug_ev .= ' ' . $ev->{'event'};
         if ($ev->{'event'} =~ /^(IF Comp |XYZZY Award)/) {
            $escore = 10;   # IF Comp and XYZZY participants get a 10.
         }
         elsif ($ev->{'event'} =~ /^(Spring Thing|Top 50) /) {
            $escore = 8 if $escore < 8;   # Spring Thing and Top 50 participants get an 8.
         }
      }}
   }
   return $escore;
}

sub calcYScore {
   # return a value from 0 to 10 based on the work's publication year and the current year.
   my $gYear = $_[0];
   my $currYear = getCurrentYear();

   if ($gYear eq '0000' or $gYear eq '' or $gYear eq 'TBD') { 
      return 1;
   }
   elsif ($currYear - $gYear == 0) { # The work was made this year! Rate that a 10.
      return 10;
   }
   elsif ($currYear - $gYear == 1) { # The work was made last year! Rate that a 9.
      return 9;
   }
   elsif ($currYear - $gYear <= 5) {
      return 8;
   }
   elsif ($currYear - $gYear <= 10) {
      return 6;
   }
   elsif ($currYear - $gYear <= 20) {
      return 4;
   }
   else {
      return 2;
   }
}

sub reportNbFields {
   print $fh "<hr id=\"nbs\"><h2>NB Fields</h2>\n";
   print $fh "<p>Report any <code>\"nb\"</code> fields in responses.json.txt.</p>\n";

   # Collect the info into an array of {id, nb} records.
   my @records = ();
   foreach my $id (keys %{$respJsonData->{'works'}}) {
      my $v = $respJsonData->{'works'}{$id};
      if (exists($v->{'nb'})) {
         push @records, { 'id' => $id, 'nb' => $v->{'nb'} };
      }
   }

   # Sort the records.
   @records = sort { $a->{'id'} cmp $b->{'id'} } @records;

   # Report the records.
   reportField( 'nb', \@records );
}

sub reportErrorFields {
   print $fh "<hr id=\"errs\"><h2>Error Fields</h2>\n";
   print $fh "<p>Report any <code>\"error\"</code> fields in responses.json.txt.</p>\n";

   # Collect the info into an array of {id, error} records.
   my @records = ();
   foreach my $id (keys %{$respJsonData->{'works'}}) {
      my $v = $respJsonData->{'works'}{$id};
      if (exists($v->{'error'})) {
         push @records, { 'id' => $id, 'error' => $v->{'error'} };
      }
   }

   # Sort the records.
   @records = sort { $a->{'id'} cmp $b->{'id'} } @records;

   # Report the records.
   reportField( 'error', \@records );
}

sub reportNaFields {
   print $fh "<hr id=\"nas\"><h2>N/A Fields</h2>\n";
   print $fh "<p>Report any <code>\"n/a\"</code> fields in responses.json.txt.</p>\n";

   # Collect the info into an array of {id, n/a} records.
   my @records = ();
   foreach my $id (keys %{$respJsonData->{'works'}}) {
      my $v = $respJsonData->{'works'}{$id};
      if (exists($v->{'n/a'})) {
         push @records, { 'id' => $id, 'n/a' => $v->{'n/a'} };
      }
   }

   # Sort the records.
   @records = sort { $a->{'id'} cmp $b->{'id'} } @records;

   # Report the records.
   reportField( 'n/a', \@records );
}

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=\"index.html\">IF Responses</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";
}