#!/usr/bin/perl -w
#
# This Quiz application and associated files is
# Copyright (C) 2000, Jan-Pieter Cornet
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

use strict;
use Getopt::Std;
use Storable;

use vars qw($opt_v);
getopts('v');

my($VERSION) = q$Revision: 1.1 $ =~ /: ([\d.]+)/;

my @vraagfiles = qw(vragen/quizvragen.txt);

# stuff to read questions
# hash of list of lists. contents:
# first index - ronde
# next index - vraagnr
# final index:
# [0] - vraag
# [1] - image or undef
# [2] - undef if can-reorder, correct answer otherwise (1..4). For can-reorder
#     correct answ is always answ1
# [3] - answ1
# [4] - answ2
# [5] - answ3
# [6] - answ4
# [7] - extra explanation, if any

my $vragen = read_vragen(@vraagfiles);

print "<ol>\n";
# write out HTML and ronde data
my $nr = 1;
for my $ronde ( @{$vragen->{ORDER}} ) {
    unshift @{$vragen->{$ronde}}, $ronde;
    store $vragen->{$ronde}, "ronde$nr.data";
    print <<HTML;
<li><a href="quiz.cgi?ronde=$nr">$ronde</a>
HTML
    $nr++;
}
print "</ol>\n";

# -------------------
# subroutines

sub read_vragen {
    my(%vraag, $ronderef);

    # read files into %vraag
FILE:
    for my $file ( @_ ) {
	open(FILE, $file) or die "cannot read $file: $!\n";
	warn "FILE: $file\n" if $opt_v;
	my $hadtitle;
	my $thisq;
	my $thispar = '';
	while ( <FILE> ) {
	    s/\s+$//;
	    next if /^\s*#/;
	    # check for blank line
	    if ( /^\s*$/ ) {
		if ( length $thispar ) {
		    if ( ! $thisq ) {
			# start of question.
			$thisq = {};
			if ( ! $hadtitle ) {
			    # no title yet, use filename
			    $ronderef = insert_title($file, \%vraag);
			    $hadtitle++;
			}
		    }
		    process_par($thisq, $thispar);
		    $thispar = '';
		}
		next;
	    }
	    # check for "ronde"
	    if ( /^Ronde:\s+(.*)/i ) {
		$ronderef = insert_title($1, \%vraag);
		$hadtitle++;
		next;
	    }
	    # check for separator.
	    if ( /^\*+$/ ) {
		if ( length $thispar ) {
		    if ( $thisq && keys %$thisq ) {
			# process last paragraph of question
			process_par($thisq, $thispar);
		    }
		    else {
			# no question yet => it's a title
			$ronderef = insert_title($thispar, \%vraag);
			$hadtitle++;
		    }
		    $thispar = '';
		}
		if ( $thisq && keys %$thisq ) {
		    # time to finish the question
		    finish_question($thisq, $ronderef);
		}
		# clear $thisq, to start fresh
		$thisq = undef;
		next;
	    }
	    # answer
	    # %balance (
	    if ( /^\s*([a-d1-4])\)\s*(\S.*)$/i ) {
		if ( length $thispar ) {
		    if ( ! $thisq ) {
			# start of question.
			$thisq = {};
			if ( ! $hadtitle ) {
			    # no title yet, use filename
			    $ronderef = insert_title($file, \%vraag);
			    $hadtitle++;
			}
		    }
		    process_par($thisq, $thispar);
		    $thispar = '';
		}
		if ( ! $thisq->{QUES} ) {
		    insert_error("Antwoord zonder vraag!");
		    close FILE;
		    next FILE;
		}
		$thisq->{CURANSW} = lc $1;
		$thispar = $2;
		next;
	    }
	    # anything else is just paragraph text
	    if ( ! length $thispar ) {
		# remove leading spaces at start of paragraph
		s/^\s+//;
		$thispar = $_;
	    }
	    elsif ( /^\s+/ ) {
		# text continued after spaces needs a forced newline
		$thispar .= "\n$_";
	    }
	    else {
		# other continuation text is just appended.
		$thispar .= " " . $_;
	    }
	}
	if ( length $thispar ) {
	    process_par($thisq, $thispar);
	    $thispar = '';
	}
	if ( $thisq && keys %$thisq ) {
	    # time to finish the last question
	    finish_question($thisq, $ronderef);
	}
	close(FILE);
    }
    \%vraag;
}

