#!/usr/bin/perl
print "Content-type:text/html\n\n";

############################################################
#
#
#                 AvSurvey.cgi
#
#	Copyright (c) 2002 FinchAviary.com
#
#  This script may not be used, copied, distributed, 
#  or modified without the express written consent
#  of the author.
#
############################################################
#
#  Description
#  -----------
#
#  AvSurvey.cgi processes information submitted
#  from a survey, accumulating the number of 
#  times each response is selected by the respondents.
#  It then displays a results page listing the 
#  questions, the choices, and the percentage of 
#  respondents who selected that choice, as well as
#  displaying a bar graph illustrating the percentages.
#
############################################################
#
#  Features
#  --------
#
#  VIEW RESULTS: AvSurvey can be called in such a way as 
#    to allow the user to view the results without voting.
#
#  CONTROL TYPES: AvSurvey works with surveys containing 
#    any combination of radio buttons and checkboxes.
#
#  UNLIMITED QUESTIONS: AvSurvey allows an unlimited number
#    of questions and an excessively large number of choices
#
#  UNLIMITED NUMBER OF SURVEYS: AvSurvey can be used to 
#    manage an unlimited number of surveys, as long as
#    each survey is given its own unique name.
#
#  OUTPUT CONFIGURED VIA TEMPLATE: A template can be specified
#     to provide custom formatting of the output page.
#
#  PREVENT MULTIPLE RESPONSES: AvSurvey can be configured to
#    prevent a user from voting twice over a given period of time.
#
#  LOGGING OF INDIVIDUAL SURVEY RESULTS: Individual Survey results
#    are logged to a log file for further analysis.
#
############################################################
#
#  File Use
#  --------
#
#  The following files are used by AvSurvey (where SurveyName
#  is the name given to the survey in the hidden variable 
#  survey_name):
#
#  AvSurvey.cgi - the program itself.
#
#  SurveyNameLock.lok - a lock file to guarantee two surveys
#    don't try to modify the survey data at the same time.
#
#  SurveyNameCount.dat - stores the number of respondents as
#    well as the number of times each choice was selected.
#    Data format (each line): QuestionNumberChoiceLetter=count
#
#  SurveyNameIP.log - stores the IP address of all respondents
#    along with the date/time they submitted the survey.
#    Data format (each line): IPAddress=date_time
#
#  SurveyNameResponse.log - stores the responses from all 
#    survey respondents.  Each line contains one respondent's
#    choices.
#    Data format (each line): QuestionNumberChoiceLetter
#      (each choice is separated by a space).
#
#  SurveyNameTemplate.htm - HTML file with the text/graphics
#    that should appear on the results page.  The comment
#    <!--AvSurvey Results--!> should appear on a line by itself 
#    where the results should be printed. The web adminstrator
#    is responsible for creating this file. If no such file
#    exists, the results will be displayed without header/footer.
#
#  SurveyNameQuestions.txt - Text file containing the title, 
#    headings, questions, and choices.
#    Data Format (each line):
#      Titles:    T=title text
#      Headings:  H=heading text
#      Questions: Q=question text
#      Choices:   C=#Letter=choice (checkbox)
#                 R=#Letter=choice (radio button)
#
########################################################################


########################################################################
# CONFIGURATION VARIABLES
# -----------------------
#
# THE FOLLOWING VARIABLES HOLD CONSTANT DATA THAT CAN BE CHANGED
# TO ALTER THE LOOK/FEEL OF THE OUTPUT AS WELL AS THE BEHAVIOR OF
# THE SCRIPT
########################################################################


#LOOK AND FEEL VARIABLES
#-----------------------

$TITLE_FONT="Arial, Helvetica, sans-serif";
$HEADING_FONT="Arial, Helvetica, sans-serif";
$QUESTION_FONT="Arial, Helvetica, sans-serif";
$CHOICE_FONT="Arial, Helvetica, sans-serif";

$TITLE_FONT_COLOR="#000080";
$HEADING_FONT_COLOR = "#000080";
$QUESTION_FONT_COLOR = "#000080";
$CHOICE_FONT_COLOR = "#000080";

$TITLE_FONT_SIZE = 4;
$HEADING_FONT_SIZE = 3;
$QUESTION_FONT_SIZE = 2;
$CHOICE_FONT_SIZE = 2;

