#!/usr/bin/perl # Display an Name index of all players # 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 use CGI qw(utf8); use open ':encoding(utf8)'; binmode STDOUT, ":utf8"; select(STDOUT); $| = 1; $" = ''; 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; $str = eval qq{"$str"}; utf8::decode($str); 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 501 Method Not Implemented

Method Not Implemented

Method '$meth' not implented for $uri. EOF exit; } print < AREA Player by Name Index EOF { local *INPUT; if (open(INPUT, "links.html")) { print while (); close INPUT; } } print << "EOF";

AREA Player by Name Index

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 (); close INPUT; } } { local *INPUT; if (open(INPUT, "sig.html")) { print while (); close INPUT; } } print << "EOF"; EOF exit; } # Only one query is done so we don't need to set transaction isolation $result = $conn->exec("select areaid, lname, fmname, aname, coalesce(genlab, to_char(gen, 'FMRN')), displayid from cname_web order by lower(lname), lower(coalesce((aname || ' ') || fmname, fmname, aname)), gen, genlab, areaid"); if ($result->resultStatus != PGRES_TUPLES_OK) { print << "EOF"; Unable to access the cname_web table. EOF { local *INPUT; if (open(INPUT, "links.html")) { print while (); close INPUT; } } { local *INPUT; if (open(INPUT, "sig.html")) { print while (); close INPUT; } } print << "EOF"; EOF exit; } if ($result->ntuples <= 0) { print << "EOF"; No members were found. EOF { local *INPUT; if (open(INPUT, "links.html")) { print while (); close INPUT; } } { local *INPUT; if (open(INPUT, "sig.html")) { print while (); close INPUT; } } print << "EOF"; EOF exit; } print "\n\n"; while (@row = $result->fetchrow) { $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[2]; } } $name = clean($name); $id = clean(urlencode($areaid)); print "
AREA IDName
$row[5]$name$date\n"; } print << "EOF";
EOF { local *INPUT; if (open(INPUT, "links.html")) { print while (); close INPUT; } } { local *INPUT; if (open(INPUT, "sig.html")) { print while (); close INPUT; } } print << "EOF"; EOF