sub insert_title {
    my($title, $rvraag) = @_;

    warn "Title: $title\n" if $opt_v;
    push @{$rvraag->{ORDER}}, $title;
    \@{$rvraag->{$title}};
}

sub insert_error {
    my $error = shift;
    
    warn "ERROR: $error\n";
}

sub process_par {
    my($q, $par) = @_;

    # ignore any junk not part of a question.
    if ( ! $q ) {
	warn "Ignored junk:\n$par\n" if $opt_v;
	insert_error("$par\n");
    }
    elsif ( $q->{CURANSW} ) {
	# some answer given
	$q->{ANSW}{$q->{CURANSW}} = $par;
	delete $q->{CURANSW};
    }
    elsif ( $q->{ANSWIS} ) {
	# extra stuff after correct answer
	$q->{COMMENT} .= "\n" if $q->{COMMENT};
	$q->{COMMENT} .= $par;
    }
    elsif ( ! $q->{QUES} ) {
	$q->{QUES} = $par;
    }
    elsif ( ! exists $q->{ANSW} ) {
	# no answer yet... could be image
	if ( $par =~ /^.*\.gif$/ ) {
	    $q->{IMG} = $par;
	}
	else {
	    # nope... just continuation of the question
	    $q->{QUES} .= "\n$par";
	}
    }
    elsif ( $par =~ /^Het\s+juiste\s+antwoord\s+is\s*:\s*([1-4a-d])\b/i ) {
	# store correct answer
	$q->{ANSWIS} = $1;
	return;
    }
    else {
	# anything else is an error. answers can't have multiple paragraphs.
	insert_error("Wat moet ik met deze troep: $par");
    }
}

sub finish_question {
    my($q, $ronderef) = @_;

    unless ( exists($q->{QUES}) && exists($q->{ANSWIS}) ) {
	insert_error("Vraag niet compleet!");
	return;
    }
    my $rec = [];
    $rec->[0] = $q->{QUES};
    $rec->[1] = $q->{IMG} if exists $q->{IMG};
    if ( ! exists $q->{ANSW}{$q->{ANSWIS}} ) {
	insert_error("Juiste antwoord $q->{ANSWIS} niet in rijtje");
	return;
    }
    if ( $q->{ANSWIS} =~ /\d/ ) {
	# ordered answers
	$rec->[2] = $q->{ANSWIS};
	for my $antwnr ( 1 .. 4 ) {
	    if ( ! exists $q->{ANSW}{$antwnr} ) {
		insert_error("Antwoord $antwnr bestaat niet!");
		return;
	    }
	    $rec->[2 + $antwnr] = $q->{ANSW}{$antwnr};
	}
    }
    else {
	# reorderable-answers
	$rec->[3] = $q->{ANSW}{$q->{ANSWIS}};
	my $pos = 4;
	for my $antwnr ( 'a' .. 'd' ) {
	    next if $antwnr eq $q->{ANSWIS};
	    if ( ! exists $q->{ANSW}{$antwnr} ) {
		insert_error("Antwoord $antwnr bestaat niet!");
		return;
	    }
	    $rec->[$pos++] = $q->{ANSW}{$antwnr};
	}
    }
    $rec->[7] = $q->{COMMENT} if $q->{COMMENT};
    # insert antw in table
    push @$ronderef, $rec;
    warn "$q->{QUES}\n" if $opt_v;
}