$TITLE_FONT_STYLE = "<b>";
$HEADING_FONT_STYLE = "<b><i>";
$QUESTION_FONT_STYLE = "<b>";
$CHOICE_FONT_STYLE = "";

$TITLE_FONT_END_STYLE = "</b>";
$HEADING_FONT_END_STYLE = "</b></i>";
$QUESTION_FONT_END_STYLE = "</b>";
$CHOICE_FONT_END_STYLE = "";

$TITLE_ALIGN = "center";
$HEADING_ALIGN = "left";
$QUESTION_ALIGN = "left";
$CHOICE_ALIGN = "left";


$BAR_GRAPHIC_ONE_PERCENT = "http://www.finchaviary.com/Graphics/Interface/BarGraphic.gif";


#BEHAVIOR
#--------

#Change this value to determine how much time must 
#pass before the user may vote again.  
#The default is once every 24 hours.

$HOURS_BETWEEN_VOTES = 0;


#Change this text to alter the messages that are displayed 
#if the user has already voted or did not answer any of the 
#questions. Note: the results will still be displayed.

$ALREADY_VOTED_MESSAGE = "Our records indicate that you have already voted in this survey. Only your first vote can be counted.";

$NO_ANSWERS_PROVIDED_MESSAGE = "You did not answer any of the questions so your vote has not been counted. You are still eligible to vote again.";


# Add a New Valid Survey Name to this array. 
# eg, @VALID_SURVEY_NAMES("Name1", "Name2", "Name3")
# This array exists because the survey name comes from the form.
# If a form passed an invalid filename, trouble could occur.
# Therefore, we limit survey name to the following values.

@VALID_SURVEY_NAMES =("FinchSurvey");

# The path that valid requests should be coming from
$VALID_REFERER = "http://www\.finchaviary\.com/Survey/";



########################################################################
#
#                         START OF SCRIPT
#
########################################################################

# Make sure the request is coming from a valid source
&check_referer();



# Determine whether the user wants to vote or just view the results
$voting = &is_voting();



# Get the user data as an array of strings containing variable=value.
@input_data = &get_user_input();
&filter_user_input();



# Get the name of the survey that the user is voting on or wants to view
$survey_name = &get_survey_name();
if(! $survey_name )
{
    print "The survey form used to submit data is invalid. Please contact the site administrator.";
    exit;
}


#Build the following file names

$lock_file;
$count_file;
$ip_log_file;
$response_log_file;
$template_file;
$question_file;

&build_file_names();


#If the user voted, process the user's vote

if( $voting )
{
    &vote();
}
else
{
    &get_counts();
}

&display_results();



########################################################################
#
#  check_referer
#
#  This subroutine ensures that the script is being called from a valid
#  location
#
########################################################################
sub check_referer
{
	if(! ($ENV{'HTTP_REFERER'}=~m%^($VALID_REFERER)%) )
	{
		print "The referer form used to submit data is invalid. Please contact the site administrator.";
		exit;
	}
}


########################################################################
#
#  is_voting
#
#  This subroutine determines whether the user is voting or just
#  viewing the results
#
########################################################################

sub is_voting
{
    #If the subroutine is invoked using POST, then we want to vote.
    #GET is used when not passing survey data because we just want
    #to view the results.

    $ENV{'REQUEST_METHOD'} eq "POST";
}

########################################################################
#
#  get_user_input
#
#  This subroutine gets the data entered by the user in the form (or
#  the data passed through GET if the user only wants to view the 
#  results)
#
########################################################################

sub get_user_input
{
    #If the user voted, the results are coming via POST and are 
    #therefore available in STDIN
    #If the user is merely viewing, the info is coming via GET
    #and is therefore available in the environment variable.

    if( $voting )
    {
        read(STDIN, $raw_data, $ENV{'CONTENT_LENGTH'});
    }
    else
    {
        $raw_data = $ENV{ 'QUERY_STRING' };
    }

    #Separate the incoming data string into an array of data pairs.
    #The input data comes in separating each pair from the next with
    #an & symbol.
    #This statement returns an array of strings in the format VarName=Value

    split(/&/, $raw_data);
}


########################################################################
#
#  filter_user_input
#
#  This subroutine performs cleans up the user input.
#
########################################################################

