#!/usr/bin/perl

# This keeps me from losing games or ending up with two copies of information
# for the same game. I used to check for missing games, but since I now
# get just partial updates, that check isn't useful.
# Specifically I check for filename changes for the same game title (and
# change the name to match), duplicate old or new games, new games, and
# games that have the same basename for their file but different titles.
# Normally you want to run this twice to recheck things after any file
# names have been updated. New games may need to be removed from wbcnew.tsv,
# and have their filename changed to match the appropiate WBC code.
# I have added a new check to report about who controls the game sheets,
# so if the wrong minion submits a game sheet, I can catch it.
#
# Bruno Wolff III

use utf8;
use locale ':not_characters';
use open ':locale';
use POSIX qw(locale_h);
setlocale(LC_ALL, "en_US.utf8");

# Get default owners for games based on the game type
%def = ();

if (open(DEF, '<contactdef.tsv')) {
  while (<DEF>) {
    next unless m/^([ABCDEFGHIJKLMNOPQRSTUVWXYZ[:digit:]]+)\t([ABCDEFGHIJKLMNOPQRSTUVWXYZ[:digit:]]+)$/;
    $type = uc($1);
    $owner = uc($2);
    $def{$1} = $2;
  }
  close(DEF);
}

# Set owners for games based on the game type
%owner = ();
%type = ();

if (open(TYPE, '<gametypes.tsv')) {
  while (<TYPE>) {
    next unless m/^([ABCDEFGHIJKLMNOPQRSTUVWXYZ[:digit:]]+)\t([ABCDEFGHIJKLMNOPQRSTUVWXYZ[:digit:]]+)$/;
    $game = uc($1);
    $type = uc($2);
    $type{$game} = $type;
    if (defined($def{$type})) {
      $owner{$game} = $def{$type};
    }
    else {
      $owner{$game} = 'BADTYPE';
    }
  }
  close(TYPE);
}

# Override for solitaire games
if (open(SOL, '<sol.tsv')) {
  while (<SOL>) {
    next unless m/^([ABCDEFGHIJKLMNOPQRSTUVWXYZ[:digit:]]+)$/;
    $game = uc($1);
    $type{$game} = 'SOL';
    $owner{$game} = 'GLENN';
  }
  close(SOL);
}

# Set owners for games that are exceptions to the defaults
if (open(EXCEPT, '<contactexc.tsv')) {
  while (<EXCEPT>) {
    next unless m/^([ABCDEFGHIJKLMNOPQRSTUVWXYZ[:digit:]]+)\t([ABCDEFGHIJKLMNOPQRSTUVWXYZ[:digit:]]+)$/;
    $game = uc($1);
    $owner = uc($2);
    $owner{$game} = $owner;
  }
  close(EXCEPT);
}

%ogames = ();
%ngames = ();
%wgames = ();
%ofiles = ();
%nfiles = ();
%wfiles = ();

# Get a list of WBC games we haven't rated

if (open(WBC, '<wbcnew.tsv')) {
  while (<WBC>) {
    next unless m/^([ABCDEFGHIJKLMNOPQRSTUVWXYZ[:digit:]]+)\t(.+)$/;
    $file = lc($1);
    $game = $2;
    $game =~ s/"//g;
    $game =~ s/^\s+//g;
    $game =~ s/\s+$//g;
    $game =~ s/\s+/ /g;
    $wgames{$game} = $file;
    $wfiles{$file} = $game;
  }
  close(WBC);
}

opendir(DIR, 'data') || die "Couldn't open old data directory.\n";
@files = readdir(DIR);
closedir(DIR);

sub bylc {lc($a) cmp lc($b)};

foreach $file (@files) {
  if ($file =~ m/\.tsv$/) {
    open(GAME, "<data/$file") || next;
  }
  elsif ($file =~ m/\.tsv\.gz$/) {
    open(GAME, "/usr/local/bin/gzcat data/$file|") || next;
  }
  else {
    next;
  }
  $file =~ s/\.*$//;
  $game = '';
  while (<GAME>) {
    chop;
    s/\r//g;
    m;^\s*$; && next;
    $_ .= ' ';
    if ($game eq '') {
      m;^\d*\s*$; && next;
      m;^\s*\d+\t\d+\t\d+\s*$; && next;
      m;^\s*(\d+/\d+/\d+(\s.*)?)?$; && next;
      m;^\s*(\d+-\d+-\d+(\s.*)?)?$; && next;
      m;^\s*([[:alpha:]]+ \d+,? \d+(\s.*)?)?$; && next;
      m;^\s*http:; && next;
    }
    @fields = split /\t/;
    $game = $fields[1];
    $game =~ s/"//g;
    $game =~ s/^\s+//g;
    $game =~ s/\s+$//g;
    $game =~ s/\s+/ /g;
    if (defined($ogames{$game})) {
      print "Duplicate old game, \"$game\", in \"$ogames{$game}\" and \"$file\".\n";
    }
    $ogames{$game} = $file;
    $ngames{$game} = '';
    $ofile = $file;
    $ofile =~ s/\..*//;
    $ofiles{$ofile} = $game;
    last;
  }
  close(GAME);
  if ($game eq '') {
    print "Unable to find name of game in old data file, $file.\n";
  }
  $file = $ogames{$game};
  $file =~ s/\..*//;
  if (not defined $owner{uc($file)} ||
    $owner{$file} eq 'BADTYPE') {
    print "Old game, \"$game\", in \"$ogames{$game}\" has no owner.\n";
  }
  if (defined $wfiles{$file}) {
    print "\nOld game, \"$game\", in \"$ogames{$game}\" replaces WBC new game, \"$wfiles{$file}\".\n";
  }
}

