#!/usr/bin/perl

use 5.6.0;
use strict;

use CGI '-debug';
chdir "/home/mjd/perl/qotw/e006" or die "chdir $!";

# File Locations, set to local survey source files!

# File containing questions in the format:
# question? answer1; answer2; answerN;; OPTIONS
my $QUESTIONS_FILE			= 'quiz-questions';

# The web page to to embed the survey in
# must contain the tag <!-- Survey -->, which will e replaced with the form
my $SURVEY_WEBPAGE_FILE		= 'grayfiles/survey.html';

# File for collecting the results, created if needed
my $ANSWERS_FILE			= 'W/answers.txt';

# The web page to to embed the results in
# must contain the tag <!-- Results -->, which will e replaced with the  table
my $RESULTS_WEBPAGE_FILE	= 'grayfiles/report.html';

# End File Locations.

# determine operation mode and call appropriate subroutines
my $query = CGI->new();
my $mode = $query->param('mode');
if ($mode && $mode eq 'answers') {
	save_answers( load_questions(), $query );
	display_results( load_answers() );
}
elsif ($mode && $mode eq 'results') { display_results( load_answers() 
); }
else { display_survey( load_questions() ); }

# generate an HTML table of results and embed it in the results page  and show
sub display_results {
	my $results = shift;
	my $table = '<TABLE 
BORDER=2><TR><TH>Question</TH><TH>Results</TH></TR>';
	foreach (keys %{ $results }) {
		$table .= "<TR><TD>$_</TD><TD>";
		my $total = 0;
		for my $a (keys %{ $$results{$_} }) { $total += $$results{$_}{$a}; }
		my $count = 0;
		for my $answer (sort {
							$$results{$_}{$b} <=> $$results{$_}{$a}
								||
							$a cmp $b
						} keys %{ $$results{$_} }) {
			$table .= "$answer ($$results{$_}{$answer}&nbsp;or&nbsp;";
			$table .= sprintf '%.2f', $$results{$_}{$answer} / $total * 100;
			$table .= '%)<BR>';
			last if ++$count == 10;
		}
		$table .= '</TD></TR>'
	}
	$table .= '</TABLE>';
	
	open RESULTS, "<", $RESULTS_WEBPAGE_FILE or die "File Error:  $!\n";
	print "Content-type: text/html\n\n";
	while (<RESULTS>) {
		s/<!--\s*Results\s*-->(?:RESULTS)?/$table/i;
		print;
	}
	close RESULTS;
}

# HTML-ify questions-honring options, embed form in survey page and show
sub display_survey {
	my $questions = shift;
	my $form = '<FORM METHOD=POST ACTION="gray.cgi">';
	$form .= '<INPUT TYPE=hidden NAME=mode VALUE=answers>';
	foreach (@{ $questions }) {
		$form .= "<P>$$_{question}";
		if ($$_{options}{ALL_THAT_APPLY}) {
			$form .= ' (select all that apply)';
		}
		elsif ($$_{options}{OPTIONAL}) { $form .= ' (optional)'; }
		$form .= '<BR>';
		if ($$_{options}{ALLOW_OTHER}) {
			push @{ $$_{answers} }, 'other:';
		}
		for (my $i = 0; $i < @{ $$_{answers} }; $i++) {
			if ($$_{options}{ALL_THAT_APPLY}) {
				$form .= '&nbsp;&nbsp;<INPUT TYPE=checkbox';
			}
			else { $form .= '&nbsp;&nbsp;<INPUT TYPE=radio'; }
			$form .= " NAME=\"$$_{question}\"";
			$form .= " VALUE=\"$$_{answers}[$i]\"";
			if ($i == 0 && !$$_{options}{ALL_THAT_APPLY} &&
						   !$$_{options}{OPTIONAL}) {
				$form .= ' CHECKED';
			}
			$form .= '>';
			$form .= "&nbsp;$$_{answers}[$i] ";
		}
		if ($$_{options}{ALLOW_OTHER}) {
			$form .= '&nbsp;<INPUT TYPE=text';
			$form .= " NAME=\"$$_{question} other\">";
		}
	}
	$form .= '<P><INPUT TYPE=submit><INPUT TYPE=reset></FORM>';
	
	open SURVEY, "<", $SURVEY_WEBPAGE_FILE or die "File Error:  $!\n";
	print "Content-type: text/html\n\n";
	while (<SURVEY>) {
		s/<!--\s*Survey\s*-->(?:SURVEY)?/$form/i;
		print;
	}
	close SURVEY;
}

# load results into a nested hash
sub load_answers {
	open ANSWERS, "<", $ANSWERS_FILE or die "File Error:  $!\n";
	my %answers;
	while (<ANSWERS>) {
		next if /^\s*$/ or /^#/;
		if (/^(.+?\?)\s*(.*)$/) {
			my($question, $answer) = ($1, $2);
			$answer =~ s/^other: //;
			if (exists $answers{$question})	{ $answers{$question}{$answer}++; }
			else { $answers{$question} = { $answer => 1 }; }
		}
	}
	close ANSWERS;
	return \%answers;
}

# load questions into a nested array
sub load_questions {
	open QUESTIONS, "<", $QUESTIONS_FILE or die "File Error:  $!\n";
	my @questions;
	while (<QUESTIONS>) {
		next if /^\s*$/ or /^#/;
		if (/^(.+?\?)\s*(.+?)(?:;;\s*(.*))?$/) {
			push @questions, { question => $1, answers => [ split /; ?/, $2 ] };
			$questions[-1]{options} = { map { $_ => 1 } split ' ', $3 } if $3;
		}
	}
	close QUESTIONS;
	return \@questions;
}

# write submitted survey to disk
sub save_answers {
	my($questions, $query) = @_;
	open ANSWERS, ">>", $ANSWERS_FILE or die "File Error:  $!\n";
	print ANSWERS "\n";
	foreach (@{ $questions }) {
		if ($$_{options}{ALL_THAT_APPLY}) {
			for my $a ($query->param($$_{question})) {
				print ANSWERS "$$_{question} $a";
				if ($$_{options}{ALLOW_OTHER} && $a eq 'other:') {
					print ANSWERS " ", $query->param($$_{question} . ' other');
				}
				print ANSWERS "\n";
			}
		}
		else {
			my $a = $query->param($$_{question});
			if (!$$_{options}{OPTIONAL} || defined $a) {
				print ANSWERS "$$_{question} $a";
				if ($$_{options}{ALLOW_OTHER} && $a eq 'other:') {
					print ANSWERS " ", $query->param($$_{question} . ' other');
				}
				print ANSWERS "\n";
			}
		}
	}
	close ANSWERS;
}

