Quiz with 4 multiple choices written in Perl/Tk

4quiz.pl

#
#	Tiny quiz script using Perl/Tk
#	4quiz.pl
#	JsZ 2011 10.12
#

use strict;
use Tk;
use Text::CSV::Simple;
use File::Basename;

# ============ #
&InitWindow;
&SetParts;
MainLoop();
# ============ #

sub InitWindow() 
{
	$main::hwin = MainWindow->new();
	$main::hwin->title( "Quiz script" );
	$main::hwin->resizable(0, 0);
}

sub SetParts()
{
	$main::mm = "Here is a question passage area.\nFirst please load some question file.";

	$main::mes = $main::hwin->Text( -background=>"white", -width=>55, -height=>5 );
	$main::mes->pack( -side=>"top" );
	$main::mes->insert("1.0", $main::mm);
	
	$main::ansAmes = "Answer A";
	$main::ansBmes = "Answer B";
	$main::ansCmes = "Answer C";
	$main::ansDmes = "Answer D";
	
	$main::btnD = $main::hwin->Button( -textvariable=>\$main::ansAmes, -width=>52, 
										-height=>1, -command=>[\&Answered, "D"] );
	$main::btnD->pack( -side=>"bottom" );
	$main::btnC = $main::hwin->Button( -textvariable=>\$main::ansBmes, -width=>52, 
										-height=>1, -command=>[\&Answered, "C"] );
	$main::btnC->pack( -side=>"bottom" );
	$main::btnB = $main::hwin->Button( -textvariable=>\$main::ansCmes, -width=>52, 
										-height=>1, -command=>[\&Answered, "B"] );
	$main::btnB->pack( -side=>"bottom" );
	$main::btnA = $main::hwin->Button( -textvariable=>\$main::ansDmes, -width=>52, 
										-height=>1, -command=>[\&Answered, "A"] );
	$main::btnA->pack( -side=>"bottom" );
	
	$main::btnQuit = $main::hwin->Button( -text=>"Quit", -command=>\&exit );
	$main::btnQuit->pack( -side=>"left" );
	$main::btnLoad = $main::hwin->Button( -text=>"Load", -command=>\&LoadQuestions );
	$main::btnLoad->pack( -side=>"left" );
	
	# Flags and Vars.
	$main::ifload = 0;
	$main::current = 0;
	$main::correct_cnt = 0;
}

sub Answered()
{
	&dbgout($_[0] . " is chosen.");
	if ($main::ifload) {
		$main::current++;
		&UpdateTitle;
		&SetupQuestion($main::current);
	}
}

sub AnswerCorrect()
{
	&dbgout("!!CORRECT!!");
	$main::correct_cnt++;
	
	# Reset binding.
	$main::btnA->bind("<Button>", \&Nothing);
	$main::btnB->bind("<Button>", \&Nothing);
	$main::btnC->bind("<Button>", \&Nothing);
	$main::btnD->bind("<Button>", \&Nothing);
}

sub Nothing()
{
	;
}

sub LoadQuestions()
{
	&dbgout("Load Questions.");
	
	my $filetype = [["CSV formated Questions File", ".csv"]];
	$main::filename = $main::hwin->getOpenFile( -filetypes=>$filetype, -defaultextension=>".csv" );
	if (defined $main::filename) {
		&StartQuestion($main::filename);
	}
}

sub StartQuestion()
{
	&dbgout("::: Quesitons start :::");
	
	my $parser = Text::CSV::Simple->new();
	$parser->add_trigger( -on_failure=>\&ERROR_occured );
	$parser->field_map(qw/question ansA ansB ansC ansD ANS/);	
	
	if (!(-e $_[0])) {
		&dbgout("File not found : " . $_[0]);
		return;
	}
	
	@main::questions = $parser->read_file($_[0]);
	$main::size_questions = $#main::questions;
	$main::current = 0;
	$main::correct_cnt = 0;
	
	$main::ifload = 1;
	&UpdateTitle();
	&SetupQuestion($main::current);
}

sub SetupQuestion()
{
	if ($_[0] > $main::size_questions) {
		my $finmes = "Correct = " . $main::correct_cnt . "/" . ($main::size_questions + 1) . "\nDo you wanna restart?";
		&dbgout("::: Questions Finish :::");
		my $ret = $main::hwin->messageBox( -title=>"Finish", -icon=>"info", 
											-type=>"YesNo", -message=>$finmes );
		if ($ret eq "No") {
			exit;
		} else {
			# restart
		}
		return;
	}
	
	&dbgout("[ Current question number : " . $_[0] . " ] " . " ANS = " . $main::questions[$_[0]]->{"ANS"});
	
	$main::mes->delete("1.0", "end");
	$main::mes->insert("1.0", $main::questions[$_[0]]->{"question"});
	$main::ansAmes = $main::questions[$_[0]]->{"ansA"};
	$main::ansBmes = $main::questions[$_[0]]->{"ansB"};
	$main::ansCmes = $main::questions[$_[0]]->{"ansC"};
	$main::ansDmes = $main::questions[$_[0]]->{"ansD"};
	
	my $ANS = $main::questions[$_[0]]->{"ANS"};
	if ($ANS == 4) { $main::btnA->bind("<Button>", \&AnswerCorrect); }
	elsif ($ANS == 3) { $main::btnB->bind("<Button>", \&AnswerCorrect); }
	elsif ($ANS == 2) { $main::btnC->bind("<Button>", \&AnswerCorrect); }
	elsif ($ANS == 1) { $main::btnD->bind("<Button>", \&AnswerCorrect); }
	else { &dbgout("Not Active."); }
}

sub UpdateTitle()
{
	my $cur = $main::current;
	my $qsize = $main::size_questions + 1;
	$main::hwin->title(basename($main::filename) . " " . $cur . "/" . $qsize . " CORRECT:" . $main::correct_cnt); 
}

# Put message to console as a debug message.
sub dbgout() { print "Out: ", $_[0], "\n"; }

# Error trigger subroutine.
sub ERROR_occured() { warn "Failed" . $_[1]; }

quesions.csv