#!/usr/bin/perl

# Display an index for retrieving spreadsheet friendly versions of the data
# Bruno Wolff III
# Last revised October 13, 2012

# While areaid and gameid can't currently contain any uri specials, I want
# assume they can here, so I if tweak the database schema, things don't
# break here. The problem characters that might eventually be allowed
# are '#', '/' and '?'.

# Use unbuffered output as there are some long delays while doing queries

select(STDOUT);
$| = 1;

$" = '';

use Pg;

# Use this to clean stuff extracted from the database for html output
sub clean(@) {
  local $str = "@_";
  $str =~ s/&/&amp;/g;
  $str =~ s/</&lt;/g;
  $str =~ s/>/&gt;/g;
  $str =~ s/"/&quot;/g;
  return $str;
}

# Use this to convert REQUEST_URI to unescaped string
sub urldecode(@) {
  local $str = "@_";
  $str =~ s/\%[0-9a-fA-F]{2}/$urldhash{$&}/eg;
  return $str;
}

# Use this to make sure urls don't contain url specials
sub urlencode(@) {
  local $str = "@_";
  $str =~ s/[^-_A-Za-z0-9.$+!*'(),]/$urlehash{$&}/eg;
  return $str;
}

# One time build of data used by url decode
sub urlinit() {
  my $c;
  my $f;
  my $i;
  for ($i=0; $i<=255; $i++) {
    $c = chr($i);
    $f = sprintf('%%%.2X', $i);
    $urldhash{$f} = $c;
    $urldhash{lc($f)} = $c;
    $urlehash{$c} = $f;
  }
}
urlinit;

if ($ENV{REQUEST_METHOD} ne '' && $ENV{REQUEST_METHOD} ne 'GET' &&
  $ENV{REQUEST_METHOD} ne 'HEAD') {
  $meth = clean($ENV{REQUEST_METHOD});
  $uri = clean($ENV{REQUEST_URI});
  print <<EOF;
content-type: text/html; charset=UTF-8
status: 501 Method not implemented

<html><head>
<title>501 Method Not Implemented</title>
</head><body>
<h1>Method Not Implemented</h1>
Method '$meth' not implented for $uri.
</body></html>
EOF
  exit;
}

print <<"EOF";
content-type: text/html; charset=UTF-8

<html>
<head>
<title>Spreadsheet friendly versions of the data</title>
</head>
<body>
EOF
{
    local *INPUT;
    if (open(INPUT, "links.html")) {
        print while (<INPUT>);
        close INPUT;
    }
} 
print << "EOF";
<h1><a name="_">Spreadsheet friendly versions of the data</a></h1>
EOF

# First try to connect
$conn = Pg::connectdb('dbname=area');
if ($conn->status != PGRES_CONNECTION_OK) {
  print << "EOF";
Unable to connect the AREA database.
EOF
{
    local *INPUT;
    if (open(INPUT, "links.html")) {
        print while (<INPUT>);
        close INPUT;
    }
} 
{
    local *INPUT;
    if (open(INPUT, "sig.html")) {
        print while (<INPUT>);
        close INPUT;
    }
} 
print << "EOF";
</body>
</html>
EOF
  exit;
}

$result = $conn->exec("begin");
if ($result->resultStatus != PGRES_COMMAND_OK) {
  $uri = clean($ENV{REQUEST_URI});
  print <<"EOF";
content-type: text/html; charset=UTF-8
status: 404 File Not Found

<html><head>
<title>404 File Not Found</title>
</head><body>
<h1>404 File Not Found</h1>
'$uri' not found.
Unable to start a transaction.
</body></html>
EOF
  exit;
}

$result = $conn->exec("set transaction isolation level serializable");
if ($result->resultStatus != PGRES_COMMAND_OK) {
  $uri = clean($ENV{REQUEST_URI});
  print <<"EOF";
content-type: text/html; charset=UTF-8
status: 404 File Not Found

<html><head>
<title>404 File Not Found</title>
</head><body>
<h1>404 File Not Found</h1>
'$uri' not found.
Unable to serialize transaction.
</body></html>
EOF
  exit;
}

print << "EOF";
<h2>Caveats</h2>
Note that data obtained from here has been "cleaned" by removing some
inconsistancies. However it is possible that the wrong choice was made
when doing that. Also suppressed names will show up as a last name
of "Withheld" and no first name. This data is publicly accessible, so
the names have to be suppressed here as well.
<p>
Ranking isn't needed so it isn't included. <em>Other interested players</em>
are not in the game sheets. A complete <a href="S_.tsv">list of other interested
players</a> is available separately.  There is no separate designation for
active, inactive, or expired people as that is determined by their active date.
People are listed in order by last name so you can find them.
<p>
The sheet names used will be the current internal game codes. They may not
always match the original sheet name sent in by the maintainer. There are
also some games that no one has a sheet for because they are WBC tournament
games for which we have never received any results.
<p>
Generating an excel file for all of the games can take a couple of minutes.
EOF

print "<h2>Combined game sheets in excel format</h2>\n";

print "<ol><li>Any admin\n";
print "<ol><li><a href=\"S__.xls\">ALL</a> - any game type\n";
$result = $conn->exec("select rtypes.rtype, descr from rtypes, games where rtypes.rtype = games.rtype group by rtypes.rtype, descr having count(*) > 0 order by lower(rtypes.rtype)");
if ($result->resultStatus == PGRES_TUPLES_OK) {
  while (@row = $result->fetchrow) {
    $type = clean($row[0]);
    $descr = clean($row[1]);
    print "<li><a href=\"S__$type.xls\">$type</a> - $descr\n";
  }
}

@contacts = ();
$result = $conn->exec("select contacts.contact from contacts, games where contacts.contact = games.contact group by contacts.contact having count(*) > 0 order by lower(contacts.contact)");
if ($result->resultStatus == PGRES_TUPLES_OK) {
  while (@row = $result->fetchrow) {
    push @contacts, $row[0];
  }
}

foreach $contact (@contacts) {
  $cc = clean($contact);
  $qcontact = $contact;
  $qcontact =~ s/\\|'/\\$&/g;
  print "</ol><li>$cc\n";
  print "<ol><li><a href=\"S_${cc}_.xls\">ALL</a> - any game type\n";
  $result = $conn->exec("select rtypes.rtype, descr from rtypes, games where rtypes.rtype = games.rtype and games.contact = '$qcontact' group by rtypes.rtype, descr having count(*) > 0 order by lower(rtypes.rtype)");
  if ($result->resultStatus == PGRES_TUPLES_OK) {
    while (@row = $result->fetchrow) {
      $type = clean($row[0]);
      $descr = clean($row[1]);
      print "<li><a href=\"S_${cc}_$type.xls\">$type</a> - $descr\n";
    }
  }
}

print "</ol></ol>\n";

print "<h2>Individual game sheets in tab separated values format</h2>\n";
$result = $conn->exec("select gameid, title from games order by lower(title)");
if ($result->resultStatus != PGRES_TUPLES_OK) {
  print "Unable to access the games table.\n"
}
elsif ($result->ntuples <= 0) {
  print "No games were found.\n";
}
else {
  print "<table><col>\n<thead><tr><th>Title<tbody>\n";
  while (@row = $result->fetchrow) {
    $code = clean(urlencode($row[0]));
    $title = clean($row[1]);
    print "<tr><td><a href=\"S_$code.tsv\">$title</a>\n";
  }
  print "</table>\n";
}

print <<EOF;
EOF
{
    local *INPUT;
    if (open(INPUT, "links.html")) {
        print while (<INPUT>);
        close INPUT;
    }
} 
{
    local *INPUT;
    if (open(INPUT, "sig.html")) {
        print while (<INPUT>);
        close INPUT;
    }
} 
print << "EOF";
</body>
</html>
EOF
