File Coverage

blib/lib/Games/QuizTaker.pm

Criterion	Covered	Total	%
statement	85	143	59.4
branch	17	38	44.7
condition	2	3	66.6
subroutine	13	16	81.2
pod	3	6	50.0
total	120	206	58.2

package Games::QuizTaker;
{
  use strict;
  use Text::Wrap;
  use Fcntl qw/:flock/;
  use Carp;
  use Data::Dumper;
  use Object::InsideOut;
  use vars qw($TESTONLY $VERSION);
  use Games::QuizTaker::IO;

  $VERSION='2.1';
  my $questions={};
  my %Randoms=();
  my @Randoms=();
  my %Test_Questions=();
  my %Test_Answers=();
  my $t;

  my @FileName :Field('Standard'=>'FileName','Type'=>'LIST');
  my @AnswerDelimiter :Field('Standard'=>'AnswerDelimiter','Type'=>'LIST');
  my @FileLength :Field('Standard'=>'FileLength','Type'=>'NUMERIC');
  my @Delimiter :Field('Standard'=>'Delimiter','Type'=>'LIST');
  my @MaxQuestions :Field('Standard'=>'MaxQuestions','Type'=>'NUMERIC');
  my @Score :Field('Standard'=>'Score','Type'=>'NUMERIC');

  my %init_args :InitArgs=(
      'FileName'=>{                     # Name of file with questions
        'Regex' => qr/^FileName$/i,
        'Mandatory' => 1,
      },
      'AnswerDelimiter'=>{              # This is the delimiter that separates multiple answers
        'Regex'=>qr/AnswerDelimiter/i,  # It is a space by default
        'Default'=>" ",
      },
      'FileLength'=>{                   # This is the number of questions in the file
        'Regex'=>qr/FileLength/,        # It is set when the question file is loaded
        'Default'=>0
      },
      'Delimiter'=>{                    # This is the delimiter that separates the questions and choices.
        'Regex'=>qr/Delimiter/i,        # It is the pipe | character by default
        'Default'=>"|"
      },
      'MaxQuestions'=>{                 # This is the maximum number of questions that can be asked for the test
        'Regex'=>qr/MaxQuestions/,
        'Default'=>undef
      },
      'Score'=>{                        # This controls whether or not you want an overall score printed out
        'Regex'=>qr/Score/i,
        'Default'=>undef
      },
  );

  sub _init :Init{
    my ($self,$args)=@_;
    if(exists($args->{'FileName'})){
      $self->set(\@FileName,$args->{'FileName'});
    }
    if(exists($args->{'AnswerDelimiter'})){
      $self->set(\@AnswerDelimiter,$args->{'AnswerDelimiter'});
    }
    if(exists($args->{'Delimiter'})){
      $self->set(\@Delimiter,$args->{'Delimiter'});
    }
    if(exists($args->{'Score'})){
      $self->set(\@Score,$args->{'Score'});
    }
    if(exists($args->{'MaxQuestions'})){
      $self->set(\@MaxQuestions,$args->{'MaxQuestions'});
    }
    if(exists($args->{'FileLength'})){
      $self->set(\@FileLength,$args->{'FileLength'});
    }
    my $ad=$self->get_AnswerDelimiter;
    my $dl=$self->get_Delimiter;
    if($ad eq $dl){ croak"The Delimiter and Answer Delimiter are the same!"; }
  }

  sub load{
    my $self=shift;
    my $delimiter=$self->get_Delimiter;
    my $file=$self->get_FileName;
    my ($question_number,$count);

    open(FH,"$file")||croak"Can't open $file: $!";
    flock(FH,LOCK_SH);
    while(){
      my @sorter;
      if(/^$/ or /^#/){}else{
        $count++;
        my $sep=qq"\\$delimiter";
        @sorter=split /$sep/;
        $question_number=shift @sorter;
        my $ref=\@sorter;
        $$questions{$question_number}=$ref;
      }
    }
    flock(FH,LOCK_UN);
    close FH;
    $self->set_FileLength($count);
  }

  sub generate{
    my $self=shift;
    my $Total_Questions=$self->get_FileLength;

    if(!defined $self->get_MaxQuestions){
      $self->set_MaxQuestions($Total_Questions);
    }

    my $Max_Questions=$self->get_MaxQuestions;

    for(1..$Max_Questions){
      my $question_number=int(rand($Total_Questions)+1);
      redo if exists $Randoms{$question_number};
      $Randoms{$question_number}=1;
    }

    @Randoms=keys %Randoms;
    $self->shuffle(\@Randoms);

    for(my $D=0;$D<$Max_Questions;$D++){
      $Test_Answers{$Randoms[$D]}=pop @{$$questions{$Randoms[$D]}};
      $Test_Questions{$Randoms[$D]} = $$questions{$Randoms[$D]};
    }
    $TESTONLY=$$questions{'1'}[0];
}

  sub test{
    my $self=shift;
    my $Answer_Sep=$self->get_AnswerDelimiter;
    my $Max=$self->get_MaxQuestions;
    my ($answer,$key,$line,$question_answer);
    my $question_number=1;
    my $number_correct=0;
    my $asep=qq"\\$Answer_Sep";
    system(($^O eq "MSWin32"?'cls':'clear'));
    print"\n";

    while($question_number<=$Max){
      $key=shift @Randoms;

      print"Question Number $question_number\n";
      $t=$$questions{$key}[0];      #Used for module testing
      foreach $line(@{$$questions{$key}}){
       Games::QuizTaker::IO::out(wrap("","","$line\n"));
      }

      print"Your Answer: ";
      $answer=Games::QuizTaker::IO::in;
      chomp($answer);
      $answer=uc($answer);
      $question_answer=$Test_Answers{$key};
      chomp($question_answer);
      $question_answer=uc $question_answer;
      my $ln=length($question_answer);

      if($ln>1){
        if($question_answer!~/$Answer_Sep/){
          warn"Answer_Delimiter doesn't match internally";
        }
        if($Answer_Sep eq " "){ }else{
          $question_answer=~s/$asep/ /;
        }
        $question_answer=$self->answer_sort($question_answer);
        $answer=$self->answer_sort($answer);
      }

       if("$answer" eq "$question_answer"){
        print"That is correct!!\n\n";
        $question_number++;
        $number_correct++;
      }else{
        print"That is incorrect!!\n";
        print"The correct answer is $question_answer.\n\n";
        $question_number++;
      }
    }
    my $Final=$self->get_Score;
    if(defined $Final){
      $self->Final($number_correct,$Max);
      return;
    }else{
      return;
    }
  }

  sub answer_sort{
    my ($self,$answer)=@_;
    my @array=split //,$answer;
    my @sorted=sort @array;
    $answer=join ' ',@sorted;
    return $answer;
  }

  sub Final{
    my ($self,$Correct,$Max)=@_;

    if($Correct >= 1){
      my $Percentage=($Correct/$Max)*100;
      print"You answered $Correct out of $Max correctly.\n";
      printf"For a final score of %02d%%\n",$Percentage;
      return;
    }else{
      print"You answered 0 out of $Max correctly.\n";
      print"For a final score of 0%\n";
      return;
    }
  }
  sub shuffle{
  ## Fisher-Yates shuffle ##
    my ($self,$array)=@_;
    my $x;
    for($x=@$array;--$x;){
      my $y=int rand ($x+1);
      next if $x == $y;
      @$array[$x,$y]=@$array[$y,$x];
    }
  }
  sub DESTROY{
    my $self=shift;
    unlink $self;
  }
}
1;
__END__