#!/usr/bin/perl

# Load postgresql database from game data.
# Bruno Wolff III
# Last updated July 12, 2014

$" = '';

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

# Postgres perl library

use Pg;

use Time::JulianDay;

$day1 = julian_day(1899, 12, 30);
@date = localtime;
$date[5] += 1900;
$date[4]++;
$today = julian_day($date[5], $date[4], $date[3]);

# Open ERROR file for writing data error report
$error = 'tmp/errors.txt';

if (!open(ERROR, ">$error")) {
  print STDERR "Couldn't open error report file.\n";
  exit;
}

$port = 5432;
$port = $ARGV[0] if $ARGV[0] =~ m/^[[:digit:]]+$/;

# Connect to the AREA database

$conn = Pg::connectdb("dbname=area user=areauser password=areapass host=localhost");
if ($conn->status != PGRES_CONNECTION_OK) {
  print ERROR "Unable to connect to the area database.\n";
  print ERROR $conn->errorMessage;
  exit;
}

# Used to check for game title duplicate warnings
%titledup = ();

# Per game stuff key gameid (from filename)
%title = ();
%gdate = ();
%pub = ();
%gameurl = ();
%gameurle = ();
%gsol = ();

# Per player stuff key areaid
%lname = ();
%fmname = ();
%aname = ();
%gen = ();
%genlab = ();
%anon = ();
%displayid = ();

# Per player and game stuff key gameid/areaid
%rate = ();
%frq = ();
%opp = ();
%rmp = ();
%trn = ();
%pdate = ();
%rmc = ();

# Per publisher stuff
%pubname = ();
%puburl = ();

# Per known pubname stuff
%pubalias = ();

# WBC code map, url and title
%wbc = ();
%wbcurl = ();
%wbcevent = ();

# Name - ID consistancy check stuff
%chkid = ();
%chkname = ();

# Valid Rating Types
%rtype = ();

# Valid Contacts
%contacts = ();

# Game rating type
%gametype = ();

# Can the game win?
%sol = ();

# Game contact
%gamecont = ();

# contact default by type
%cdef = ();

# Default for solitaire games
%csol = ();

# contact exceptions
%cexc = ();

# List of IDs of people who don't want their names on the web page

if (!open(ANON, 'anon.tsv')) {
  print ERROR "Couldn't open anonymous ID file.\n";
  exit;
}
while (<ANON>) {
  s/\s+//g;
  $anon{$_} = 'anon';
}
close(ANON);

# Remove per file error reports

if (!opendir(DIR, 'errors')) {
  print ERROR "Couldn't open error directory.\n";
}
foreach $error (readdir(DIR)) {
  next if $error eq '.htaccess';
  unlink "errors/$error";
}
closedir(DIR);

# Where the text version of the excel sheets reside

if (!opendir(DIR, 'data')) {
  print ERROR "Couldn't open data directory.\n";
  exit;
}
@files = sort(readdir(DIR));
closedir(DIR);

# Canonical list of player names, but it may not be up to date. Give data
# here preference over that found in game files.