opendir(DIR, 'new') || die "Couldn't open new data directory.\n";
@files = readdir(DIR);
closedir(DIR);

foreach $file (@files) {
  if ($file =~ m/\.tsv$/) {
    open(GAME, "<new/$file") || next;
  }
  elsif ($file =~ m/\.tsv\.gz$/) {
    open(GAME, "/usr/local/bin/gzcat new/$file|") || next;
  }
  else {
    next;
  }
  $game = '';
  while (<GAME>) {
    chop;
    s/\r//g;
    m;^\s*$; && next;
    $_ .= ' ';
    if ($game eq '') {
      m;^\d*\s*$; && next;
      m;^\s*\d+\t\d+\t\d+\s*$; && next;
      m;^\s*(\d+/\d+/\d+(\s.*)?)?$; && next;
      m;^\s*(\d+-\d+-\d+(\s.*)?)?$; && next;
      m;^\s*([[:alpha:]]+ \d+,? \d+(\s.*)?)?$; && next;
      m;^\s*http:; && next;
    }
    @fields = split /\t/;
    $game = $fields[1];
    $game =~ s/"//g;
    $game =~ s/^\s+//g;
    $game =~ s/\s+$//g;
    $game =~ s/\s+/ /g;
    if ($ngames{$game} ne '') {
      print "Duplicate new game, \"$game\", in \"$ngames{$game}\" and \"$file\".\n";
    }
    $ngames{$game} = $file;
    $nfile = $file;
    $nfile =~ s/\..*//;
    $nfiles{$nfile} = $game;
    last;
  }
  close(GAME);
  if ($game eq '') {
    print "Unable to find name of game in new data file, \"$file\".\n";
  }
  $file = $ngames{$game};
  $file =~ s/\..*//;
  if (defined $wfiles{$file}) {
    print "\nNew game, \"$game\", in \"$ngames{$game}\" replaces WBC new game, \"$wfiles{$file}\".\n";
  }
}

foreach $file (sort(bylc keys(%nfiles))) {
  if (defined($ofiles{$file}) && ($nfiles{$file} ne $ofiles{$file})) {
    print "Game name changed for file \"$file\" from \"$ofiles{$file}\" to \"$nfiles{$file}\".\n";
  }
}

foreach $game (sort(bylc keys(%ngames))) {
  if ($ogames{$game} eq '') {
    print "Added new game, \"$game\", in \"$ngames{$game}\".\n";
  }
  elsif ($ngames{$game} eq '') {
#    print "Missing game, \"$game\", corresponding to old game in \"$ogames{$game}\".\n";
  }
  elsif ($ngames{$game} ne $ogames{$game}) {
    print "The file for \"$game\" changed from \"$ogames{$game}\" to \"$ngames{$game}\".\n";
    if (! -e "new/$ogames{$game}") {
      if (rename ("new/$ngames{$game}", "new/$ogames{$game}")) {
        print "New file \"$ngames{$game}\" renamed to \"$ogames{$game}\".\n";
      }
    }
  }
}

# Get ownership information for new games

%nowner = ();

foreach $game (keys(%ngames)) {
  next if $ngames{$game} eq '';
# If the new file name is going to be changed, use the old file name.
  if (defined($ogames{$game})) {
    $file = uc($ogames{$game});
  }
  else {
    $file = uc($ngames{$game});
  }
  $file =~ s/\..*//;
  if (defined($owner{$file})) {
    $nowner{$file} = $owner{$file};
  }
  else {
    $nowner{$file} = 'NOOWNER';
  }
}

# Count up games by owner
%count = ();
foreach $game (keys(%nowner)) {
  $count{$nowner{$game}}++;
}

print "\nOwnership counts:\n";
foreach $owner (sort keys(%count)) {
  print "$owner:  $count{$owner}\n";
}

print "\nOwnership of games with owners owning less than 10 new games:\n";
foreach $file (sort keys(%nowner)) {
  next if $count{$nowner{$file}} >= 10;
  print "$file  $nowner{$file} \n";
}

# Count up owners by type for games not being replaced
print "\nCounts for games not being updated by owner, type:\n";
%count = ();
foreach $game (keys(%owner)) {
  next if defined $wfiles{lc($game)};
  next if defined $nowner{$game};
  $group = $owner{$game} . ', ' . $type{$game};
  $count{$group}++;
}
foreach $group (sort keys(%count)) {
  print "$group:  $count{$group}\n";
}

print "\nOwnership of games not updated where there are less than 10\n";
print "not be included by owner, type:\n";
foreach $group (sort keys(%count)) {
  next if $count{$group} >= 10;
  foreach $game (sort keys(%owner)) {
    next if defined $wfiles{lc($game)};
    next if defined $nowner{$game};
    next if $group ne $owner{$game} . ', ' . $type{$game};
    print "$group:  $game\n";
  }
}

print "\n";