Solutions and Discussion for Perl Quiz of the Week #6 (Expert Edition)

Sample solutions and discussion
Perl Expert Quiz of The Week #6 (20021120)

        Write a generic survey or quiz program, "survey".

        The program will read a configuration file in this format:

                How old are you?  0-12; 13-19; 20-24; 25-34; 35-44; 45 or older
                What is your favorite color?  red; blue; black; other
                ...

        Each question is on a separate line; the question is
        everything up to and including the first '?', and the allowed
        responses to the question are the following items separated by
        ';'.  If the last response ends with ";;" instead of ";", any
        data following the ";;" is taken to be configuration options
        for that question, separated by spaces.  For example:

            How old are you?  0-12; 13-19; 20-24; 25-34; 35-44; 45 or older;; OPTIONAL
            What is your favorite color?  red; blue; black;; ALLOW_OTHER

        It is up to you to decide what options, if any, should be
        supported.

        The program will then prompt the user with the questions, and
        read and validte the responses.  When the user has finished
        answering the questions, the program should record the
        responses in a file.

        There should be some way to run the program to get it to
        disgorge a report about the aggregate survey responses.  The
        report should include: The number of people completing the
        survey; the number providing each response to each question,
        and the percentage breakdown for the responses to each
        question.

        The program could use the terminal as an interface, or it
        could have a Tk interface, or could be a CGI program, or
        whatever you prefer.


----------------------------------------------------------------

Not much to say this week.  There was no discussion of the problem on
the -discuss list, and only three people sent sample solutions.  All
of these seemed straightforward, so I'll show Alan Cameron's, for two
reasons: First, it's relatively short, and second, it isn't cluttered
up with a lot of HTML, because it uses a plain terminal interface.

================================================================
#!/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;

================================================================

Mr. Cameron's program used the 'Storable' module to record the answer
data in a file.  Two other solutions used plain text, serializing the
data manually; my example program used DB_File.

1. When I posed this question, I hoped someone would build a generic
   survey kit that had a pluggable interface.  Nobody did do this,
   although Alan Cameron's came close: His program has a fairly clear
   separation between the interface parts (report_ans, get_answer) and
   the data parts (read_qfile, write_afile).

2. John Toomey's and James Gray's programs support the useful options
   OPTIONAL and ALLOW_OTHER; Mr. Gray's also supports ALL_THAT_APPLY.
   Alan Cameron and I took the easy way out and had the programs
   ignore the input.

3. Everyone's program suffers from potential race conditions, except
   mine (I think.)  Oops!

   I've found in the past that in addition to recording aggregate
   data, it's a good idea to also record every detail of every survey
   that is submitted, including the date and source IP address,
   because you never know what information you might want to extract
   later.  ("How many 18-25-year-olds said their favorite color was
   blue?")  Also in case you mess up the file locking and the
   aggregate date becomes corrupt.  A plain text file that gets a
   survey response appended to it is unlikely to become corrupt.

4. My program and Cameron's were much smaller than the others.  I
   thought, "Oh, we must have an unfair advantage, because we left out
   the optional options."  So I added OPTIONAL and ALLOW_OTHER to my
   program, and it grew from 80 to 99 lines.  Then I realized I hadn't
   deleted the prose introductions from gray.pl and toomey.pl.  (My
   line-counting progrram ignores comments, but not email headers or
   prose.)  It's been that kind of a day.  Here are the totals:

                                OPTIONAL   ALLOW_OTHER   ALL_THAT_APPLY

        cameron.pl       80    
        gray.pl         116     Yes        Yes           Yes
        mjd.pl           80     
        mjd2.pl          99     Yes        Yes
        toomey.pl       115     Yes        Yes


   So where's the code difference?  toomey.pl seems to have a lot of
   repeated code.  gray.pl has some additional code to handle
   ALL_THAT_APPLY, but also uses a lot of space generating HTML
   output.  mjd2.pl uses the CGI.pm built-in functions, which appears
   to be more compact, at least in this case.

5. All five programs are at http://perl.plover.com/qotw/misc/e006/ .

I hope the next quiz will arouse more interest.  Thanks to everyone
who participated.  New quizzes tomorrow.