#!/usr/bin/perl # Display a title index of all games # 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/&/&/g; $str =~ s//>/g; $str =~ s/"/"/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 < 501 Method Not Implemented

Method Not Implemented

Method '$meth' not implented for $uri. EOF exit; } print <<"EOF"; content-type: text/html; charset=UTF-8 AREA Game Title Index

AREA Game Title 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 exit; } # Only one query is done so we don't need to set transaction isolation. $result = $conn->exec("select gameid, title from games order by lower(title), gameid"); if ($result->resultStatus != PGRES_TUPLES_OK) { print << "EOF"; Unable to access the games table. EOF exit; } if ($result->ntuples <= 0) { print << "EOF"; No games were found. EOF exit; } print "\n\n"; while (@row = $result->fetchrow) { $code = clean(urlencode($row[0])); $title = clean($row[1]); print "

Title
$title\n"; } print < EOF