#!/usr/bin/perl
# Search AREA members by name or AREA ID or games by title.
# Bruno Wolff III
# Last revised October 20,2012
use utf8;
use feature 'unicode_strings';
use open ':encoding(utf8)';
use POSIX qw(locale_h);
setlocale(LC_ALL, "en_US.utf8");
# Flush output immediately as database lookups can cause delays.
select(STDOUT);
$| = 1;
# Prevent ridiculously large requests from causing problems.
$MAXPOST = 10000;
# Turn off space seperators when including arrays in quoted text.
$" = '';
use Pg;
# Use this to clean stuff extracted from the database for html output
sub clean(@) {
local $str = "@_";
$str =~ s/&/&/g;
$str =~ s//>/g;
$str =~ s/"/"/g;
return $str;
}
# Use this to convert REQUEST_URI to unescaped string
sub urldecode(@) {
local $str = "@_";
$str =~ s/\%[[:digit:]abcdefABCDEF]{2}/$urldhash{$&}/eg;
return $str;
}
# Use this to make sure urls don't contain url specials
sub urlencode(@) {
local $str = "@_";
$str =~ s/[^-_abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ[:digit:].$+!*(),]/$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;
$urldhash{lc($f)} = '' if $i > 127;
$urlehash{$c} = $f;
}
}
urlinit;
# Get paramters.
if ($ENV{REQUEST_METHOD} eq 'POST') {
$ENV{QUERY_STRING} = '';
if ($ENV{CONTENT_LENGTH} =~ m/^\d+$/ && $ENV{CONTENT_LENGTH} >= 0 &&
$ENV{CONTENT_LENGTH} <= $MAXPOST &&
lc($ENV{CONTENT_TYPE}) eq 'application/x-www-form-urlencoded') {
if (read(STDIN, $ENV{QUERY_STRING}, $ENV{CONTENT_LENGTH}) !=
$ENV{CONTENT_LENGTH}) {
$ENV{QUERY_STRING} = '';
}
}
}
elsif ($ENV{REQUEST_METHOD} eq '') {
$ENV{QUERY_STRING} = '';
}
elsif ($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
501 Method Not Implemented
Method Not Implemented
Method '$meth' not implented for '$uri'.
EOF
exit;
}
$ENV{QUERY_STRING} =~ s/\+/ /g;
foreach $s (split('&', $ENV{QUERY_STRING})) {
my $s1;
my $s2;
next if $s eq '';
if ($s =~ m/\=/) {
$s1 = $`;
$s2 = $';
$par{urldecode($s1)} .= urldecode($s2);
}
else {
$par{urldecode($s)} .= '';
}
}
$keywords = clean($par{keywords});
utf8::decode($par{keywords});
$uri = $ENV{REQUEST_URI};
$uri =~ s%\?.*$%%;
$uri =~ s%^.*/%%;
print << "EOF";
content-type: text/html; charset=UTF-8
Search AREA for members by name or AREA ID or games by title
EOF
# Only one query is done so we don't need to set transaction isolation.
if (defined($par{namefull})) {
print "Member name search results (using full word matching)
\n";
$conn = Pg::connectdb('dbname=area client_encoding=UTF8');
if ($conn->status != PGRES_CONNECTION_OK) {
print "Unable to connect the AREA database.\n";
}
else {
$s = '';
$j = 'where';
foreach $word (split(/[^[:graph:]]+/, $par{keywords})) {
next if $word eq '';
$word =~ s/[^[:graph:]]//g;
$word =~ s/[^[:alnum:]]/\\$&/g;
$word =~ s/\\|\'/\\$&/g;
$s .= " $j (lname ~* '(^| )$word( |\$)' or fmname ~* '(^| )$word( |\$)' or aname ~* '(^| )$word( |\$)' or coalesce(genlab, to_char(gen, 'FMRN')) ~* '(^| )$word( |\$)')";
$j = 'and';
}
$result = $conn->exec("select areaid, lname, fmname, aname, coalesce(genlab, to_char(gen, 'FMRN')) from cname_web $s order by lower(lname), lower(coalesce((aname || ' ') || fmname, fmname, aname)), gen, genlab, areaid");
if ($result->resultStatus != PGRES_TUPLES_OK) {
print "Unable to access the cname_web table.\n";
print "select areaid, lname, fmname, aname, coalesce(genlab, to_char(gen, 'FMRN')) from cname_web $s order by lower(lname), lower(coalesce((aname || ' ') || fmname, fmname, aname)), gen, genlab, areaid\n";
}
elsif ($result->ntuples <= 0) {
print "No members with matching names were found.\n";
}
else {
print "\n| AREA ID | Name |
|---|
\n";
while (@row = $result->fetchrow) {
$id = clean(urlencode($row[0]));
$areaid = clean($row[0]);
if (!defined($row[1])) {
$name = '* Name Withheld *';
}
else {
$name = $row[1];
if (defined($row[4])) {
$name .= ' ' . $row[4];
}
if (defined($row[2])) {
if (defined($row[3])) {
$name .= ', ' . $row[3] . ' (' . $row[2] . ')';
}
else {
$name .= ', ' . $row[2];
}
}
elsif (defined($row[3])) {
$name .= ', ' . $row[3];
}
}
$name = clean($name);
print "| $areaid | $name\n";
}
print " |
\n";
}
}
}
elsif (defined($par{namepre})) {
print "Member name search results (using word prefix matching)
\n";
$conn = Pg::connectdb('dbname=area');
if ($conn->status != PGRES_CONNECTION_OK) {
print "Unable to connect the AREA database.\n";
}
else {
$s = '';
$j = 'where';
foreach $word (split(/[^[:graph:]]+/, $par{keywords})) {
next if $word eq '';
$word =~ s/[^[:graph:]]//g;
$word =~ s/[^[:alnum:]]/\\$&/g;
$word =~ s/\\|\'/\\$&/g;
$s .= " $j (lname ~* '(^| )$word' or fmname ~* '(^| )$word' or aname ~* '(^| )$word' or coalesce(genlab, to_char(gen, 'FMRN')) ~* '(^| )$word')";
$j = 'and';
}
$result = $conn->exec("select areaid, lname, fmname, aname, coalesce(genlab, to_char(gen, 'FMRN')) from cname_web $s order by lower(lname), lower(coalesce((aname || ' ') || fmname, fmname, aname)), gen, genlab, areaid");
if ($result->resultStatus != PGRES_TUPLES_OK) {
print "Unable to access the cname_web table.\n";
}
elsif ($result->ntuples <= 0) {
print "No members with matching names were found.\n";
}
else {
print "\n\n\n| AREA ID | Name\n |
|---|
\n";
while (@row = $result->fetchrow) {
$id = clean(urlencode($row[0]));
$areaid = clean($row[0]);
if (!defined($row[1])) {
$name = '* Name Withheld *';
}
else {
$name = $row[1];
if (defined($row[4])) {
$name .= ' ' . $row[4];
}
if (defined($row[2])) {
if (defined($row[3])) {
$name .= ', ' . $row[3] . ' (' . $row[2] . ')';
}
else {
$name .= ', ' . $row[2];
}
}
elsif (defined($row[3])) {
$name .= ', ' . $row[3];
}
}
$name = clean($name);
print "| $areaid | $name\n";
}
print " |
\n";
}
}
}
elsif (defined($par{gamefull})) {
print "Title search results (using full word matching)
\n";
$conn = Pg::connectdb('dbname=area');
if ($conn->status != PGRES_CONNECTION_OK) {
print "Unable to connect the AREA database.\n";
}
else {
$s = '';
$j = 'where';
foreach $word (split(/[^[:graph:]]+/, $par{keywords})) {
next if $word eq '';
$word =~ s/[^[:graph:]]//g;
$word =~ s/[^[:alnum:]]/\\$&/g;
$word =~ s/\\|\'/\\$&/g;
$s .= " $j title ~* '(^| )$word( |\$)'";
$j = 'and';
}
$result = $conn->exec("select gameid, title from games $s 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 with matching titles were found.\n";
}
else {
print "\n\n\n| Title\n |
|---|
\n";
while (@row = $result->fetchrow) {
$code = clean(urlencode($row[0]));
$title = clean($row[1]);
print "| $title\n";
}
print " |
\n";
}
}
}
elsif (defined($par{gamepre})) {
print "Title search results (using word prefix matching)
\n";
$conn = Pg::connectdb('dbname=area');
if ($conn->status != PGRES_CONNECTION_OK) {
print "Unable to connect the AREA database.\n";
}
else {
$s = '';
$j = 'where';
foreach $word (split(/[^[:graph:]]+/, $par{keywords})) {
next if $word eq '';
$word =~ s/[^[:graph:]]//g;
$word =~ s/[^[:alnum:]]/\\$&/g;
$word =~ s/\\|\'/\\$&/g;
$s .= " $j title ~* '(^| )$word'";
$j = 'and';
}
$result = $conn->exec("select gameid, title from games $s 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 with matching titles were found.\n";
}
else {
print "\n\n\n| Title\n |
|---|
\n";
while (@row = $result->fetchrow) {
$code = clean(urlencode($row[0]));
$title = clean($row[1]);
print "| $title\n";
}
print " |
\n";
}
}
}
elsif (defined($par{idfull})) {
print "Member AREA ID search results (using full word matching)
\n";
$conn = Pg::connectdb('dbname=area');
if ($conn->status != PGRES_CONNECTION_OK) {
print "Unable to connect the AREA database.\n";
}
else {
$s = '';
$j = 'where';
foreach $word (split(/[^[:graph:]]+/, $par{keywords})) {
next if $word eq '';
$word =~ s/[^[:graph:]]//g;
$word =~ s/[^[:alnum:]]/\\$&/g;
$word =~ s/\\|\'/\\$&/g;
$s .= " $j areaid ~* '(^| )$word( |\$)'";
$j = 'and';
}
$result = $conn->exec("select areaid, lname, fmname, aname, coalesce(genlab, to_char(gen, 'FMRN')) from cname_web $s order by areaid");
if ($result->resultStatus != PGRES_TUPLES_OK) {
print "Unable to access the cname_web table.\n";
}
elsif ($result->ntuples <= 0) {
print "No members with matching AREA IDs were found.\n";
}
else {
print "\n\n\n| AREA ID | Name\n |
|---|
\n";
while (@row = $result->fetchrow) {
$id = clean(urlencode($row[0]));
$areaid = clean($row[0]);
if (!defined($row[1])) {
$name = '* Name Withheld *';
}
else {
$name = $row[1];
if (defined($row[4])) {
$name .= ' ' . $row[4];
}
if (defined($row[2])) {
if (defined($row[3])) {
$name .= ', ' . $row[3] . ' (' . $row[2] . ')';
}
else {
$name .= ', ' . $row[2];
}
}
elsif (defined($row[3])) {
$name .= ', ' . $row[3];
}
}
$name = clean($name);
print "| $areaid | $name\n";
}
print " |
\n";
}
}
}
elsif (defined($par{idpre})) {
print "Member AREA ID search results (using word prefix matching)
";
$conn = Pg::connectdb('dbname=area');
if ($conn->status != PGRES_CONNECTION_OK) {
print "Unable to connect the AREA database.\n";
}
else {
$s = '';
$j = 'where';
foreach $word (split(/[^[:graph:]]+/, $par{keywords})) {
next if $word eq '';
$word =~ s/[^[:graph:]]//g;
$word =~ s/[^[:alnum:]]/\\$&/g;
$word =~ s/\\|\'/\\$&/g;
$s .= " $j areaid ~* '(^| )$word'";
$j = 'and';
}
$result = $conn->exec("select areaid, lname, fmname, aname, coalesce(genlab, to_char(gen, 'FMRN')) from cname_web $s order by areaid");
if ($result->resultStatus != PGRES_TUPLES_OK) {
print "Unable to access the cname_web table.\n";
}
elsif ($result->ntuples <= 0) {
print "No members with matching AREA IDs were found.\n";
}
else {
print "\n\n\n| AREA ID | Name\n |
|---|
\n";
while (@row = $result->fetchrow) {
$id = clean(urlencode($row[0]));
$areaid = clean($row[0]);
if (!defined($row[1])) {
$name = '* Name Withheld *';
}
else {
$name = $row[1];
if (defined($row[4])) {
$name .= ' ' . $row[4];
}
if (defined($row[2])) {
if (defined($row[3])) {
$name .= ', ' . $row[3] . ' (' . $row[2] . ')';
}
else {
$name .= ', ' . $row[2];
}
}
elsif (defined($row[3])) {
$name .= ', ' . $row[3];
}
}
$name = clean($name);
print "| $areaid | $name\n";
}
print " |
\n";
}
}
}
print << "EOF";
EOF