Приглашаем посетить
Voting Booth
#!/usr/bin/perl
##############################################################
# #
# vote.cgi - Voting Booth Perl Script for the World Wide Web #
# #
# Written by Michael Hall - mikeh@isaac.biola.edu #
# Copyright ©1995 by Michael Hall, All Rights Reserved. #
# #
##############################################################
#############################################################
# Define the following fields in your form:
#
# vote The user's vote on the topic (number
# only) or "results" if viewing results
# topic The voting file
#############################################################
# Variables
$BaseDir = "/var/www/docs/scripts2"; # Path to the voting section
$Counter = 0;
$Sum = 0;
$VoteNum = 0;
$NumItems = 0;
$Percentage = 0;
$Votes = 0;
$Header = <<'EOT';
<HTML>
<HEAD>
<META NAME="GENERATOR" CONTENT="Adobe PageMill 2.0 Mac">
<TITLE>The Scripts Home: The Voting Booth</TITLE>
</HEAD>
<BODY BGCOLOR="#ffffff">
<P><IMG SRC="WebLogo.gif" ALT="The Scripts Home: A Free Source of Perl CGI Scripts for Interactive Web Pages"
BORDER="0" WIDTH="471" HEIGHT="102" NATURALSIZEFLAG="3" ALIGN="BOTTOM"></P>
<P><CENTER><IMG SRC="Titles/VotingBooth.gif" BORDER="0" ALT="The Voting Booth"
WIDTH="442" HEIGHT="62" NATURALSIZEFLAG="3" ALIGN="BOTTOM"></CENTER></P>
<H2><CENTER><FONT SIZE=+1>This Months' Voting Topic:</FONT></CENTER></H2>
EOT
$Footer = <<'EOT';
<P><HR ALIGN=LEFT><IMG SRC="../../clip_art/MacMade.gif" WIDTH="50" HEIGHT=
"50" ALIGN="RIGHT" NATURALSIZEFLAG="3"><IMG SRC="/cgi-bin/logo.pl" ALIGN=
"LEFT"><FONT SIZE=-1>©1996 and Designed by <A HREF="http://www.virtualcenter.com/vmt/">Virtual
Marketing Technologies</A>. All Rights Reserved.<BR>
EOT
&UnWeb;
if ($in{'option'} eq "") {
&Error ("No Option Specified");
}
if ($in{'topic'} eq "") {
&Error ("No Topic Specified");
}
if ($in{'option'} eq "results") {
&DisplayResults;
}
else {
&CheckVoter;
&RecordVote;
}
#############################################################
# Read in the voting file and process the votes
sub CheckVoter {
open (VF, "$BaseDir/$in{'topic'}.usr");
$voter = <VF>;
close VF;
chop ($voter);
if ($voter eq $ENV{'REMOTE_HOST'}) {
&Error ("No Duplicate Voting");
}
else {
open (VF, ">$BaseDir/$in{'topic'}.usr");
print VF "$ENV{'REMOTE_HOST'}\n";
close VF;
}
}
#############################################################
# Read in the voting file and process the votes
sub RecordVote {
open (VF,"$BaseDir/$in{'topic'}");
@lines = <VF>;
chop @lines;
close VF;
$Num = @lines;
# Seperate out the items
$Topic = $lines[0];
$Count = 1;
while ($Count != $Num) {
($Item[$Count],$VoteCount[$Count]) = split (/::/, $lines[$Count]);
$Votes = $Votes + $VoteCount[$Count];
$Count++;
}
$VoteCount[$in{'option'}]++;
$Votes++;
# Now write back the data to the file
open (VF, ">$BaseDir/$in{'topic'}");
print VF "$Topic\n";
$Counter = 1;
while ($Counter != $Num) {
print VF "$Item[$Counter]::$VoteCount[$Counter]\n";
$Counter++;
}
close VF;
$Flag = 1;
&DisplayResults;
}
sub DisplayResults {
if ($Flag == 0) {
open (VF, "$BaseDir/$in{'topic'}");
@lines = <VF>;
chop @lines;
close VF;
$Num = @lines;
# Seperate out the items
$Topic = $lines[0];
$Count = 1;
while ($Count != $Num) {
($Item[$Count],$VoteCount[$Count]) = split (/::/, $lines[$Count]);
# if ($VoteCount[$Count] != 0) {
$Votes = $Votes + $VoteCount[$Count];
# }
$Count++;
}
}
# Determine Stats
$Counter = 1;
if ($Votes != 0) {
while ($Counter != $Num) {
$Percentage[$Counter] = (int(($VoteCount[$Counter] / $Votes) * 100));
$Counter++;
}
}
$Counter = 1;
$NewCount = 0;
while ($Counter != $Num) {
$NewLine[$NewCount] = "<tr><td>$Item[$Counter]</td>
<td align=center>$VoteCount[$Counter]</td><td align=center>
$Percentage[$Counter]\%</td></tr>\n";
$NewCount++;
$Counter++;
}
# Display the results
$Counter = 1;
&PrintHeader ("Results for $Topic");
print "$Header\n";
print "<center><h2>$Topic</h2></center>\n";
print "<center><b>Total Votes Cast So Far: $Votes</b></center><p>\n";
print "<center><table border=2>\n";
print "<tr><td align=center><b>Choice:</b></td><td align=center>
<b>No. Votes</b></td><td align=center><b>Percentage:</b></td></tr>\n";
foreach $Line (@NewLine) {
print "$Line";
}
print "</table></center>\n";
print "<p><center><font size=+2><a href=\"$ENV{'HTTP_REFERER'}\">Return to Previous Page</a></font></center>\n";
print "<p><font size=-1>Generated by <a href=\"http://www.virtualcenter.com/scripts2\">
The Voting Booth v2.0</a> - Copyright © 1996 by <a href=\"http://www.virtualcenter.com/vmt\">Virtual Marketing Technologies</a>.
All Rights Reserved.<p></font>\n";
print "$Footer\n";
print "</body>\n";
print "</html>\n";
}
sub Error {
local ($Error) = @_;
if ($Error eq "No Duplicate Voting") {
&PrintHeader ("No Duplicate Voting");
print "$Header\n";
print "<center><h1>Error: No Duplicate Voting!</h1></center>\n";
print "Sorry, you can only vote once on a particular topic.
You'll have to wait until someone else votes before you can vote again.<p>\n";
print "$Footer\n";
exit;
}
if ($Error eq "No Option Specified") {
&PrintHeader ("No Option Specified");
print "$Header\n";
print "<center><h1>Error: No Option Specified!</h1></center>\n";
print "No option was specified in the previous HTML form.
Please contact the administrator and inform him/her of this error.<p>\n";
print "$Footer\n";
exit;
}
if ($Error eq "No Topic Specified") {
&PrintHeader ("No Topic Specified");
print "$Header\n";
print "<center><h1>Error: No Topic Specified!</h1></center>\n";
print "No topic was specified in the previous HTML form.
Please contact the administrator and inform him/her of this error.<p>\n";
print "$Footer\n";
exit;
}
}
sub UnWeb {
# Get the input
# Split the name-value pairs
@pairs = split(/&/, $ENV{'QUERY_STRING'});
foreach $pair (@pairs) {
($name, $value) = split(/=/, $pair);
# Un-Webify plus signs and %-encoding
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$value =~ s/<!--(.|\n)*-->//g;
if ($allow_html != 1) {
$value =~ s/<([^>]|\n)*>//g;
}
else {
unless ($name eq 'body') {
$value =~ s/<([^>]|\n)*>//g;
}
}
$in{$name} = $value;
}
}
#######################
# Print HTML Header
sub PrintHeader {
local ($Title) = @_;
print "Content-type: text/html\n\n";
print "<html>\n";
print " <head>\n";
print " <title>$Title</title>\n";
print " </head>\n";
}