#!/usr/bin/perl # Build index of links for "Boardgamer" use. # 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 Custom AREA Game Index for Boardgamer staff

Custom AREA Game Index for Boardgamer staff

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 games.gameid, title, to_char(games.touched, 'FMMonth DD, YYYY'), count(*) as total, count(case when rate > 5000 then 1 end) as ranked from games, crate where games.gameid = crate.gameid and frq > 0 and crate.touched >= (timestamp 'now' + '4 year ago') group by games.gameid, games.title, games.touched having count(case when rate > 5000 then 1 end) > 0 order by games.touched desc, ranked desc, total desc, lower(title)"); 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	>5000	Active	Date
$title	$row[4]	$row[3]	$row[2]\n"; } print < EOF