#!/usr/bin/perl

print "Content-type: text/html\n\n";

if (open INF, "<s_head.txt") {
  print while <INF>;
  close INF;
}

read(STDIN, $inbuf, $ENV{'CONTENT_LENGTH'});
for (split(/&/, $inbuf)) {
  ($name, $value) = split(/=/, $_);
  $value =~ tr/+/ /;
  $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
  $form{$name} = $value;
}

$qno = $form{"numq"} || 0;

open(INF, "<qconfig.txt") || die "Can't find configuration file";
@rawque = <INF>;
close INF;
pop @rawque while $rawque[-1] =~ /^\s*$/;

if ($form{"display"}) {
  # Show the results...

  $sts = open(INF, "<qresult.txt");
  if ($sts) {
    $numque = @rawque;
    print "Number of questions: $numque<BR>\n";

    @data = <INF>;
    $numres = @data / @rawque;
    print "Number of respondents: $numres<BR><BR>\n";

    for (@data) {
      ($q, $r) = split /:/, $_, 2;
      if ($r =~ /^co:/) {
        ($r, $ext) = split /:/, $r, 2;
        $res[$q]{"other"}++;
        $res[$q]{"other:$ext"}++;
        $res[$q]{"total"}++;
      }
      elsif ($r =~ /^cn/) {
        $res[$q]{"none"}++;
        $res[$q]{"total"}++;
      }
      else {
        $r =~ /^c(\d+)/ or next;
        $res[$q]{$1}++;
        $res[$q]{"total"}++;
      }
    }

    for (0 .. $#rawque) {
      ($que, $ans) = split /\?\s*/, $rawque[$_], 2;
      ($ans, $opt) = split /\s*;;\s*/, $ans, 2;
      @ans = split /\s*;\s*/, $ans;

      print "<BR><B>Question #" . ($_ + 1) . ":</B><BR>\n";
      print "$que?<BR>\n<UL>\n";

      for $n (0 .. $#ans) {
        $perc = 1000 * ($res[$_]{$n} / $res[$_]{"total"});
        $perc = int($perc + 0.5) / 10;
        print "$ans[$n]: <B>" . ($res[$_]{$n} or "0") . "</B>
(${perc}%)<BR>\n";
      }
      if (defined($res[$_]{"other"})) {
        $perc = 1000 * ($res[$_]{"other"} / $res[$_]{"total"});
        $perc = int($perc + 0.5) / 10;
        print "<BR><I>other respones: </I><B>$res[$_]{other}</B>
(${perc}%)\n<UL>\n";
        for $n (grep {/^other:/} (keys %{$res[$_]})) {
          $perc = 1000 * ($res[$_]{$n} / $res[$_]{"total"});
          $perc = int($perc + 0.5) / 10;
          $n =~ /^other:(.+?)\s*$/;
          print "$1: <B>$res[$_]{$n}</B> (${perc}%)<BR>\n";
        }
        print "</UL>\n";
      }
      if (defined($res[$_]{"none"})) {
        $perc = 1000 * ($res[$_]{"none"} / $res[$_]{"total"});
        $perc = int($perc + 0.5) / 10;
        print "<BR><I>no response: </I><B>$res[$_]{none}</B>
(${perc}%)<BR>\n";
      }

      print "</UL>\n";
    }
  }
  else {
    print "No results have yet been accumulated.\n";
  }
}
elsif ($qno <= $#rawque && $qno >= 0) {
  # Still working on the quiz...

  ($que, $ans) = split /\?\s*/, $rawque[$qno], 2;
  ($ans, $opt) = split /\s*;;\s*/, $ans, 2;
  @ans = split /\s*;\s*/, $ans;
  @opt = split /\s+/, $opt;
  $opt{$_} = 1 for @opt;

  print "<FORM ACTION='survey.pl' METHOD='POST'>\n";
  print "${que}?\n<UL>\n";
  for (0 .. $#ans) {
    $chk = ($set++ || $opt{"OPTIONAL"}) ? "" : " CHECKED";
    print "<INPUT TYPE='radio' NAME='choice' VALUE='c$_'$chk>
$ans[$_]<BR>\n";
  }
  if ($opt{"ALLOW_OTHER"}) {
    $chk = ($set++ || $opt{"OPTIONAL"}) ? "" : " CHECKED";
    print "<INPUT TYPE='radio' NAME='choice' VALUE='co'$chk> <I>Other</I>:
\n";
    print "<INPUT TYPE='text' SIZE='20' NAME='other' VALUE=''><BR>\n";
  }
  if ($opt{"OPTIONAL"}) {
    $set++;
    print "<BR><INPUT TYPE='radio' NAME='choice' VALUE='cn' CHECKED> <I>No
answer</I><BR>\n";
  }
  print "</UL>\n<CENTER><INPUT TYPE='submit' VALUE='Submit'></CENTER>\n";

  print "<INPUT TYPE='hidden' NAME='numq' VALUE='" . ($qno + 1) . "'>\n";

  if ($qno > 0) {
    print "<INPUT TYPE='hidden' NAME='q" . ($qno - 1) . "' VALUE='";
    if ($form{"choice"} eq "co") {
      $form{'other'} =~ y/\n\r//;
      print "co:$form{'other'}'>\n";
    }
    else {
      print "$form{'choice'}'>\n";
    }
  }

  if ($qno > 1) {
    for (grep(/^q/, keys(%form))) {
      print "<INPUT TYPE='hidden' NAME='$_' VALUE='$form{$_}'>\n";
    }
  }

  print "</FORM>\n";
}
else {
  # Done with the quiz...

  print "<CENTER>Thanks for participating!<BR><BR>\n";

  open(OUTF, ">>qresult.txt") || die "Can't open results file";
  for (0 .. ($#rawque - 1)) {
    print OUTF "$_:" . $form{"q$_"} . "\n";
  }

  print OUTF "" . $#rawque . ":";
  if ($form{"choice"} eq "co") {
    $form{'other'} =~ y/\n\r//;
    print OUTF "co:$form{'other'}\n";
  }
  else {
    print OUTF "$form{'choice'}\n";
  }

  close OUTF;

  print "<FORM ACTION='survey.pl' METHOD='POST'>\n";
  print "<INPUT NAME='display' TYPE='submit' VALUE='Display
Results'></CENTER>\n";
  print "</FORM>\n";
}

if (open INF, "<s_foot.txt") {
  print while <INF>;
  close INF;
}