$master = 'The Master ID File';
if (open(MASTER, "<master.tsv") || open(MASTER, "/usr/local/bin/gzcat master.tsv.gz|")) {
  while (<MASTER>) {
    last if m/^id/i;
  }
  while (<MASTER>) {
    next if m/^\s*$/;
    @fields = split /\t/;
    $areaid = $fields[0];
    $fmname = $fields[1];
    $lname = $fields[2];
    $aname = '';
    $gen = '';
    $genlab = '';
    $lname =~ s/\([^)]*\)//g;
    $lname =~ s/[^-[:alpha:]' ]//g;
    $lname =~ s/^[-' ]+//g;
    $lname =~ s/[-' ]+$//g;
    $lname =~ s/([-' ])[-' ]+/$1/g;
    if ($lname =~ s/ SR$//i) {
      $gen = '1';
      $genlab = 'Sr';
    }
    elsif ($lname =~ s/ I$//i) {
      $gen = '1';
    }
    elsif ($lname =~ s/ JR$//i) {
      $gen = '2';
      $genlab = 'Jr';
    }
    elsif ($lname =~ s/ II$//i) {
      $gen = '2';
    }
    elsif ($lname =~ s/ III$//i) {
      $gen = '3';
    }
    elsif ($lname =~ s/ IV$//i) {
      $gen = '4';
    }
    elsif ($lname =~ s/ V$//i) {
      $gen = '5';
    }
    if ($lname eq '') {
      print ERROR "Bad name in master file: $fields[0] ($fields[1] $fields[2])\n";
      $lname = 'Missing Last Name';
    }
    if ($fmname =~ m/\(([^)]*)\)/) {
      $aname = $fmname;
      $fmname = $1;
    }
    $fmname =~ s/\([^)]*\)//g;
    $fmname =~ s/[^-[:alpha:]' ]//g;
    $fmname =~ s/^[-' ]+//g;
    $fmname =~ s/[-' ]+$//g;
    $fmname =~ s/([-' ])[-' ]+/$1/g;
    $aname =~ s/\([^)]*\)//g;
    $aname =~ s/[^-[:alpha:]' ]//g;
    $aname =~ s/^[-' ]+//g;
    $aname =~ s/[-' ]+$//g;
    $aname =~ s/([-' ])[-' ]+/$1/g;
    $areaid =~ s/[^-ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz[:digit:].]//g;
    if ($areaid =~ m/^\d+(\.(\d\d?)?)?$/) {
      if ($areaid =~ m/\.0+$/) {
        print ERROR "Non-standard version of AREA ID \"$fields[0]\" ($fields[1] $fields[2]) in masterfile.\n";
      }
      $areaid = sprintf('%08.2f', $areaid);
      $areaid =~ s/\.00$//;
    }
    if ($areaid !~ m/^[ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz[:digit:]]+(\.[0-9]{2,})?$/ || $areaid =~ m/^\d+\.\d{3,3}$/) {
      print ERROR "Bad AREA ID \"$fields[0]\" ($fields[1] $fields[2]) in master file.\n";
      next;
    }
    $displayid{uc($areaid)} = $areaid;
    $areaid = uc($areaid);
    $lname{$areaid} = $lname;
    $fmname{$areaid} = $fmname;
    $aname{$areaid} = $aname;
    $gen{$areaid} = $gen;
    $genlab{$areaid} = $genlab;
    if (!defined($chkid{$areaid})) {
      $chkid{$areaid} = {};
    }
    else {
      print ERROR "Duplicate master file entry for $areaid.\n";
    }
    $chkid{$areaid}{"$lname,$gen,$genlab,$fmname,$aname"} .= ' Master';
    if (!defined($chkname{"$lname,$gen,$genlab,$fmname,$aname"})) {
      $chkname{"$lname,$gen,$genlab,$fmname,$aname"} = {};
    }
    $chkname{"$lname,$gen,$genlab,$fmname,$aname"}{$areaid} .= ' Master';
    $master{$areaid} = "$lname,$gen,$genlab,$fmname,$aname";
  }
  close(MASTER);
}

$result = $conn->exec("begin");
if ($result->resultStatus != PGRES_COMMAND_OK) {
  print "Unable to begin a transaction.\n";
  print $conn->errorMessage, "\n";
  exit(0);
}

$result = $conn->exec("delete from cname");
if ($result->resultStatus != PGRES_COMMAND_OK) {
  print "Unable to delete cname.\n";
  print $conn->errorMessage, "\n";
  $result = $conn->exec("rollback");
  exit(0);
}

$result = $conn->exec("copy cname (areaid, displayid, lname, fmname, aname, gen, genlab, privacy, touched)  from stdin delimiters '\t' with null as ''");
foreach $areaid (keys %lname) {
  $priv = 'web';
  $priv = 'admin' if defined($anon{$areaid});
  $line = "$areaid\t$displayid{$areaid}\t$lname{$areaid}\t$fmname{$areaid}\t$aname{$areaid}\t$gen{$areaid}\t$genlab{$areaid}\t$priv\tnow\n";
  $line =~ s/\\/\\\\/g;
  if (($ret = $conn->putline($line)) != 0) {
    print "Unable to load the cname table (row-$ret).\n";
    print $conn->errorMessage, "\n";
    print $line;
    $result = $conn->exec("rollback");
    exit(0);
  }
}
if (($ret = $conn->putline("\\.\n")) != 0) {
  print "Unable to load the cname table (final-$ret).\n";
  print $conn->errorMessage, "\n";
  $result = $conn->exec("rollback");
  exit(0);
}
if (($ret = $conn->endcopy) != 0) {
  print "Unable to load the cname table (endcopy-$ret).\n";
  print $conn->errorMessage, "\n";
  $result = $conn->exec("rollback");
  exit(0);
}

$result = $conn->exec("commit");
if ($result->resultStatus != PGRES_COMMAND_OK) {
  print "Unable to commit the transaction.\n";
  print $conn->errorMessage, "\n";
  $result = $conn->exec("rollback");
  exit(0);
}

print "Tables loaded.\n";

$result = $conn->exec("vacuum analyze");
if ($result->resultStatus != PGRES_COMMAND_OK) {
  print "Vacuum analyze didn't run correctly.\n";
  print $conn->errorMessage, "\n";
}

print "Vacuum Analyze completed.\n";

foreach $areaid (sort keys %anon) {
  if (!defined($lname{$areaid})) {
    print ERROR "Anonymous AREA ID, \"$areaid\", not in use.\n";
  }
}

foreach $areaid (sort keys %chkid) {
  if (scalar(keys(%{$chkid{$areaid}})) > 1) {
    print ERROR "Multiple names for AREA ID $areaid.\n";
    foreach $name (sort keys %{$chkid{$areaid}}) {
      print ERROR "  \"$name\"  In:$chkid{$areaid}{$name}\n";
    }
  }
}

foreach $name (sort keys %chkname) {
  if (scalar(keys(%{$chkname{$name}})) > 1) {
    print ERROR "Multiple AREA IDs for name \"$name\" (warning only).\n";
    foreach $areaid (sort keys %{$chkname{$name}}) {
      print ERROR "  $areaid  In:$chkname{$name}{$areaid}\n";
    }
  }
}

close(ERROR);

print "See errors.txt for non-fatal errors report.\n";