#!/usr/local/bin/perl

#######################################################################
# SurveySays                          Version 1.11                    #
# Copyright 1998 by Matt Riffle       All Rights Reserved.            #
# Initial Full Release: 7/4/98        This Release: 2/20/99           #
# Riffnet Scripts Archive             http://scripts.riffnet.com/     #
#######################################################################
# This program is free software; you can redistribute it and/or       #
# modify it under the terms of the GNU General Public License         #
# as published by the Free Software Foundation; either version 2      #
# of the License, or (at your option) any later version.              #
#                                                                     #
# This program is distributed in the hope that it will be useful,     #
# but WITHOUT ANY WARRANTY; without even the implied warranty of      #
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the       #
# GNU General Public License for more details.  It is included in     #
# this distribution in the file "license.txt".                        #
#                                                                     #
# You should have received a copy of the GNU General Public License   #
# along with this program; if not, write to the Free Software         #
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA           #
# 02111-1307, USA.                                                    #
#######################################################################

### 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") {
    &register_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;