by Gary Lee

Write an easy voting thingy using Perl.

To help the losing cause of universal access to the Web and further display my horrible perl skills, let us create a CGI script in perl 5 that is viewable by (hopefully) any browser to poll readers on a particular question.
October 13, 1997

Such as:

Which do you prefer? The Old Star Trek The New Star Trek

The script was inspired by ESPN SportsZone, which I read all the time while I'm pretending to work, and the fact that I can never see their poll results when I turn off images on my browser.

Let's create a script that will read an HTML file with the question on it. Like template.txt. Looking at the file, you will see it is the source of this article. You may also note that the FORM part is enclosed by a made-up <MPOLL> tag. Your browser ignores any tag it does not recognize, but the soon-to-be-created script will use it to replace that part with the poll results. Also, let's use a cookie to tell us if the reader has previously voted, in which case just show the results instead of asking the question.

Confused? So am I. That is what you get for eschewing human contact for a computer...you become incomprehensible (among other things). Maybe you should rejoin the real world before it happens to you.

For those of you still present, here is the logic behind the script:

1. If a cookie is set, show the current results of the poll,
2. else if a vote is submitted, record it and show the results,
3. else print the question.

#!/usr/bin/perl
use CGI;
$query = new CGI;
if ($ENV{HTTP_COOKIE}) {
    &print_results;
}
elsif ($query->param) {
    &add_vote;
    &set_cookie;
    &print_results;
}
else {
    &print_question;
} 

The use CGI; immediately marks this as a perl 5 script that requires that wonderful module CGI.pm. Then I make a CGI object called $query to access any data submitted via an HTML form. Finally comes the logic... check if there's a cookie (which is passed to your script as $ENV{HTTP_COOKIE} by the server), else check if any CGI parameters were entered (i.e. check if a vote was cast), else print the question.

The script would now be totally finished, if &print_results, &add_vote, and &set_cookie were defined. Luckily for us, our next task is to define them.

In perl, the & is used to call a subroutine...a piece of code defined somewhere else. You can see how useful it is here. The program is practically self-documenting, it helps us focus on what we have to do, and it allows us to re-use the same code in different sections (like &print_results).

The first subroutine we shall write is the subroutine print_question. We can just tack it to the end of the above code:

sub print_question {
    print "Content-type: text/html\n\n";
    open(TEMPLATE,"/columns/template.txt");
    while(<TEMPLATE>) {
        print;
    }
}

Simple enough. The sub marks the stuff following as a subroutine. In it, print the content-type so the web browser will know that it is an HTML document (as opposed to an image or something more exotic). Then open up template.txt and while you can still read lines from it (that is, you haven't reached the end), print them out.

Now that we can print the question, let's deal with what happens when someone answers it.

sub add_vote {
    $choice = $query->param('vote');
    if ($choice == '0' || $choice == '1') {
        open(RESULTS,"results.txt");
        $line = <RESULTS>
        @votes = split(/ /,$line);
        $votes[$choice]++;
        open(RESULTS,">results.txt");
        select(RESULTS); $| = 1; select(STDOUT);
        print RESULTS "$votes[0] $votes[1]";
    }
}

<FORM METHOD="POST" ACTION="/~glee/cgi-bin/poll.cgi">
<STRONG>Which do you prefer?</STRONG><BR>
<INPUT TYPE="radio" NAME="vote" VALUE="0">The Old Star Trek<BR>
<INPUT TYPE="radio" NAME="vote" VALUE="1">The New Star Trek<BR>
<INPUT TYPE="submit" VALUE="Vote">

So, choosing the superior Old Star Trek will return a vote of value 0, while anybody who mistakenly chooses the New Star Trek will return a vote of value 1. With this information, the subroutine might make sense. First, we store the value of the vote into $choice. Then, check to see if $choice is an acceptable value. If it is, then open up "results.txt", read the first line, split it up at the space separating the two numbers, and store the values in the array @votes. This means $votes[0] will contain the first number, and $votes[1] will contain the second.

Now we can say $votes[$choice]++, which means "increment $votes[0] (corresponding to the superior Star Trek) or $votes[1] (the pale substitute), depending on the value of $choice." Then we open up "results.txt" again and record the new count.

Whew. How about we move on to something more simple.

sub set_cookie {
    print "Set-Cookie: meepPoll=\"1\"; Version=\"1\"\n";
    print "Cache-control: no-cache=\"set-cookie\"\n";
}

Nothing really to explain about this subroutine. This is how you set a cookie named "meepPoll" with the value "1" that follows the "version 1" cookie specification. Once the cookie is set, the browser will return the cookie to the server whenever it accesses anything in </columns/a10/>, i.e. the location where it was originally set. In our script, we don't even check the value of the cookie. We only care if it exists because we assume there will only be one cookie for this URL. We could've written a cookie named "underwear" with the value "blue", except "white" would be more accurate.

Now that I've managed to use the word "underwear", we can finish by creating the print_results subroutine. If you are still awake, you might remember that it is called if a cookie has been set for this URL, or after someone has submitted a vote.

sub print_results {
    open(RESULTS,"results.txt");
    $line = <RESULTS>;
    @votes = split(/ /,$line);
    $results = qq(
    <TABLE CELLPADDING=3 BORDER=1>
    <TR>
	<TD BGCOLOR="#FFCCCC">
	<STRONG>The Old Star Trek:</STRONG>
    <TD BGCOLOR="#FFCCCC" ALIGN="right">
	$votes[0]<BR>
    <TR>
	<TD BGCOLOR="#FFCCCC"><STRONG>
	The New Star Trek:</STRONG>
    <TD BGCOLOR="#FFCCCC" ALIGN="right">
	$votes[1]<BR>
    </TABLE>
    );
    open(TEMPLATE,"template.txt");
    undef $/;
    $_ = <TEMPLATE>;
    
    s/<MPOLL>(.*?)<\/MPOLL>/$results/si;
    print "Content-type: text/html\n\n";
    print $_;
}

Next comes some nifty perl stuff. After opening "template.txt", we undef $/, which affects the next line. $/, the "input record separator," is newline by default, causing input to be read one line at a time. By undefining it, we do not stop at the end of each line, so instead of reading "template.txt" one line at a time into $_, we slurp up the entire contents into the variable.

We do this so we can search for and replace the multiple lines between the <MPOLL> and </MPOLL> that contains the question form. That is what s/<MPOLL>(.*?)<\/MPOLL>/$results/si; does. Once the substitution is done, the only thing left to do is print out the page.

Simple enough. (Ha.) But you can cut-and-paste the code and figure it out with the help of a trusty perl book from O'Reilly and a little experimentation. You can even add things like percentages of total votes, or more choices on the ballot (like having the superior Star Trek, the new Star Trek, Deep Space 9, and the gosh-awful Voyager). And once you've finished your masterpiece, you too can confirm the superiority of The Original Series.

The End...

Gary Lee is a co-owner of meep! media inc., an Internet and Intranet consulting company. He is also one of the programmers, and creator of meep! media's first product, meep!Board, a message board system.