sub filter_user_input
{
    foreach $pair(@input_data)
    {
        ($key,$value)=split(/=/,$pair,2);
        $value=~tr/+/ /;
        $value=~s/%(..)/pack("c",hex($1))/ge;
        $value=~s/\0//g;
        $value=~s/\012//gs;
        $value=~s/\015/ /gs;
        $key=~s/\0//g;
    
        # Rebuild the pair and replace in the array    
        $pair = join("=", $key, $value);
   }
}






########################################################################
#
#  get_survey_name
#
#  This subroutine determines which survey the user voted on (or wishes
#  to view).
#
########################################################################

sub get_survey_name
{
    # Search the input data for the survey_name variable
    foreach $pair(@input_data)
    {
        ($key, $value) = split(/=/, $pair, 2);
        if( $key eq "SURVEY_NAME" )
        {
            foreach $valid_survey(@VALID_SURVEY_NAMES)
            {
                if( $value = $valid_survey )
                {
                    return $value;
                }
            }
        }
     }
     return 0;   
}


########################################################################
#
#  build_file_names
#
#  This subroutine builds the various filenames used by the program
#  based on the survey name.
#
########################################################################
sub build_file_names
{
    $lock_file = $survey_name . "Lock.lok";
    $count_file = $survey_name . "Counts.dat";
    $ip_log_file = $survey_name . "IP.log";
    $response_log_file = $survey_name . "Response.log";
    $template_file = $survey_name . "Template.htm";
    $question_file = $survey_name . "Questions.txt";
}

########################################################################
#
#  vote
#
#  This subroutine processes the user's vote
#
########################################################################
sub vote
{
	# Check to see if the user already voted
	if( &has_voted )
	{
		$display_message = $ALREADY_VOTED_MESSAGE;
	}
	else
	{
		# Check to see if the user answered any of the questions
		if( ! (&answered_questions) )
		{
			$display_message = $NO_ANSWERS_PROVIDED_MESSAGE;
		}
		else
		{
			# Set a lock to prevent anyone else from modifying the contents
			# of results files (counts and logs) while we are updating them
			if( ! (&set_lock) )
			{
				print "A timeout error occurred while trying to process your vote. Please contact the site administrator if the problem persists.";
				exit;
			}
			else
			{
				# Load the current counts for each response into a hash table
				&get_counts();

				# Increment the counts for the choices the user voted on
				&update_counts();

				# Write the new counts back to the file
				&write_counts();

				# Record the user's responses in the log
				&write_response_log();

				# Record the user's IP and date/time in the IP log
				&write_ip_log();

				# Release the lock so that others can add their responses to the file
				&release_lock();
			}
		}
	}
}

########################################################################
#
#  display_results
#
#  This subroutine displays the results of the poll
#
########################################################################
sub display_results
{
	# Open the template file if it exists and load the HTML into an array
	@template_array;
	&load_template_array;

	&display_header;

	# Open the question file and read in the title, headings, questions, and choices
	&load_questions;

	# Parse each line from the question file and output the appropriate HTML
	foreach $question_item(@questions_array)
	{
		&output_line($question_item);
	}
	&output_end_choices; 



	&display_footer;
}



########################################################################
#
#  load_template_array
#
#  If the template file exists, loads the contents into an array
#
########################################################################
sub load_template_array
{
	# Does the file exist?
	if(-e $template_file)
	{
		# Open the file and read its contents
		if( open( TEMPLATE, "<" . $template_file ) )
		{
	        read(TEMPLATE, $template_data, -s $template_file);
			close TEMPLATE;
			
			# Copy the data into an array
			@template_array = split(/\n/, $template_data);
		}
	}
}



########################################################################
#
#  display_header
#
#  Displays header HTML for the output page, if there is any.
#
########################################################################
sub display_header
{
	# Display each line of the template file until the comment is found
	foreach $template_line(	@template_array )
	{
		if(! ($template_line =~ "<!--Survey Data-->") )
		{
			print $template_line;
		}
		else
		{
			last;
		}
	}
}


########################################################################
#
#  display_footer
#
#  Displays footer HTML for the output page, if there is any.
#
########################################################################
sub display_footer
{
	# Display each line of the template that comes after the comment

	$found_comment = 0;
	foreach $template_line(	@template_array )
	{
		if($found_comment)
		{
			print $template_line;
		}
		
		if($template_line =~ "<!--Survey Data-->" )
		{
			$found_comment = 1;
		}
	}
}


