#!/usr/bin/perl -w # # amisigornot: # Vote on sigs. # # Copyright (c) 2004 Chris Lightfoot. All rights reserved. # Email: chris@ex-parrot.com; WWW: http://www.ex-parrot.com/~chris/ # my $rcsid = ''; $rcsid .= '$Id: amisigornot,v 1.8 2005/03/23 23:08:54 chris Exp $'; use strict; use DBI; use DBD::SQLite; use Error qw(:try); use CGI; use CGI::Fast; use HTML::Entities qw(encode_entities); =pod -- database schema create table sigs ( id integer not null primary key, sig text ); create table sessions ( id integer not null primary key, timewhen integer not null ); create table votes ( sigid integer not null, sessionid integer not null, vote integer, primary key(sigid, sessionid) ); =cut # select_single_row DBH STATEMENT [BINDVALS] # Return in list context the columns returned by performing STATEMENT on DBH # with BINDVALS. sub select_single_row ($$;@) { my ($dbh, $stmt, @binds) = @_; my $x = $dbh->selectall_arrayref($stmt, {}, @binds); throw Error::Simple("statement `$stmt' returned " . scalar(@$x) . " rows in select_single_row, should be 1") unless (@$x == 1); return @{$x->[0]}; } # select_single_value DBH STATEMENT [BINDVALS] # As select_single_row, but return in scalar context the single value returned. sub select_single_value ($$;@) { my ($dbh, $stmt, @binds) = @_; my @x = select_single_row($dbh, $stmt, @binds); throw Error::Simple("statement `$stmt' returned " . scalar(@x) . " columns in select_single_value, should be 1") unless (@x == 1); return $x[0]; } # new_url QUERY [PARAM VALUE]... # Return the URL of the QUERY, with the given changes to PARAMs. sub new_url ($%) { my ($q, %p) = @_; my $q2 = new CGI($q); foreach (keys %p) { if (!defined($p{$_})) { $q2->delete($_); } else { $q2->param($_, $p{$_}); } } return $q2->self_url(); } my $CT = 'text/html; charset=iso-8859-1'; sub html_head ($) { my ($title) = @_; encode_entities($title); # return < $title

$title

