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 ; } 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.