########################################################################
#
#  has_voted
#
#  Determines whether this user has voted within the allowable time-frame
#
########################################################################
sub has_voted
{
	$has_voted = 0;

	# Check to see if the ip file exists.  If it does not, we can assume
	# the user has not voted.

	if( -e $ip_log_file )
	{
		# Open the IP file for reading
		if( open( IP_LOG_FILE, "<" . $ip_log_file ) )
		{
		    # Read the file into one large string
	        read(IP_LOG_FILE, $ip_data, -s $ip_log_file);
			
			# Parse each line into an array.
			# Reverse the lines so that the last line (most recent)
			# is read first.  We only want to check the most recent
			# vote by this IP address

			@ip_array = split(/\n/, $ip_data);
			@ip_array = reverse(@ip_array);

			# Separated out the time and IP address for each entry until
			# we find this user's IP
			foreach $ip_line(@ip_array)
			{
				($ip, $ip_time) = split(/=/, $ip_line, 2);

				# If we found this user's IP, check to see if the required
				# number of hours has passed since the last vote.
				if( $ip eq $ENV{ REMOTE_ADDR } )
				{
					chomp $ip_time;
					if(time < ($ip_time + ($HOURS_BETWEEN_VOTES * 3600)) )
					{
						$has_voted = 1;
					}
				}
			}
		}
	}
	return $has_voted;
}


########################################################################
#
#  answered_questions
#
#  Determines whether the user answered any questions
#
########################################################################
sub answered_questions
{
	$answered = 0;
	foreach $pair(@input_data)
	{
		($key, $value) = split(/=/, $pair, 2);
		if( (!($value=~/ZZZZ$/)) && ($key ne "SURVEY_NAME") )
		{
			$answered = 1;
			last;
		}
	}
	return $answered;
}


########################################################################
#
#  set_lock
#
#  Attempts to create a file that will in effect lock other user's of
#  the script out of the data files until we are done.  Returns true
#  if successful.
#
########################################################################
sub set_lock
{
	$timeout = time + 30;
	
	# Loop while lock file exists. If lock file exists, someone
	# is updating the data. We must wait until they are done.
	# When they are done, they will delete the lockfile.

	while( (-e $lock_file) && (time < $timeout))
	{
		# Can't do anything until lock file is deleted by other user
	}

	if( ! (-e $lock_file) )
	{
		$locked = open(LOCK_FILE, ">" . $lock_file);
	}
	return $locked;
}

########################################################################
#
#  release_lock
#
#  Destroys the lock file so that others can add their results to the
#  data files.
#
########################################################################
sub release_lock
{
	# delete the lock file and allow others to contribute to the survey
	close LOCK_FILE;
	unlink $lock_file;
}

########################################################################
#
#  get_counts
#
#  This subroutine loads the counts for each option into a hash
#
########################################################################
sub get_counts
{
	%count_table;

	# Check to see if the counts file exists. If it does, open it so we
	# can read the current counts
	if( -e $count_file )
	{
		# Open the count file in read mode
		if( open( COUNT_FILE, "<" . $count_file ) )
		{
			# Read the file into one large string
	        read(COUNT_FILE, $count_data, -s $count_file);
			
			# Parse each line into an array.
			@count_array = split(/\n/, $count_data);

			# Separate each value=count pair into a hash, where value 
			# is the key and count is the lookup data.

			foreach $count_line(@count_array)
			{
				($key, $value) = split(/=/, $count_line, 2);
				$count_table{$key} = $value;
			}
		}
		close COUNT_FILE;
	}
}



########################################################################
#
#  update_counts
#
#  Updates the hash table with the current counts by incrementing the
#  count for every item selected by the user.
#
########################################################################
sub update_counts
{
	%question_answered;

	foreach $pair(@input_data)
	{
		($key, $choice) = split(/=/,$pair,2);
		$choice =~ /^(\d*)\D/;
		$question = $1;

		if( ($key ne "SURVEY_NAME") && (!($choice=~/ZZZZ$/)) )
		{
			if(! exists $question_answered{$question} )
			{
				if( exists $count_table{$question} )
				{
					$count_table{$question} = $count_table{$question} + 1;
				}
				else
				{
					$count_table{$question} = 1;
				}
				$question_answered{$question} = 1;
			}

			if( exists $count_table{$choice} )
			{
				$count_table{$choice} = $count_table{$choice} + 1;
			}	
			else
			{
				$count_table{$choice} = 1;
			}
		}
	}
}



