jale
Deleted
Jun 6, 2000, 11:30 AM
Post #1 of 2
(306 views)
|
|
Error with Voting Script
|
Can't Post
|
|
I run the NT here and this message is coming back:
CGI Error
The specified CGI application misbehaved by not returning a complete set of HTTP headers. The headers it did return are:
Couldn't Open data file! at d:/perl/lib/surveysays.pl line 41.
________________________________________
i have already checked the folder permissions and that's fine. there are two scripts to run this poll.
1.sets variables poll.pl:
#!/usr/local/bin/perl
# This is the "stub file" that contains all the configuration variables
# needed to customize a quiz. You will need one of these for each quiz
# you create -- they'll each call the main file surveysays.pl to do the
# processing.
# This uses the full path to the surveysays.pl script that came with the
# distribution.
require "d:\intranet\cgi-bin\surveysays.pl";
# This is the path to the data file the script will use to store results.
# The script must either have permissions to write to the directory the
# file will be stored in (and it will create the file itself on first run),
# or you can create the file yourself (as a 0-byte file), and just give
# the script permission to write to the file.
$datafile = "d:\perl\bin\data.txt";
# If your system can use "flock" for file-locking, leave this variable set
# to 1. If not, set it to 0. (If you aren't sure, try 1 first and switch
# to 0 if the script fails.)
$file_lock = 1;
# This is the URL needed to call the script directly.
$script_url = "http://worf/cgi-bin/poll.pl";
# This is the "name" of your quiz. It should only be a few words long.
$quiz_name = "Oasis_Survey";
# These variables control the look of your poll. $top_color is the color
# at the top of the poll, where the $quiz_name will be. $bot_color is the
# color of the bottom of the poll. $font_color is the color the text will
# be, and $font_size is how big it will be. $font_face controls the font
# that is used by the poll. $table_width controls how wide your poll will
# be (I recommend keeping the default values as given for $font_size and
# $table_width).
$top_color = "#33ccff";
$font_face="Arial,Helvetica";
$bot_color = "#ffffff";
$font_color = "#000000";
$font_size = "-2";
$table_width = "125";
# This variable is the question you are asking in your quiz.
$question = "Did you like Oasis?";
# @choices represents the possible answers people can give. It should
# be formatted as shown.
@choices = ("Yes","No","Needs some work","Great On-Line Help");
# If $graphical is set to 1, a 'bar graph' of sorts will be printed along
# side percentages when the results are shown (set it to 0 to report only
# percentages). If used, $gr_file is the URL to call the "dot" that is
# used to create the bars (feel free to replace the default purple one).
# $gr_height is the height in pixels the bar should be, and $gr_scale helps
# control the width (when set to 1, an answer with 25% of the vote would
# have a bar 25 pixels wide; if set to 2, 25% would yield a 50 pixel bar
# and so on).
$graphical = 1;
$gr_file = "http://worf/images/dot.gif";
$gr_scale = 1;
$gr_height = 10;
# If you want the total number of votes received to be reported with the
# results, set this to 1. Else, set it to 0.
$report_total_votes = 1;
# In order to keep people from voting repeatedly, a cached of the most
# recent IPs that voted is kept. A value between 5 and 10 is recommended.
$ips_cached = 8;
# If your poll is working properly, leave this undefined. As a last
# resort, if your poll consistently puts the results on a separate page,
# define this as the URL of the page containing the poll.
$panic_url = "";
# This variable, if set to 1, may help alleviate problems with browsers and
# proxy servers caching your page and not displaying poll results. Do not
# set this to 1 if you have multiple polls on the same page; weird
# behavior will result if you do.
$suppress_cache = 0;
# This variable, if set to 1, adds a second button to the poll, which
# allows the user to see the poll results without voting.
$without_vote = 1;
# Do Not Edit Below This
&SurveySays;
exit;
2.here is the actual perl code surveysays.pl:
#!/usr/local/bin/perl
### This File Need Not Be Edited At All!! ###
sub SurveySays {
&decode_form;
# Handle First Call To Script
if ((!-e "$datafile") | | (-z "$datafile")) {
&initialize_data;
}
# Cache Supression Code
if ($suppress_cache) { $add_on = "?survey";
} else { $add_on = ""; }
# Handle absence of HTTP_REFERER if possible
if ((!$ENV{'HTTP_REFERER'}) && ($panic_url)) {
$ENV{'HTTP_REFERER'} = $panic_url;
}
# If person has already voted, return results
&check_for_vote;
# Take Care of the Vote, if any
if ($ENV{'QUERY_STRING'} eq "voted") {
®ister_vote;
}
# If none of the above, return quiz
&return_quiz;
}
sub initialize_data {
my($numchoices,$i);
$numchoices = @choices;
if ($file_lock) { flock(FILE,2); }
open (FILE, ">$datafile") | | die "Couldn't Open data file!";
print FILE "CHOICES| | |";
for ($i=1; $i<= $numchoices; $i++) {
print FILE "0";
if ($i != $numchoices) { print FILE "| | |"; }
}
print FILE "\nIPS| | |";
for ($i=1; $i <= $ips_cached; $i++) {
print FILE "0.0.0.0";
if ($i != $ips_cached) { print FILE "| | |"; }
}
if ($file_lock) { flock(FILE,8); }
close (FILE);
}
sub check_for_vote {
my($check1,$check2,@totals,$totals,@ips,$ips,$one);
# Get Data
if ($file_lock) { flock(FILE,1); }
open(FILE,"<$datafile") | | &error;
$totals = <FILE>; $totals =~ s/\n$//;
$ips = <FILE>; $ips =~ s/\n$//;
if ($file_lock) { flock(FILE,8); }
close (FILE);
($check1, @totals) = split(/\|\|\|/,$totals);
($check2, @ips) = split(/\|\|\|/,$ips);
# Error Checking
if (($check1 ne "CHOICES") | | ($check2 ne "IPS")) { &error; }
foreach $one (@ips) {
if ($one eq $ENV{'REMOTE_ADDR'}) {
if ((($F{'VOTE_CHECK'} eq "voted") | | ($F{'RESULTS_ONLY'} eq "yes")) && ($ENV{'HTTP_REFERER'})) {
$F{'VOTE_CHECK'} = "double";
print "Location: $ENV{'HTTP_REFERER'}?double \n\n";
} else {
&return_results;
}
}
}
}
sub register_vote {
my($check1,$check2,$discard,@ips,@totals,$totals,$numchoices);
# Decode Form
# Get Data
if ($file_lock) { flock(FILE,2); }
open(FILE,"<$datafile") | | &error;
$totals = <FILE>; $totals =~ s/\n$//;
$ips = <FILE>; $ips =~ s/\n$//;
if ($file_lock) { flock(FILE,8); }
close (FILE);
($check1, @totals) = split(/\|\|\|/,$totals);
($check2, $discard, @ips) = split(/\|\|\|/,$ips);
# Error Checking
if (($check1 ne "CHOICES") | | ($check2 ne "IPS")) { &error; }
$numchoices = @choices;
for ($i=1; $i<=$numchoices; $i++) {
if ($i == $F{'quiz'}) {
$totals[$i-1]++;
last;
}
}
if ($file_lock) { flock(FILE,2); }
open(FILE2,">$datafile") | | &error("DF");
print FILE2 "CHOICES| | |";
print FILE2 join("| | |",@totals), "\n";
print FILE2 "IPS| | |";
print FILE2 join("| | |",@ips), "| | |$ENV{'REMOTE_ADDR'}";
if ($file_lock) { flock(FILE2,8); }
close (FILE2);
print "Location: $ENV{'HTTP_REFERER'}$add_on \n\n";
exit;
}
sub return_quiz {
my($numchoice,$ncinfile,$check,$totals,@totals,$i);
# Get Data
if ($file_lock) { flock(FILE,1); }
open(FILE,"<$datafile") | | &error;
$totals = <FILE>;
if ($file_lock) { flock(FILE,8); }
close (FILE);
($check, @totals) = split (/\|\|\|/,$totals);
# Error Checking
if ($check ne "CHOICES") { &error("CHOICE"); }
$numchoice = @choices;
$ncinfile = @totals;
if ($numchoice != $ncinfile) { &error("NUMCHOICE"); }
# Return Table
print "Content-type: text/html", "\n\n";
print "<table border=0 width=$table_width cellspacing=0 cellpadding=2><tr>";
print "<td valign=center align=middle bgcolor=\"$top_color\"><font face=\"$font_face\" color=\"$font_color\" size=\"$font_size\"><b>$quiz_name</b></font></td></tr>\n";
print "<tr><td valign=top align=left bgcolor=\"$bot_color\">\n";
print "<font face=\"$font_face\" size=\"$font_size\" color=\"$font_color\">";
print "$question<p>\n";
print "<form method=post action=\"$script_url?voted\">\n";
print "<input type=hidden name=\"VOTE_CHECK\" value=\"voted\">\n";
for ($i=1; $i<=$numchoice; $i++) {
print "<input type=radio name=quiz value=\"$i\"> $choices[$i-1]<br>\n";
}
print "<p><center><input type=submit value=\"Vote!\"></center></form><p>\n";
if ($without_vote) {
print "<center><form method=post action=\"$script_url?voted\">\n";
print "<input type=hidden name=\"RESULTS_ONLY\" value=\"yes\">\n";
print "<input type=submit value=\"View Results\"></form></center><p>\n";
}
print "<center><a href=\"http://www.cgiscripts.net/\" target=\"_top\">by CgiScripts.Net</a>\n";
print "</font></td></tr></table>\n";
exit;
}
sub return_results {
my($check,$totals,@totals,$ips,@ips,$numchoices,$i,@processed,@raw,$one,$mastertotal,$tmp,$tmp2);
# Get Data
if ($file_lock) { flock(FILE,1); }
open(FILE,"<$datafile") | | &error;
$totals = <FILE>; $totals =~ s/\n$//;
if ($file_lock) { flock(FILE,8); }
close (FILE);
($check, @totals) = split(/\|\|\|/,$totals);
# Error Checking
if ($check ne "CHOICES") { &error; }
$numchoices = @choices;
$mastertotal = 0;
for ($i=0; $i<$numchoices; $i++) {
$mastertotal += $totals[$i];
push(@raw,"$totals[$i]| | |$choices[$i]");
}
@processed = sort {$a <=> $b} (@raw);
print "Content-type: text/html", "\n\n";
print "<table border=0 width=$table_width cellspacing=0 cellpadding=2><tr>";
print "<td valign=center align=middle bgcolor=\"$top_color\"><font face=\"$font_face\" color=\"$font_color\" size=\"$font_size\"><b>$quiz_name</b></font></td></tr>\n";
print "<tr><td valign=top align=left bgcolor=\"$bot_color\">\n";
print "<font face=\"$font_face\" size=\"$font_size\" color=\"$font_color\">";
print "$question<p>\n";
for ($i=$numchoices-1; $i>=0; $i--) {
($num,$what) = split(/\|\|\|/,$processed[$i]);
$tmp = ($num/$mastertotal) * 100;
$tmp = sprintf("%3.2f",$tmp);
if ($graphical) {
$tmp2 = int($tmp);
print "<img align=absmiddle src=\"$gr_file\" height=$gr_height width=$tmp2><br>";
}
print "$what: $tmp\%<br>\n";
}
if ($report_total_votes) {
print "<p><center>Total Votes: $mastertotal</center>\n";
}
print "<p><center><a href=\"http://www.cgiscripts.net/\" target=\"_top\">by CgiScripts.Net</a>\n";
print "</font></td></tr></table>\n";
exit;
}
sub error {
print "Content-type: text/html","\n\n";
print "ERROR!! $_[0]";
exit;
}
sub decode_form {
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
@couples = split(/&/, $buffer);
foreach $couple (@couples) {
($called, $equalto) = split(/=/, $couple);
$equalto =~ tr/+/ /;
$equalto =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$equalto =~ s/<!--(.|\n)*-->//g;
$equalto =~ s/<([^>]|\n)*>//g;
$F{$called} = $equalto;
}
}
return 1;
Please help.. :-(
[This message has been edited by jale (edited 06-06-2000).]
|
MAIN
SEARCH
WHO'S 
LOG 