#! /usr/bin/perl

#--------------------------------------------------------------------------
# Console quizzing program
# Copyright (C) 2005-2009  Dino Morelli  <dino@ui3.info>
#
#   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., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301
#   USA
#--------------------------------------------------------------------------

use strict;
use warnings;

use English;
use File::Basename;
use Getopt::Long;
use List::Util qw/shuffle/;
use Text::Wrap;

use constant COLUMNS => 77;


my %opts;

sub order {
    my @new;

    if ($opts{randomize}) {
        @new = shuffle @_;
    } else {
        @new = sort { $a <=> $b } @_;
    }

    return @new;
}


# sub to process the basename further than File::Basename
# But only on Windows systems where this script is probably being run
# from the batch file
{
    no warnings;

    sub basename {
        my $basename = File::Basename::basename shift;

        $OSNAME =~ /MSWin32/ && do {
            $basename =~ s/\.plx//;
        };

        return $basename;
    }
}

# Creates a pair of hashes representing letter-to-number and the reverse
# mappings.
sub createAnswerHashes {
   my @letters = ('a' .. 'd');
   my @numbers = (0 .. 3);
   my (%lton, %ntol);

   if ($opts{randomize}) {
      @numbers = shuffle @numbers;
   }

   for (@letters) {
      $lton{$_} = shift @numbers;
   }

   %ntol = reverse %lton;

   return (\%lton, \%ntol);
}


# Display statistics given a pass number, remaining questions and total
# count
sub displayStats {
   my ($pass, $remaining, $total) = @_;

   my $correct = $total - $remaining;
   my $perc = 0;

   print "=" x COLUMNS . "\n";
   printf "Pass %d statistics:\n", $pass;
   printf "\n%d questions in this pass, %d correct so far\n",
      $total, $correct;
   $perc = ($correct / $total) * 100 if ($total);
   printf "%5.1f%% answered correctly\n", $perc;
   print "=" x COLUMNS . "\n\n";
}


my $basename = basename $0;
my $usage = <<USAGE;
$basename - Quiz program for studying FCC examination questions

usage:
    $basename [-r] FILE
    $basename -h
    $basename -v

options:
    -h, --help       This help information.
    -r, --randomize  The questions and their answers are displayed in a 
                     random order.
    -v, --version    Output version info and exit.


Some quiz data files can be found here:
http://wireless.fcc.gov/commoperators/eqp.html

This program works with the plain-text question files. From the above
web site, you can save-as the .doc files to plain ascii text or extract
the .exe archives.
USAGE

my $version = <<VER;
$basename 1.3.0
by Dino Morelli  <dino\@ui3.info>   `$basename -h` for help
VER


# Parse the switches and arguments that were specified on the command-line
Getopt::Long::Configure ("bundling");
GetOptions(
    \%opts,
    'help|h',
    'randomize|r',
    'version|v',
) or die "$usage\n";

die "$usage\n" if $opts{help};
die "$version\n" if $opts{version};

my $qFilePath = shift;

die "No question file specified\n\n$usage\n" unless $qFilePath;

my $title = "[untitled] ($qFilePath)";