########################################################################
#
#  write_counts
#
#  Writes the updated counts back out to the counts file.
#
########################################################################
sub write_counts
{
	@count_array = ();
	# Open the counts file for writing (overwrite existing or create new)
	if( open( COUNT_FILE, ">" . $count_file ) )
	{
		@count_array = %count_table;
		while( @count_array )
		{
			$key = shift @count_array;
			$value = shift @count_array;

			if( !($value=~/ZZZZ$/) )
			{
				$text = $key . "=" . $value . "\n";
				print COUNT_FILE $text;
			}
		}
		close COUNT_FILE;
		chmod( 0644, $count_file );
	}
}

########################################################################
#
#  write_response_log
#
#  Writes the user's choices out to a line in the response log in
#  case we want to do more sophisticated analysis of the data.
#
########################################################################
sub write_response_log
{

}

########################################################################
#
#  write_ip_log
#
#  Writes the date/time and the user's IP address out to a log so that
#  we can prevent them from voting again within a given time frame. This
#  prevents someone from spamming the survey with phony responses.
#
########################################################################
sub write_ip_log
{
	# Check to see if the ip file exists. If it does, open it so we
	# can append to it. Otherwise, create it.
	if( -e $ip_log_file )
	{
		# Open the IP file in append mode
		$file_open = open( IP_LOG_FILE, ">>" . $ip_log_file );
	}
	else
	{
		# Create the IP file
		$file_open = open( IP_LOG_FILE, ">" . $ip_log_file );

		# Set permissions to 0644
		chmod( 0644, $ip_log_file);
	}

	if( $file_open )
	{
		$ip_log_text = $ENV{ REMOTE_ADDR } . "=" . time . "\n";
		print IP_LOG_FILE $ip_log_text;
		close IP_LOG_FILE;
	}
}


########################################################################
#
#  output_title_line
#
#  Output the HTML to generate the title of the survey
#  Change this function to alter the appearance of the title in
#  the output.
#
#  Parameter - the text of the title line
#
########################################################################
sub output_title_line
{
	my($title_text) = @_;

	if( $title_text )
	{
		$title_html = "<p align=\"" . $TITLE_ALIGN . "\"><font size=\"" . $TITLE_FONT_SIZE . "\" face=\"" . $TITLE_FONT . "\" color=\"" . $TITLE_FONT_COLOR . "\">" . $TITLE_FONT_STYLE . $title_text . "\n" . $TITLE_FONT_END_STYLE . "</font></p>";
		print $title_html;
	}
}


########################################################################
#
#  output_heading_line
#
#  Output the HTML to generate the heading for the next section
#  of the survey
#
########################################################################
sub output_heading_line
{
	my($heading_text) = @_;

	if( $heading_text )
	{	
		$heading_html = "<p align=\"" . $HEADING_ALIGN . "\"><font size=\"" . $HEADING_FONT_SIZE . "\" face=\"" . $HEADING_FONT . "\" color=\"" . $HEADING_FONT_COLOR . "\">" . $HEADING_FONT_STYLE . $heading_text . "\n" . $HEADING_FONT_END_STYLE . "</font></p>";
		print $heading_html;
	}

}

########################################################################
#
#  output_question_line
#
#  Output the HTML to generate the next question
#
########################################################################
sub output_question_line
{
	my($question_text, $num_responses) = @_;

	if( $question_text )
	{	
		$question_html = "<p align=\"" . $QUESTION_ALIGN . "\"><font size=\"" . $QUESTION_FONT_SIZE . "\" face=\"" . $QUESTION_FONT . "\" color=\"" . $QUESTION_FONT_COLOR . "\">" . $QUESTION_FONT_STYLE . $question_text . "\n" . $QUESTION_FONT_END_STYLE . "</font>";
		$num_responses_html = "<br> <font size=\"" . $QUESTION_FONT_SIZE . "\" face=\"" . $QUESTION_FONT . "\" color=\"" . $QUESTION_FONT_COLOR . "\"> Responses - " . $num_responses . "</font></p>";
		print $question_html;
		print $num_responses_html;
	}
}