EOF } sub html_tail () { # XXX should add validate link.... return <

Am I Sig Or Not?
Copyright © 2004 Chris Lightfoot.

EOF } sub error_page ($$$) { my ($q, $short, $long) = @_; return html_head("Error: $short") . $q->p(encode_entities($long)) . html_tail(); } my $dbh = DBI->connect("dbi:SQLite:/home/chris/sigs/sigs.sqlite", undef, undef, { AutoCommit => 0, RaiseError => 1 }); while (my $q = new CGI::Fast) { try { my $sessionid = $q->cookie("amisigornot_sessionid"); if (defined($sessionid) && ($sessionid =~ /[^\d]/ || 1 != select_single_value($dbh, 'select count(*) from sessions where id = ?', $sessionid))) { $sessionid = undef; } if (!defined($sessionid)) { if ($q->param('c')) { print $q->header(-type => $CT), error_page($q, "You must enable cookies", "This application needs cookies to work. Sorry."); } else { # Create a new session. $dbh->do('insert into sessions (id, timewhen) values (NULL, ?)', {}, time); $sessionid = $dbh->func('last_insert_rowid'); $dbh->commit(); my $c = $q->cookie(-name => 'amisigornot_sessionid', -value => $sessionid, -expires => '+1000d', -path => '/'); print $q->redirect(-uri => new_url($q, 'c' => 1), -cookie => $c); } } else { my $sigid = $q->param('sigid'); my $vote = $q->param('vote'); my $view = $q->param('view'); my $all = $q->param('all'); $view = 0 if (!defined($view) or $view ne '1'); $all = 0 if (!defined($all) or $all ne '1'); print $q->header(-type => $CT), html_head("Am I Sig Or Not?"); if ($view) { # Show best/worst. print $q->p(q(These are the best and worst few quotes, according to other voters. Alternatively,), $q->a({href => new_url($q, view => undef, sigid => undef, vote => undef)}, "go back to voting") . "."), $q->h2("Best"), ""; my $best = $dbh->selectall_arrayref('select avg(vote), count(vote), sig from votes, sigs where sigs.id = votes.sigid group by sigid having count(vote) > 1 order by avg(vote) desc limit 15'); my $N = 1; foreach (@$best) { my ($score, $count, $sig) = @$_; printf '', $N++, $score + 1, encode_entities($sig); } print '
VoteQuote
%d%.2f
%s
'; print $q->h2("Worst"), ""; my $worst = $dbh->selectall_arrayref('select avg(vote), count(vote), sig from votes, sigs where sigs.id = votes.sigid group by sigid having count(vote) > 1 order by avg(vote) asc limit 15'); $N = 1; foreach (@$worst) { my ($score, $count, $sig) = @$_; printf '', $N++, $score + 1, encode_entities($sig); } print '
VoteQuote
%d%.1f
%s
'; } elsif ($all) { # Show all. print ""; my $all = $dbh->selectall_arrayref('select avg(vote), sig from votes, sigs where sigs.id = votes.sigid group by sigid order by avg(vote) desc'); my $N = 1; foreach (@$all) { my ($score, $sig) = @$_; printf '', $N++, $score + 1, encode_entities($sig); } print '
VoteQuote
%d%.2f
%s
'; } else { # Vote on sigs. print $q->p(q(Tell me what you think of the quotes in the list. Vote on a scale from 1 (worst) to 10 (best). You'll see how others voted once you've entered your vote. Alternatively, take a look at), $q->a({href => new_url($q, view => 1, sigid => undef, vote => undef)}, "the best and worst quotes according to other voters") . "."); # Select a random signature, biasing the choice towards those # with fewer votes. my $old_sigid = $sigid; my ($sigid, $count) = $dbh->selectrow_array( 'select id, count(v2.sessionid) from sigs left join votes, votes as v2 on sigs.id = votes.sigid where votes.sessionid = ? and votes.vote is null and sigs.id = v2.sigid group by id order by count(v2.sessionid) + 5 * (abs(random() / 2147483648.0)) limit 1', {}, $sessionid); # Ugh. # case where user has voted on all sigs. aargh! if (!defined($sigid)) { print "\n\n\n\n\n\n"; $sigid = $dbh->selectrow_array('select id from sigs order by random() limit 1') if (!defined($sigid)); } print $q->h2('Vote!'), $q->pre(encode_entities(select_single_value($dbh, 'select sig from sigs where id = ?', $sigid))), q(); for (my $i = 0; $i < 10; ++$i) { print q(); } print q(
worst), $q->start_form(), $q->hidden(-name => 'vote', -default => $i, -override => 1), $q->hidden(-name => 'sigid', -default => $sigid, -override => 1), $q->submit(-name => $i + 1, -value => $i + 1), $q->end_form(), q(best
); if (defined($old_sigid) and defined($vote)) { # If we have a signature and a vote, display the last one. throw Error::Simple("Bad sig parameter") unless (1 == select_single_value($dbh, 'select count(*) from sigs where id = ?', $old_sigid)); throw Error::Simple("Bad vote parameter") unless ($vote =~ /^[0-9]$/); $dbh->do('delete from votes where sessionid = ? and sigid = ?', {}, $sessionid, $old_sigid); $dbh->do('insert into votes (sessionid, sigid, vote) values (?, ?, ?)', {}, $sessionid, $old_sigid, $vote); $dbh->commit(); print $q->h2("Last sig"); my $x = $dbh->selectall_arrayref('select vote, count(sessionid) from votes where sigid = ? group by vote', {}, $old_sigid); my @votes = qw(0 0 0 0 0 0 0 0 0 0); my $max = 0; my $sum = 0; my $n = 0; foreach (@$x) { my ($v, $num) = @$_; $votes[$v] = $num; $sum += $num * $v; $n += $num; $max = $num if ($num > $max); } # Report these things as being 1-based.... my $mean = $sum / $n + 1; $vote += 1; $mean = sprintf("%.1f", $mean); print $q->p("Votes: $n; average $mean; your vote: $vote. Previous votes:"); print q() , map { "" } (1 .. 10) , ""; foreach (@votes) { printf q(), 150 * ($_ / $max) + 1; } print "
worst$_best
"; print $q->pre(encode_entities(select_single_value($dbh, 'select sig from sigs where id = ?', $old_sigid))); } } print html_tail(); } $dbh->rollback(); # DBD::SQLite bug. } catch Error::Simple with { my $E = shift; print $q->header(-type => $CT), error_page($q, "Application error", $E->text()); $dbh->rollback(); # DBD::SQLite bug. }; } $dbh->disconnect();