#!/usr/bin/perl

# Display AREA rating data for a person.
# 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 '?'. Also note that '/'s don't really work at all
# since the server has a special check for / (encoded as %2F) in a component.

# Use unbuffered output as there are some long delays while doing queries
use CGI qw(utf8);
use open ':encoding(utf8)';
binmode STDOUT, ":utf8";

select(STDOUT);
$| = 1;

$" = '';

use Pg;

$time = time;

# 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;

# +s in the query part are really spaces
$uri = $ENV{REQUEST_URI};
if ($uri =~ m/^([^?]*\?)(.*)$/) {
  $uri = $1;
  $temp = $2;
  $temp =~ s/\+/ /g;
  $uri .= $temp;
}
$uri = urldecode($uri);

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;
}

$ENV{SCRIPT_NAME} =~ s%\?.*$%%;
$ENV{SCRIPT_NAME} =~ s%[^/]*$%%;
$script = $ENV{SCRIPT_NAME};
$script = urldecode($script);
# The length check is to protect against buffer overrun attacks.
if (length($uri) > 1000 || $uri !~ m/^\Q$script\E(P|U)_([\040-\176]*)\.html$/) {
  $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.
</body></html>
EOF
  exit;
}

$type = $1;
$areaid = uc($2);

# Check if encoding is safe, otherwise browsers might mess up relative links
$check = $ENV{REQUEST_URI};
for ($i=0; $i<length($script); $i++) {
  if ($check !~ s/^%[0-9A-Za-z]{2}//) {
    $check =~ s/^.//;
  }
}
$check =~ s/\%[0-9A-Za-z]{2}//g;
if ($check =~ m/[^-_A-Za-z0-9.+!*'()$,]/) {
  $loc = 'http://' . $ENV{SERVER_NAME} . $ENV{SCRIPT_NAME} . $type . '_' . urlencode($areaid) . '.html';
  $cloc = clean($loc);
  print <<"EOF";
content-type: text/html; charset=UTF-8
Status: 301
Location: $loc

<html><head>
<title>301 moved permanently</title>
</head><body>
<h1>301 moved permanently</h1>
Improperly escaped URL. Use <a href="$cloc">$cloc</a> instead.
</body></html>
EOF
  exit;
}

# Quotes and backslashes need to be quoted before using in a pg string constant
$qareaid = $areaid;
$qareaid =~ s/\\|'/\\$&/g;
$areaid = clean($areaid);

# First try to connect
$conn = Pg::connectdb('dbname=area');
if ($conn->status != PGRES_CONNECTION_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 connect to the database.
</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;
}

$result = $conn->exec("select lname, fmname, aname, coalesce(genlab, to_char(gen, 'FMRN')), displayid from cname_web where areaid = '$qareaid'");
if ($result->resultStatus != PGRES_TUPLES_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 access the player table.
</body></html>
EOF
  exit;
}
if ($result->ntuples != 1 || !(@row = $result->fetchrow)) {
  $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.
No such AREA ID.
</body></html>
EOF
  exit;
}

if (!defined($row[0])) {
  $name = '* Name Withheld *';
}
else {
  $name = $row[0];
  if (defined($row[3])) {
    $name .= ' ' . $row[3];
  }
  if (defined($row[1])) {
    if (defined($row[2])) {
      $name = $row[2] . ' (' . $row[1] . ') ' . $name;
    }
    else {
      $name = $row[1] . ' ' . $name;
    }
  }
  elsif (defined($row[2])) {
    $name = $row[2] . ' ' . $name;
  }
}

$name = clean($name);
$name = eval qq{"$name"};
utf8::decode($name);
print <<"EOF";
content-type: text/html; charset=UTF-8

<html>
<head>
<title>AREA Ratings for $row[4]: $name</title>
</head>
<body>
EOF
{
    local *INPUT;
    if (open(INPUT, "links.html")) {
        print while (<INPUT>);
        close INPUT;
    }
} 
print << "EOF";
<h1><a name="_">AREA Ratings for $row[4]: $name</a></h1>
EOF

if ($type eq 'U') {
  print "<a href=\"P_$areaid.html#_\">Switch to alphabetical ordering.</a>\n";
  $result = $conn->exec("select games.gameid, title, rate, frq, opp, rmp, trn, rmc, to_char(crate.touched,'YYYY-MM-DD'), to_char(games.touched,'YYYY-MM-DD') from games, crate where games.gameid = crate.gameid and areaid = '$qareaid' and crate.touched > ((timestamp 'epoch' + '$time second') + '12 year ago') and (frq > 0 or crate.touched > ((timestamp 'epoch' + '$time second') + '4 year ago')) order by games.touched desc, lower(title), games.gameid");
}
else {
  print "<a href=\"U_$areaid.html#_\">Switch to most recently modified ordering.</a>\n";
  $result = $conn->exec("select games.gameid, title, rate, frq, opp, rmp, trn, rmc, to_char(crate.touched,'YYYY-MM-DD'), to_char(games.touched,'YYYY-MM-DD') from games, crate where games.gameid = crate.gameid and areaid = '$qareaid' and crate.touched > ((timestamp 'epoch' + '$time second') + '12 year ago') and (frq > 0 or crate.touched > ((timestamp 'epoch' + '$time second') + '4 year ago')) order by lower(title), games.gameid");
}
if ($result->resultStatus != PGRES_TUPLES_OK) {
  print <<"EOF";
Unable to retrieve game information from 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;
}
if ($result->ntuples <= 0) {
  print <<"EOF";
<p>
No rating or interest information found for this person.
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;
}

print <<"EOF";
<p>
<table><col align="left"><col align="right" span="6"><col align="left" span="2">
<thead><tr><th>Title<th>Rating<th>Frequency<th>Opponents<th>Remote play<th>Tournaments<th>Remote Competitions<th>Active date<th>Last updated<tbody>
EOF
while (@row = $result->fetchrow) {
  $title = clean($row[1]);
  $gameid = clean($row[0]);
  $id = clean(urlencode($row[0]));
  if ($row[3] > 0) {
    print "<tr><td><a name=\"$gameid\" href=\"G_$id.html#$areaid\">$title</a><td>$row[2]<td>$row[3]<td>$row[4]<td>$row[5]<td>$row[6]<td>$row[7]<td>$row[8]<td>$row[9]\n";
  }
  else {
    print "<tr><td><a name=\"$gameid\" href=\"G_$id.html#$areaid\">$title</a><td>Interested<td><td><td><td><td><td>$row[8]<td>$row[9]\n";
  }
}
print << "EOF";
</table>
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