# Load in the question data
=for comment
The questions are stored in a hash of hashes with the keys being the 
indices of the questions, like this:

   {
      1 => {
         'question' => "Question text",
         'answers' => [
            "Answer A",
            "Answer B",
            "Answer C",
            "Answer D",
            ],
         'correct' => "Index of correct answer"
         },
      2 => { ... as above ...
=cut
my %questions;

open QFILE, "$qFilePath" or die "Can't open $qFilePath: $!\n";

my ($type, $curQ, $answerIndex);
my $questionIndex = 0;
while (<QFILE>) {
   # Strip off newlines
   # For UNIX format line ending.
   chomp;
   # For DOS format line ending.
   s/\x0d\x0a//;

   # Skip blank lines
   next if /^\s*$/;

   # First line of question
   if (/^\d*]\s*(.*)/) {
      $type = 'question';
      $curQ = {
         $type => $1,
         answers => [],
      };
      $questions{++$questionIndex} = $curQ;
      $answerIndex = -1;
   }

   # First line of an answer
   elsif (/^.[})]\s*(.*)/) {
      $type = 'answers';
      push @{$curQ->{$type}}, $1;
      $answerIndex++;
   }

   # Not first line of something, append the text to current content
   # Or maybe it's the question title at the very top
   else {
      if($curQ) {
         if ($type eq 'question') {
            $curQ->{$type} .= " $_";
         }
         else {
            $curQ->{$type}->[$answerIndex] .= " $_";
         }
      } else {
         # No questions at all yet, this is the title
         s/\s*$//;
         $title = "$_ ($qFilePath)";

         # The rest of the block isn't valid, skip it for this case
         next;
      }
   }

   # If this was a correct answer, make a note of which and remove the
   # indicator (@@ string).
   my $answerText = $curQ->{answers}->[$answerIndex];
   if ($answerText && ($answerText =~ s/@@//)) {
      $curQ->{correct} = $answerIndex;
      $curQ->{answers}->[$answerIndex] = $answerText;
   }
}
close QFILE;

# Clear the screen
# Clearing the screen is operating-system specific, try to figure out
# what we're running on:
SWITCH: {
    $_ = $OSNAME;

    /MSWin32/ && do { system "cls"; last SWITCH; };

    # Fall through probably means a Unix-like operating system.
    # We hope
    system "clear";
}


# Ask the questions
print "=" x COLUMNS . "\n";
print "$version\n";
print "=" x COLUMNS . "\n";
print "$title\n";

my $pass = 1;
my @indices = order keys %questions;
my $total = @indices;
my $index;
while ($total) {
    print "=" x COLUMNS . "\n";
    printf "Pass %i\n", $pass;
    print "=" x COLUMNS . "\n\n";

    my $number = 1;
    for $index (@indices) {
        my $curQ = $questions{$index};

        displayStats $pass, (scalar keys %questions), $total;

        # Display question
        print "-" x COLUMNS . "\n";
        printf "Pass %i, Question %i (Number %i of %i total in this pass)\n\n", 
            $pass, $index, $number, $total;

        $Text::Wrap::columns = 80;
        print wrap('', '', $curQ->{question});
        print "\n\n";

        # Get the letter-to-number mappings for this question.
        my ($lton_ref, $ntol_ref) = createAnswerHashes;
        my %lton = %$lton_ref;
        my %ntol = %$ntol_ref;

        # Display answers
        $Text::Wrap::columns = 73;
        for (sort keys %lton) {
            # Some of the question data has globs of extra spaces
            # Clean this up now right before display
            $curQ->{answers}->[$lton{$_}] =~ s/\s+/ /g;

            print "  $_}  ";
            print wrap('', '      ', $curQ->{answers}->[$lton{$_}]);
            print "\n\n";
        }

        # Receive answer from user
        print "Answer (a, b, c, d or q to exit test)? ";
        chomp (my $answer = <STDIN>);
        print "\n";

        # Check for program exit command
        if ($answer eq 'q') {
            print "Are you sure you want to interrupt the test (yN)? ";
            chomp (my $quitYn = <STDIN>);

            if ( $quitYn eq 'y' ) {
               print "\nEnding quiz program now\n\n";
               displayStats $pass, (scalar keys %questions), $total;
               exit 0;
            }

            redo;
        }

        # Determine correctness
        if($answer eq $ntol{$curQ->{correct}}) {
            print "CORRECT!";
            delete $questions{$index};
        }
        else {
            print "Incorrect, the correct answer is: " . $ntol{$curQ->{correct}};
        }

        print "\n\n";

        $number++;
    }

    # Get new list of remaining indices
    @indices = order keys %questions;

    # Display first-pass stats
    displayStats ($pass, (scalar keys %questions), $total) if $pass == 1;

    # Set up for the next pass
    $total = @indices;
    $pass++;
}

print "=" x COLUMNS . "\n";
printf "All questions answered correctly in %i passes.\n", $pass - 1;
print "=" x COLUMNS . "\n";