<![CDATA[#!/usr/bin/perl
################ Poll
#
# Copyright 1999 by Greg Billock
# Distributed under GPL
#
# Reads poll data file and constructs HTML from it
#
# Call with ?poll=filename to print the file for that particular
# poll.
#
# Call with ?action=index to print the index of all polls.
#
# Call with ?action=display to print results (not vote form)
#
# Call with ?action=ballot to display the ballot form
#
# Call with ?action=vote to register the vote
#
# Call with ?action=addform to add a new poll
#
# Call with ?action=briefdisplay for SSI-type display
# Call with ?action=briefballot for SSI-type ballot
###########################
# configuration section #
$polldatafile = "polls.txt";
$selfurl = "http://yoursite.com/cgi-bin/poll.pl";
$password = "yourpassword";
$title = "CGI Polls";
$bodystyle = "<BODY BGCOLOR=\"#ffffff\">";
####################
#execution starts
&readparam;
$pollname = $cgiVals{'poll'};
$action = $cgiVals{'action'};
#read in universal data file
&readdatafile;
$pollfile = $allpollfiles{$pollname};
if ($pollfile) {
$datafile = $pollfile;
&readpollfile;
}
if ($action eq "") {
$action = "index";
}
if ($action eq 'index') {
&printhtmlhead;
&printindex;
&printhtmlfoot;
}
if ($action eq 'display') {
&printhtmlhead;
&printdisplay;
&printhtmlfoot;
}
if ($action eq 'ballot') {
&printhtmlhead;
&printballot;
&printhtmlfoot;
}
if ($action eq 'vote') {
&printhtmlhead;
&printvoteresult;
&printhtmlfoot;
}
if ($action eq 'briefdisplay') {
&printack;
&printbriefdisplay;
}
if ($action eq 'briefballot') {
&printack;
&printbriefballot;
}
if ($action eq 'addform') {
&printhtmlhead;
&printaddform;
&printhtmlfoot;
}
if ($action eq 'addpoll') {
&printhtmlhead;
&processaddform;
&printhtmlfoot;
}
if ($action eq 'admin') {
&printhtmlhead;
&printadminform;
&printhtmlfoot;
}
########## end execution #######
# printadminform
# Prints the form used to change statuses
sub printadminform {
&procadmin;
print <<EndOfHTML;
<H1>Polls Admin</H1>
<HR>
<H3>
<A HREF="$selfurl?action=addform">Add a New Poll</A></H3>
<HR>
<H3>Administer existing polls</H3>
<FORM ACTION="$selfurl" METHOD="post">
<INPUT TYPE="hidden" NAME="action" VALUE="admin">
<TABLE BORDER=1 CELLPADDING=5>
EndOfHTML
;
foreach $pname (@allpollnames) {
#name
print "<TR>";
print "<TD><B>$allpolltitles{$pname}</B></TD>\n";
#active/inactive/delete
if ($allpollstatus{$pname} eq 'active') {
print "<TD>\n";
print "<INPUT TYPE=\"radio\" NAME=\"$pname\" VALUE=\"activate\" CHECKED>Activate<BR>\n";
print "<INPUT TYPE=\"radio\" NAME=\"$pname\" VALUE=\"deactivate\">De-Activate<BR>\n";
print "<INPUT TYPE=\"radio\" NAME=\"$pname\" VALUE=\"delete\">Delete\n";
print "</TD>\n";
}
else {
print "<TD>\n";
print "<INPUT TYPE=\"radio\" NAME=\"$pname\" VALUE=\"activate\">Activate<BR>\n";
print "<INPUT TYPE=\"radio\" NAME=\"$pname\" VALUE=\"deactivate\" CHECKED>De-Activate<BR>\n";
print "<INPUT TYPE=\"radio\" NAME=\"$pname\" VALUE=\"delete\">Delete\n";
print "</TD>\n";
}
#view results
print "<td ALIGN=CENTER>\n";
print "<A HREF=\"$selfurl?action=display&poll=$pname\">[View Results]</A></td>\n";
print "</TR>\n\n";
}
print "</TABLE><P>\n";
print "Password: \n";
print "<INPUT TYPE=\"text\" NAME=\"submitpass\"><P>";
print "<INPUT TYPE=\"SUBMIT\" VALUE=\"Submit\"><BR>";
print "</FORM>\n";
print "<P><HR><P>\n";
print "<A HREF=\"$selfurl\"><I>Go to index</I></A>";
}
sub procadmin {
$submitpass = $cgiVals{'submitpass'};
if ($submitpass ne $password) {
return;
}
#figure out commands....
@newpollnames = ();
foreach $pname (@allpollnames) {
$command = $cgiVals{$pname};
if ($command eq 'activate') {
$allpollstatus{$pname} = "active";
@newpollnames = (@newpollnames, $pname);
}
if ($command eq 'deactivate') {
$allpollstatus{$pname} = "inactive";
@newpollnames = (@newpollnames, $pname);
}
if ($command eq 'delete') {
delete $allpollstatus{$pname};
delete $allpolltitles{$pname};
delete $allpollfiles{$pname};
}
}
@allpollnames = @newpollnames;
&writedatafile;
}
# printaddform
# Prints the form used to add a poll
sub printaddform {
print <<EndOfHTML;
<H1>Add a new poll</H1>
<FORM ACTION="$selfurl" METHOD="post">
<INPUT TYPE="hidden" NAME="action" VALUE="addpoll">
Poll name (one word):
<INPUT TYPE="text" NAME="newpoll" SIZE=20><P>
Poll title:
<INPUT TYPE="text" NAME="title" SIZE=40><P>
Poll filename:
<INPUT TYPE="text" NAME="filename" SIZE=20><P>
Poll question:
<INPUT TYPE="text" NAME="question" SIZE=50><P>
Poll selection options (one per line):<BR>
<TEXTAREA NAME="options" ROWS=6 COLS=50>
</TEXTAREA>
<P>
<HR>
<P>
Password:
<INPUT TYPE="text" NAME="submitpass" SIZE=20><P>
<INPUT TYPE="submit" VALUE="Add New Poll">
</FORM>
EndOfHTML
;
}
# processaddform
# Prints ack for processing the add-poll form
sub processaddform {
$pollname=$cgiVals{'newpoll'};
$polltitle = $cgiVals{'title'};
$datafile = $cgiVals{'filename'};
$pollquestion= $cgiVals{'question'};
$newpolloptions = $cgiVals{'options'};
$submitpass = $cgiVals{'submitpass'};
if ($submitpass ne $password) {
print "<H1>Sorry, password incorrect. No changes recorded.</H1>\n";
return;
}
@options = split(/\n/,$newpolloptions);
@polloptions = (" ", @options);
$pollnumoptions = scalar(@polloptions) - 1;
for ($i=1; $i<=$pollnumoptions; $i++) {
$pollvotes[$i] = 0;
}
#write the new data to the new file
&writepollfile;
open(DATA, ">>$polldatafile");
print (DATA "name=$pollname\n");
print (DATA "title=$polltitle\n");
print (DATA "file=$datafile\n");
print (DATA "status=active\n");
close(DATA);
#ack to user
print "<H1>Changes recorded!</H1>\n";
print "To view new poll, click ";
print "<A HREF=\"$selfurl?poll=$pollname&action=display\">here</A><P>";
}
# printvoteresult
# Prints a display of a poll file after recording vote
sub printvoteresult {
$votedoption = $cgiVals{'option'};
$pollvotes[$votedoption]++;
$tally++;
&writepollfile;
&printdisplay;
}
#printindex
# Prints an index of all polls registered
sub printindex {
&readdatafile;
print <<EndOfHTML;
<h1>$title</h1>
<hr ALIGN=LEFT WIDTH="100%">
<br>
<center><table BORDER=4 CELLPADDING=10 COLS=1>
<tr>
<td>
<center>
<h2>
Current polls:</h2></center>
<center><table BORDER=0 CELLSPACING=5 CELLPADDING=5 WIDTH="90%" >
EndOfHTML
;
#print first item specially
$firstpoll = shift(@allpollnames);
$curpollbgcolor = "#FFCCFF";
print "<tr>\n";
print "<td BGCOLOR=\"$curpollbgcolor\"><b>$allpolltitles{$firstpoll}</b></td>\n";
print "<td ALIGN=CENTER BGCOLOR=\"$curpollbgcolor\">\n";
print "<A HREF=\"$selfurl?action=ballot&poll=$firstpoll\">[Vote!]</A>\n</td>\n";
print "<td ALIGN=CENTER BGCOLOR=\"$curpollbgcolor\">\n";
print "<A HREF=\"$selfurl?action=display&poll=$firstpoll\">[View Results]</A>\n</td>\n";
print "</tr>\n\n";
#print the rest of the polls...
foreach $pname (@allpollnames) {
print "<tr>\n";
print "<td><b>$allpolltitles{$pname}</b></td>\n";
print "<td ALIGN=CENTER>\n";
if ($allpollstatus{$pname} eq 'active') {
print "<A HREF=\"$selfurl?action=ballot&poll=$pname\">[Vote!]</A></td>\n";
}
else {
print "<font color=\"#CCCCCC\">[Inactive]</font></td>\n";
}
print "<td ALIGN=CENTER>\n";
print "<A HREF=\"$selfurl?action=display&poll=$pname\">[View Results]</A></td>\n";
print "</tr>\n\n";
}
print <<EndOfHTML;
</table></center>
<br> </td>
</tr>
</table></center>
EndOfHTML
;
}
# printbriefdisplay
# Prints a display of a poll file in brief (i.e. in a table)
sub printbriefdisplay {
print "<B>$polltitle</B>\n";
print "<P><I>$pollquestion</I><BR>\n";
for($i=1; $i<=$pollnumoptions; $i++) {
print "$polloptions[$i]: <B>$pollvotes[$i]</B><BR>\n";
}
}
# printdisplay
# Prints a display of a poll file
sub printdisplay {
print <<EndOfHTML;
<h1>$title</h1>
<hr ALIGN=LEFT WIDTH="100%">
<p><i>Poll results for....</i>
<blockquote><b></b>
<table BORDER=4 CELLPADDING=15>
<tr>
<td><b>$polltitle</b><b></b>
<p><i>$pollquestion</i>
<br>
<hr ALIGN=LEFT WIDTH="100%">
<table BORDER=0 CELLSPACING=5 CELLPADDING=5 >
EndOfHTML
;
#print out results
for($i=1; $i<=$pollnumoptions; $i++) {
print "<tr><td>$polloptions[$i]</td>\n";
print "<td WIDTH=\"20\"></td>\n";
if ($tally != 0) {
$percent = $pollvotes[$i] / $tally;
}
else {
$percent = 0;
}
$percent = $percent * 100;
$percent = int($percent);
print "<td ALIGN=LEFT VALIGN=TOP><b>$pollvotes[$i]</b> votes ($percent%)</td></tr>\n\n";
}
print <<EndOfHTML;
</table>
</td></tr>
</table>
</blockquote>
<HR>
<A HREF="$selfurl">More polls</A>
EndOfHTML
;
}
# printbriefballot
# Prints a *brief* ballot for a poll file
sub printbriefballot {
print <<EndOfHTML;
<B>$polltitle</B><P>
<I>$pollquestion</I><BR>
<FORM ACTION="$selfurl" METHOD="post">
<INPUT TYPE="hidden" NAME="poll" VALUE="$pollname">
<INPUT TYPE="hidden" NAME="action" VALUE="vote">
EndOfHTML
;
for($i=1; $i<=$pollnumoptions; $i++) {
print "<INPUT TYPE=\"radio\" NAME=\"option\" VALUE=\"$i\">\n";
print "$polloptions[$i]<BR>\n";
}
print "<INPUT TYPE=\"SUBMIT\" VALUE=\"Vote\">\n";
print "</FORM>\n";
}
# printballot
# Prints a ballot for a poll file
sub printballot {
print <<EndOfHTML;
<H1>$title</H1>
<hr ALIGN=LEFT WIDTH="100%">
<P><i>Please vote!</i>
<blockquote>
<FORM ACTION="$selfurl" METHOD="post">
<INPUT TYPE="hidden" NAME="poll" VALUE="$pollname">
<INPUT TYPE="hidden" NAME="action" VALUE="vote">
<table BORDER=4 CELLPADDING=15>
<tr>
<td><b>$polltitle</b><b></b>
<p><i>$pollquestion</i>
<br>
<hr ALIGN=LEFT WIDTH="100%">
<table BORDER=0 CELLSPACING=5 CELLPADDING=5 >
EndOfHTML
;
#print options
for($i=1; $i<=$pollnumoptions; $i++) {
print "<tr><td ALIGN=RIGHT>\n";
print "<INPUT TYPE=\"radio\" NAME=\"option\" VALUE=\"$i\">\n";
print "</td>\n";
print "<td>$polloptions[$i]</td>\n</tr>\n";
}
print <<EndOfHTML;
</TABLE>
<INPUT TYPE="SUBMIT" VALUE="Record Your Vote">
</td></tr>
</table>
</FORM>
</blockquote>
EndOfHTML
;
}
# readpollfile
# Reads the data file specified by the referrer in $datafile
#
# returns $polltitle, $pollquestion, $pollvotes, $polloptions
sub readpollfile {
open(DATA,$datafile);
@datalines = <DATA>;
close(DATA);
$tally = 0;
foreach $dataline (@datalines) {
chomp($dataline);
$lcdata = lc($dataline);
@splitdata = split(/=/,$dataline);
if ( substr($lcdata,0,5) eq 'title' ) {
$polltitle = $splitdata[1];
}
if ( substr($lcdata,0,8) eq 'question' ) {
$pollquestion = $splitdata[1];
}
if ( substr($lcdata,0,5) eq 'votes' ) {
$tindex = substr($splitdata[0],6);
$pollvotes[$tindex] = $splitdata[1];
$tally = $tally + $pollvotes[$tindex];
}
if ( substr($lcdata,0,6) eq 'option' ) {
$tindex = substr($splitdata[0],7);
$polloptions[$tindex] = $splitdata[1];
}
}
$pollnumoptions = scalar(@polloptions) - 1;
}
# writepollfile
# Writes the data file specified by the referrer
sub writepollfile {
#overwrite...
open(DATA,">$datafile");
print (DATA "title=$polltitle\n");
print (DATA "question=$pollquestion\n");
for($i=1; $i<=$pollnumoptions; $i++) {
print (DATA "votes.$i=$pollvotes[$i]\n");
print (DATA "option.$i=$polloptions[$i]\n");
}
close(DATA);
}
# readdatafile
# Reads the poll description data file
#
# returns @allpollnames, %allpolltitles, %allpollfiles, %allpollstatus
sub readdatafile {
open(DATA,$polldatafile);
@datalines = <DATA>;
close(DATA);
$curpoll = "";
@allpollnames = ();
foreach $dataline (@datalines) {
chomp($dataline);
$lcdata = lc($dataline);
@splitdata = split(/=/,$dataline);
if ( substr($lcdata,0,4) eq 'name' ) {
$curpoll = $splitdata[1];
push(@allpollnames, $curpoll);
}
if ( substr($lcdata,0,5) eq 'title' ) {
$allpolltitles{"$curpoll"} = $splitdata[1];
}
if ( substr($lcdata,0,4) eq 'file' ) {
$allpollfiles{"$curpoll"} = $splitdata[1];
}
if ( substr($lcdata,0,6) eq 'status' ) {
$allpollstatus{"$curpoll"} = $splitdata[1];
}
}
@allpollnames = reverse(@allpollnames);
}
# writedatafile
# Writes current contents out to the data file
sub writedatafile {
open(DATA, ">$polldatafile");
#reverse to right down in chronological order
@allpollnames = reverse(@allpollnames);
foreach $pname (@allpollnames) {
print (DATA "name=$pname\n");
print (DATA "title=$allpolltitles{$pname}\n");
print (DATA "file=$allpollfiles{$pname}\n");
print (DATA "status=$allpollstatus{$pname}\n");
}
close(DATA);
#reverse back to 'proper' order
@allpollnames = reverse(@allpollnames);
}
#prints HTML header
sub printhtmlhead {
print("Content-type: text/html\n\n");
print <<EndOfHTML;
<HTML><HEAD><TITLE>$title</TITLE></HEAD>
$bodystyle
EndOfHTML
;
}
#prints HTML header
sub printack {
print("Content-type: text/html\n\n");
}
#print HTML footer
sub printhtmlfoot {
print("</BODY></HTML>\n");
}
# read parameters
# name/value pairs are in %cgiVals (global) hash
sub readparam {
if ( ($ENV{'REQUEST_METHOD'} eq 'POST') || ($ENV{'REQUEST_METHOD'} eq 'post') ) {
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); #read for POST method to $buffer
@cgiPairs = split(/\&/,$buffer);
}
else {
#get the pairs of parameters passed to the script for GET method
@cgiPairs = split(/\&/,$ENV{'QUERY_STRING'});
}
#split the pairs into a %cgiVals hash
foreach $pair ( @cgiPairs ) {
($var,$val) = split("=",$pair);
$val =~ s/\+/ /g;
$val =~ s/%(..)/pack("c",hex($1))/ge;
$cgiVals{"$var"} = "$val";
}
}
#note! for textarea fields, add this:
# $FORM{'comments'} =~ s/\r/\n/;
#
#which replaces the linefeeds with the \n newline
sub putenv {
foreach $key (keys(%ENV)) {
print "$key = $ENV{$key}<BR>\n";
}
print "<P>\n";
foreach $key (keys(%cgiVals)) {
print "$key = $cgiVals{$key}<BR>\n";
}
}]]>