#!/usr/bin/perl

# For Quiz of the Week #6, Expert
# Author: Alan Cameron
#
# run as './survey' to run the survey
# run as './survey report' to get a report on the answers
# $Qfile and $Afile can be changed to whatever you want.

use strict;

# For saving of the answer file
use Storable;

# Filenames for the question and answer file
my $Qfile = "quiz-questions";
my $Afile = "cameron-data";

# Array of questions in the following format
# @questions = (
#	[
#	 "Question 1",
#	 "OPTIONS",
#	 ["answer1","answer2",...]
#	],
#	[
#	 "Question 2",
#	 "OPTIONS",
#	 ["answer1","answer2",...]
#    ...
#	]
# )
my @questions;

# Array of answers to each question.
# Elements are the number of the answer chosen
my @answers;

# Read in the list of questions from a given file
# stores questions in global array @questions
# skips blank lines, and lines beginning with #
# also removes any white space before and after the list of answers
sub read_qfile {
	my $file = shift;
	my $fh;
	open $fh, "$file" or die "Couldn't open $file: $!";

	while (<$fh>) {
		next if /^\s*$/;
		next if /^#/;
		chomp;
		my ($ques, $ans) = /^(.*?\?)\s*(.*)$/;
		my $opt;
		($ans, $opt) = split /;;/, $ans;
		my @ans = split /;/, $ans;
		s/^\s*//, s/\s*$// for @ans;
		push @questions, [$ques, $opt, \@ans];
	}
}

# Adds the results of @answers to the Answer file
sub write_afile {
	my $file = shift;
	my @ans;
	# Either read in the current answer file, or create a new
	# structure to hold the answers.
	if (-e $file) {
		@ans = @{ +retrieve($file) };
	} else {
		foreach (@questions) {
			push @ans, [ (0) x scalar @{$_->[2]} ];
		}
		unshift @ans, 0;
	}
	my $num = shift @ans;
	for (my $i = 0;$i < @answers; $i++) {
		$ans[$i]->[$answers[$i]]++
	}
	unshift @ans, ++$num;
	store \@ans, $file;
}

# Report on the number of answers for each question
# Output is formatted for a max of 3 digits in the number
# of answers per question, if you have more than 999 answers
# to a particular question, the output won't look as nice
sub report_ans {
	my $file = shift;
	my @ans;
	my $total;
	if (-e $file) {
		@ans = @{ +retrieve($file) };
	} else {
		die "No Current Answer file to report.\n";
	}
	my $num = shift @ans;
	print "Number of questionees: $num\n";
	# For each question, iterate through the list of possible
	# answers, and print the number of each.
	for (my $i = 0;$i < @questions; $i++) {
		print $questions[$i][0];
		print " (", $questions[$i][1], ")" if $questions[$i][1];
		print "\n";
		$total += $_ for @{$ans[$i]};
		$total = 1 unless $total;
		for (my $j = 0; $j < @{$questions[$i][2]}; $j++) {
			$ans[$i][$j] = 0 unless defined $ans[$i][$j];
			printf "%3d (%5.1f%%)  %s\n",
			  $ans[$i][$j], ($ans[$i][$j] / $total)*100, $questions[$i][2][$j];
		}
		print "\n";
		$total = 0;
	}
}

# returns the number of the chosen answer
# passed in 2 args. a string containing the options,
# and an arrayref to a list of answers
sub get_answer {
	my $opt = shift;
	my @ans = @{ +shift };
	my $in;
	my $i;

	for ($i = 0; $i < @ans; $i++) {
		print $i+1, " $ans[$i]\n";
	}

	while(1) {
		print "Answer (1-$i): ";
		{ local $^W=0;
		$in = int <STDIN>;
		}
		if ($in < 1 || $in > $i) {
			print "Invalid answer, try again\n";
			redo;
		}
		last;
	}
	print "\n";
	return $in - 1;

}

# Get the list of questions
read_qfile $Qfile;

# If all you want is a report, print that and exit
if ($ARGV[0] =~ /report/i) {
	report_ans $Afile;
	exit 0;
}

# Ask each question, and record the response
foreach my $ques (@questions) {
	my ($q, $opt, $ans) = @$ques;
	print "$q\n";
	push @answers, get_answer($opt, $ans);
}

# Write out the answers to the answer file
write_afile $Afile;