########################################################################
#
#  output_begin_choices
#
#  Output the HTML to start the table in which the choices will appear
#
########################################################################
sub output_begin_choices
{
	print "<div align=\"left\"><table width = \"565\" border=\"1\" bordercolor=\"#0000FF\" bgcolor=\"#E6E6FF\" cellpadding=\"1\" cellspacing=\"0\">\n";
}

########################################################################
#
#  output_choice_line
#
#  Output the HTML to generate one row of the choices table, containing
#  the choice, the bar, and the percentage
#
########################################################################
sub output_choice_line
{
	my($choice_text, $percent) = @_;
	if( $choice_text )
	{
		$graphic_width = $percent * 3;
		if( $graphic_width == 0 )
		{
			$graphic_name = "";
		}
		else
		{
			$graphic_name = $BAR_GRAPHIC_ONE_PERCENT;
		}
		$choice_html = "<tr><td width=\"200\"><font face= \"" . $CHOICE_FONT . "\" size=\"" . $CHOICE_FONT_SIZE . "\" color=\"" . $CHOICE_FONT_COLOR . "\">" . $choice_text . "</font></td><td width = \"365\"><font face=\"" . $CHOICE_FONT . "\" size=\"" . $CHOICE_FONT_SIZE . "\" color=\"" . $CHOICE_FONT_COLOR . "\"><img src=\"" . $graphic_name . "\" width=\"" . $graphic_width . "\" height=\"11\"> %.0f </font></td></tr>";
		printf( $choice_html, $percent );
	}
}

########################################################################
#
#  output_end_choices
#
#  Output the HTML to end the table in which the choices appeared
#
########################################################################
sub output_end_choices
{
	print "</table></div>";
}




########################################################################
#
#  load_questions
#
#  Read in the title, headings, questions, and choices
#
########################################################################
sub load_questions
{
	@questions_array;

	# Check to see if the question file exists. If it does, open it so we
	# can read the questions
	if( -e $question_file )
	{
		# Open the question file in read mode
		if( open( QUESTION_FILE, "<" . $question_file ) )
		{
			# Read the file into one large string
	        read(QUESTION_FILE, $question_data, -s $question_file);
			
			# Parse each line into an array.
			@questions_array = split(/\n/, $question_data);
		}
		close QUESTION_FILE;
	}
}


########################################################################
#
#  output_line
#
#  Output the HTML to generate the line passed in
#
########################################################################
sub output_line
{
	my($line_text) = @_;

	if( $line_text )
	{
		($part_1, $part_2, $part_3) = split(/=/,$line_text,3);

		if( $part_1 eq "T" )
		{
			if( ($last eq "C") || ($last eq "R") )
			{
				&output_end_choices; 
			}
			&output_title_line($part_2);
			$last = "T";
		}

		if( $part_1 eq "H" )
		{
			if( ($last eq "C") || ($last eq "R") )
			{
				&output_end_choices; 
			}
			&output_heading_line($part_2);
			$last = "H";
		}
		if( $part_1 eq "Q" )
		{
			if( ($last eq "C") || ($last eq "R") )
			{
				&output_end_choices; 
			}

			$responses = 0;
			$responses_key = $part_2;
			if( exists $count_table{$responses_key} )
			{
				$responses = $count_table{$responses_key};
			}
			

			&output_question_line($part_3, $responses);
			$last = "Q";
		}
		if( ($part_1 eq "C") || ($part_1 eq "R") )
		{
			if( ($last ne "C") && ($last ne "R") )
			{
				&output_begin_choices; 
			}

			$choice_key = $part_2;

			if( exists $count_table{$choice_key} )
			{
				$choice_percent = $count_table{$choice_key};
			}
			else
			{
				$choice_percent = 0;
			}

			$part_2=~/(\d+)/;
			$responses_key = $1;
			$responses = $count_table{$responses_key};
			if( $responses )
			{
				$choice_percent = ($choice_percent/$responses) * 100;
			}
			else
			{
				$choice_percent = 0;
			}



			&output_choice_line($part_3, $choice_percent);

			$last = $part_1;
		}
	}
}