package Exercise::Gen::Verify;

use strict;
use warnings;
use File::Path qw(make_path);
use Set::Scalar;
require Exporter;

our @ISA = qw(Exporter);

our %EXPORT_TAGS = ( 'all' => [ qw( ) ] );
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
our @EXPORT = qw(
    &verify_exercise  &verify_test
    &set_exercise_answer &set_exercise_enun &set_exercise_html
    &get_exercise_answer &get_exercise_enun &get_exercise_html
	&get_number_answer &exists_user_exercise  &get_exercise_test
    &set_exercise_verify_func &set_exercise_test &set_exercise
    &get_stats &get_topid
	&add_user_exercise &get_user_exercise
    &pass_newid
    &set_pass_basedir &get_pass_basedir
    &db_tie &db_untie
    &exists_exercise_id
    &mk_exercise_base
    &mk_exercise_base_str
    &dump_exer
    &parse_submission);

our $VERSION = '0.01';

## from a exercise-id -->
##   shows the questions from  ../MEX/mex.db
##   accepts an answer
##   validates the answers according to  ../MEX/mex.db
##   saves the user inf  ../MEX/user.db --> histório de cada aluno
##   /MEX/mex.db --> perguntas e rexpostas

use utf8::all;
use MLDBM qw(DB_File Storable); use DB_File; use Fcntl;
use Data::Dumper; $Data::Dumper::Terse=2; $Data::Dumper::Indent=0;
use Math::Symbolic::MaximaSimple qw(:all);

## our($debug, $id, $passarola_dir,$t);  ## debug, exid, passarola_dir, test number
our($passarola_dir,$debug,$t);  ## debug, exid, passarola_dir, test number

$debug=0;

my ($p1,$p2);
our %EXER;
our %USER;
our %compf;

set_pass_basedir("$ENV{'HOME'}/.passarola") if defined($ENV{'HOME'});

#  { no warnings;
#    if (not -d $passarola_dir) { mkdir $passarola_dir }
#    if (-d $passarola_dir) {
#      $p1=tie %EXER, 'MLDBM',"$passarola_dir/mex.db" , O_CREAT|O_RDWR, 0666 or die $!;
#      $p2=tie %USER, 'MLDBM',"$passarola_dir/user.db", O_CREAT|O_RDWR, 0666 or die $!;
#    }
#  }

%compf=(  # table of comparation
  real    => sub{ my($a,$b,$at)=@_; realcmp($a,$b,$at)},
  n       => sub{ my($a,$b)=@_;                                     ## integer
        if($b =~ /^\s*[+-]?\d+\s*$/){ return ($a == $b)}
        else                        { return 0 }}    ,
  s       => sub{ my($a,$b)=@_; return ($a eq $b)},                 ## string
  bool    => sub{ my($a,$b)=@_; return (bool($a) eq bool($b))},     ## Booleano
  icstr   => sub{ my($a,$b)=@_; return icstr($a) eq icstr($b)},     ## ignore case
  icastr  => sub{ my($a,$b)=@_; return icastr($a) eq icastr($b)},   ## ic and accents
  set     => sub{ my($a,$b,$at)=@_; return cmp_set($a,$b,$at)},             ## set of X
  list    => sub{ my($a,$b,$at)=@_; return cmp_list($a,$b,$at)},            ## deep seq of x
  #fun    => sub{},               #TO BE CONTINUED                  ## fun: A->B
  tabfun  => sub{ my($a,$b,$at)=@_; tabfun($a,$b,$at)},       #
  meshfun => sub{ my($a,$b,$at)=@_; meshfun($a,$b,$at)},       #
  r_rfunmax=> sub{ my($a,$b,$at)=@_; r_rfunmax($a,$b,$at)},   # FIXME 30%
  memberof=> sub{ my($a,$b,$at)=@_; memberof($a,$b,$at)},
  ## uni  => sub{ my($a,$b)=@_; return cmp_list($a,$b)},                 ##
  uni     => sub{ my($a,$b,$at)=@_; return icastr($a) eq icastr($b)},   ## ic and accents
);
#}

sub realcmp{my ($a,$b,$at)=@_;
    my $err_r= 1/100000;
    my $err_a;
    if(defined $at->{err}){
       if   ($at->{err} =~ /(\d+(\.\d+)?)\s*\%/){ $err_r=$1/100 }
       elsif($at->{err} =~ /(\d+(\.\d+)?)\s*$/) { $err_a=$1     }
    }
    if($err_a){ return abs($a-$b) <= $err_a         }
    else      { return abs($a-$b) <= abs($a)*$err_r }
}

sub memberof{ my ($a,$b,$at)=@_;   ## FIXME: em obras
   if   (ref $a eq "ARRAY"){}
   elsif(ref $a ){ return 0}
   else { no warnings;  $a = eval("$a");}
   if(not ref($a) eq "ARRAY") {
      print STDERR "Error bad set=$a def (in verification): should be an ARRAY\n" ;
   }
   for(@$a){return 1 if is_eq($_,$b,{})};
   return 0
}

sub meshfun{ my ($f1,$f2,$at)=@_;   ## FIXME: em obras
  my $dom = $at->{dom};
  my @tests;
  my $f11 = $f1;
  my $f21 = $f2;
  my $dom1 = $dom;
  my $goodfun = 1;
  if(not ref($dom)){
     no warnings;
     $dom1 = eval($dom);
     print STDERR "Error in $dom: $@\n" if ($@ && $debug);
  }
  if(not ref($f1) eq "CODE"){
     no warnings;
     $f11 = eval($f1);
     $goodfun=0 if ($@);
     print STDERR "Error in $f1: $@\n" if ($@ && $debug);
  }
  if(not ref($f2) eq "CODE"){
     no warnings;
     $f21 = eval($f2);
     $goodfun=0 if ($@);
     print STDERR "Error in $f2: $@\n" if ($@ && $debug);
  }

  if($goodfun and ref($dom1) eq "ARRAY"){
    my $tab = [ map { if(ref($_)){[ @$_, fcal($f11,@$_)]}
                      else       {[ $_ , fcal($f11,$_ )]} } @$dom1 ];
    return  tabfun($tab,$f21,{});
  }
  else{
    if($goodfun){
     print STDERR "Error bad dom=$dom1... def (in verification): tab should be an ARRAY\n" ;
    }
    else{
     print STDERR "Error bad perl function (sub {...} expected)\n" ;
    }
     return 0;
  }
}

sub fcal{
 my ($a,@args)=@_;
 eval{$a->(@args) } // 'err'
}


sub tabfun{ my ($tab,$f,$at)=@_;   ## FIXME: em obras
  my @tests;
  my $f1 = $f;
  my $tab1 = $tab;
  if(not ref($tab)){
     no warnings;
     $tab1 = eval($tab);
     print STDERR "Error in $tab: $@\n" if ($@ && $debug);
  }
  if(not ref($f)){
     no warnings;
     $f1 = eval($f);
     print STDERR "Error in $f: $@\n" if ($@ && $debug);
  }
  my $ok=1;
  if(ref($tab1) eq "ARRAY"){
    for my $row (@$tab1){
      my @args =@$row;
      my $result = pop(@args);
      if(ref($f1)   eq "CODE"){
         my $r1 = fcal($f1,@args) ;
         my $r2 = is_eq($result, $r1, {});
         $ok &&= $r2;
         push(@tests,[$r2,[@args],$r1, $result,$at]); }
      else { $ok=0; }
    }
  }
  else{
     print STDERR "Error bad tab=$tab1... def (in verification): tab should be an ARRAY\n" ;
     $ok=0;
  }
#  return \@tests
  return $ok;
}

sub r_rfunmax{ my ($f1,$f2,$at)=@_;   ## maxima_f² x → bool  // just num → num
                                  ## FIXME: em obras
  my @tests;
  my $ok=1;
  if(is_eq($f1,$f2,{type=>"icstr"})){ return 1};
  my $r1 = maxima("h1(x):=$f1 -($f2)");
  my $r2 = maxima("h1(x)");
#  print STDERR "DEBUG: $r2\n" if $debug;
  if(is_eq($r2,0,{type=>"icstr"})){ return 1 }

  return 0; ## FIXME: sample it!

#  if(ref($tab) eq "ARRAY"){
#    for my $row (@$tab){
#      my ($result,@args)=@$row;
#      if(ref($f)   eq "CODE"){
#         my $r1 = $f->(@args);
#         my $r2 = is_eq($result, $r1, $c);
#         $ok &= $r2;
#         push(@tests,[$r2,[@args],$r1, $result,$c]); }
#      else { }
#    }
#  }
##  return \@tests
#  return $ok;
}

sub is_eq{ my ($answer,$submitted,$at)=@_;
  my $function = $at->{func} || "";
  my $type     = $at->{type} || "";
  if( ref($function) eq "CODE"     ) {return $function->($answer,$submitted,$at);}
  if( not $function and not $type  ) {$type = impli_type_of($answer);}
  warn("can't compare '$answer' '$submitted': what is type '$type'?\n") unless $compf{$type};
  if( not defined $answer){ return 1;}
  return $compf{$type}->($answer,$submitted,$at)?1:0;
}

#sub _printtab{
# for my $tab(@_){
#   if   (ref $tab eq "ARRAY"){ print map {Dumper($_)."\n"} @$tab}
#   elsif(ref $tab eq "HASH" ){ print map {Dumper($_,$tab->{$_})."\n"} keys %$tab}
#   else { print "$tab\n" }
# }
#}



sub mk_exercise_base_str{ # recebe exids
   my %opt =(enun => 0);
   if(ref($_[0]) eq "HASH") {%opt = (%opt , %{shift(@_)}) } ;
   my $str="\n#student  \n\n";
   $str .= "#test_id ". join('+',@_)."\n"  if @_ > 1;
   for my $id(@_){
      my $q= $EXER{$id}{answer};
      my $e= $EXER{$id}{com} || {};
      my $comg= $EXER{$id}{enun} || "";
      $comg =~ s!\n!\n// !g;

      $str .= "//". "_" x 60 ."\n#version_id $id\n";
      $str .= "//$comg\n" if $comg && $opt{enun};

      for(sort {substr($a,2)<=>substr($b,2)} keys %$q){ no warnings;
        my $com = $e->{$_}{com} || $q->{$_}{com} || $q->{$_}{type} || "";
        $com =~ s!\n!\n// !g;
        $str .=  "\n#$_ ";
        $str .=  "// $com" if $com;
        $str .=  "\n\n";
      }
   }
   return $str;
}

sub mk_exercise_base{
   print "\n#student  \n\n";
   print "#test_id ", join('+',@_),"\n"  if @_ > 1;
   for my $exid(@_){
      my $q= $EXER{$exid}{answer};
      my $e= $EXER{$exid}{com} || {};
      my $comg= $EXER{$exid}{enun} || "";
      $comg =~ s!\n!\n// !g;

      print "//", "_" x 60 ,"\n#version_id $exid\n";
      print "//$comg\n" if $comg;

      for(sort keys %$q){ no warnings;
        my $com = $e->{$_}{com} || $q->{$_}{com} || $q->{$_}{type} || "";
        $com =~ s!\n!\n// !g;
        print "\n#$_ ";
        print "// $com" if $com;
        print "\n\n";
      }
   }
}

# parse_submission: recebe uma submissão, determina se é um exercício único ou
# se é um conjunto (teste) e interpreta cada uma das secções (exercício)
sub parse_submission{
  my $input = join("/n",@_);
  $input ||= join("",<STDIN>);   # if no param get from stdin
  $input = "\n$input";
  $input =~ s!\s*$!!;

  my ($init, @secs) = split(/\s*\n#version_id\s+/,$input,-1);
  if( @secs >= 2) { ## test  (meta , q*)
     my @s = (parse_sec($init));
     for( @secs){ push(@s, parse_sec("#version_id $_"))}
     return \@s;
  }
  else { ## Just a question
     return parse_sec($input);
  }
}

# parse_sec: parse part of a submition
sub parse_sec{
  my $input = shift(@_);
  $input = "\n$input";
##  print STDERR "parse_sec('$input')\n";
  $input =~ s!\s*$!!;
  $input =~ s!\n//.*!!g;
  my @l = map { s/^\s*(.*?)\s*$/$1/; $_} split(/\s*\n#(\w+)(?:\s+\/\/.*)?/,$input,-1);
  my %args = ( _init => @l);
  delete($args{_init}) unless $args{_init} =~ /\S/;
  return \%args;
}

sub verify_dom{ my ($expected,$answ,) = @_;
 1 ; #FIXME domains should be equal?
}

sub verify_test{         ##  submission*, (versionId | answer)*  #FIXME -- untested
    my ($subm,$answ) = @_;
    if(not ref $subm){       ## textual submission
       $subm = parse_submission($subm);
    }
    die("Ver.Test: Invalid submission\n") unless ref($subm) eq "ARRAY";
    my ($Meta,@su)=@$subm;
    my @res=($Meta);
    for my $i(0..@su-1){
        my $answ = [] unless defined  $answ ;
        push(@res,[verify_exercise($su[$i],$answ->[$i])])
    }
    return (\@res )
}

sub verify_exercise{         ##  submission, (versionId | answer)?
    my ($subm,$answ) = @_;
    if(not ref $subm){       ## textual submission
       $subm = parse_submission($subm);
    }
    if   (ref($subm) eq "ARRAY"){ return verify_test($subm,$answ);}
    elsif(ref($subm) ne "HASH" ){ die("Verif. Exercise: Invalid submission\n")}

    my $version_id = $subm->{version_id} ;

    if(not defined $answ and defined $version_id){
                           # no answer: get exer{subm{versionid)}}
       $answ = $EXER{$version_id}{answer};
       die("invalid version: $version_id\n") unless $answ
    }
    elsif(not ref $answ){  # answer is a versio_id
       $version_id = $answ unless $version_id;
       $answ = $EXER{$answ}{answer};
       die("invalid version: $version_id\n") unless $answ
    }
    else{                  # answer is a HASH
       $version_id = "";
    }
    verify_dom($answ,$subm);
    $subm->{version_id}=$version_id;
    if($version_id){  # define subs in verify_func ir there is any
	  my $verify_func = get_exercise_verify_func($version_id);
	  eval($verify_func) if defined $verify_func;
      printf STDERR "Error in verify fun def. code$@\n" if $@;
    }
    _aux_verify_exercise($subm,$answ);
}

sub add_fun{
   my($id,$f,$type)=@_;
   $compf{$id}= $f;
}


sub _aux_verify_exercise{         ##  submission, answer
    my ($subm,$answ) = @_;
    my $code = $subm->{version_id} ;
    my @res;
    my $cot=0;
    my $cot_total;
    for(sort keys %$answ){
        my $item = $answ->{$_};
        $cot_total += $item->{cot} || 1;
        {no warnings; print STDERR "Debug:$_-'$answ->{$_}{v}' =?= '$subm->{$_}'" if $debug ;}
        if(defined $subm->{$_} and $subm->{$_} =~ /\S/){
           my $at={%$item};
           if($item->{func}){
             if(    ref($item->{func}) eq "CODE"){ $at->{func} = $item->{func} } # is reference to code FIXME
             if(defined $compf{$item->{func}}   ){ $at->{type} = $item->{func} } # name of custom function is given, and is defined in compf
             else{
               if(not ref($item->{func})        ){ $at->{func} = eval $item->{func} }
             }
           }
           else{
             $at->{type} = $item->{type} || impli_type_of($item->{v});
           }

           print "is_eq(",$item->{v}||"?",$subm->{$_}||"?",$at->{type}||"?",")\n" if $debug;
           my $r = is_eq($item->{v},$subm->{$_},$at);
           if($r){ $cot += $item->{cot} || 1;
                   print STDERR "'Correcto!'\n" if $debug ; }
           else  { print STDERR "'Errado!'\n" if $debug ;   }
           push(@res,[$_,$r,$at->{type},$item->{v},$subm->{$_}]);
        }
        else { ## empty submission
           print STDERR "''\n" if $debug ;
           push(@res,[$_,'-',$item->{type},$item->{v},"-"]);
        }
    }
    if($cot_total){ return ({total=>(100*$cot)/$cot_total},\@res);}
    else          { return ({total=> "-"                 },\@res);}
}

sub _not_used_do_exercise{
    my ($cod, $aluno,$resp) = @_;
    print $EXER{$cod}{enun};
    my $answer;
    my $tmp = $USER{$aluno};
    my $tmp2 = $tmp->{$cod};
    my @array;
    my $compar;
    load_perl($EXER{$cod}{perl});
    my $n = 1;
    for (@{$EXER{$cod}{answer}}){
       $answer = $resp->("p$n");
       if($answer){
	      if($_->{func}){
            $compar = $compf{$_->{func}};
          }
          else{
            my $type = $_->{type} || impli_type_of($answer);
            $compar = $compf{$type};
          }

          push(@array, $answer);
          if($compar->($answer,$_->{answer})){   print 'Correcto!'; }
           else{ print 'Errado!'; }
       }
       $n++;
    }
    unshift (@{$tmp2}, [@array]);
    $tmp->{$cod} = $tmp2;
    $USER{$aluno} = $tmp;
}


sub _not_used_load_perl{
  my $x = shift;
  eval($x);
}

sub _not_used_add_fun{
   my($id,$f,$type)=@_;
   $compf{$id}= $f;
}

sub _not_used_print_exercise{
    my ($cod, $aluno) = @_;
    print  $EXER{$cod}{enun};
    my $n = 1;
    for (@{$USER{$aluno}{$cod}[0]}){
       print "Resposta dada à pergunta $n: $_ <br />\n";
       $n++;
    }
}

#############################
# Compare functions
#############################

sub icstr{my $a=shift; ## Norm. spaces; lower case
  $a=~ s/^\s*//;
  $a=~ s/\s*$//;
  $a=~ s/\s+/ /g;
  $a=~ s/\b \B//g;
  $a=~ s/\B \b//g;
  return lc($a);
}

sub bool{
  my $a = lc(shift);
  if(  $a eq "v"
    or $a eq "verdade"
    or $a eq "t"
    or $a eq "ok"
    or $a eq "true"
    or $a eq "1"){ return 1;}
  if(  $a eq "f"
    or $a eq "falso"
    or $a eq "no"
    or $a eq "not ok"
    or $a eq "false"
    or $a =~ /^0$/){ return 0;}
  return "?";
}

sub icastr{ ## Norm special caracters
  my $_ = shift;
  y{áéíóúàèìòùÁÉÍÓÚÀÈÌÒÙâêîôûÂÊÎÔÛçÇãõÃÕ}{aeiouaeiouAEIOUAEIOUaeiouAEIOUcCaoAo};
  return icstr($_);
}

sub cmp_list{
  my ($answer, $input,$at) = @_;
  if   (ref $input eq "ARRAY"){}
  elsif(ref $input ){ return 0}
  else { no warnings;  $input = eval("$input");}

  if   (ref $answer eq "ARRAY"){}
  elsif(ref $answer ){ return 0}
  else { no warnings;  $answer = eval("$answer");}

  return ($answer~~$input and $input~~$answer);
}

sub cmp_set{
  my ($answer, $input,$at) = @_;

  my $inp; my $ans;

  if   (ref $input eq "ARRAY"){}
  elsif(ref $input ){ return 0}
  else { no warnings;  $input = eval("$input");}

  if   (ref $answer eq "ARRAY"){}
  elsif(ref $answer ){ return 0}
  else { no warnings;  $answer = eval("$answer");}

  if(ref $input eq "ARRAY" and ref $answer eq "ARRAY"){
    if(scalar(@{$input})!=scalar(@{$answer})){return 0;}
    $inp = Set::Scalar->new(@$input);
    $ans = Set::Scalar->new(@$answer);
    return($inp==$ans);
  }else{return 0;}
}

sub n{my $a = shift;
    return $a if(ref($a) or not defined $a);
    $a =~ s/\b \B//g;
    $a } ## FIXME: normalizer

sub impli_type_of{my $a=n(shift(@_)); # calculate a default type
  if(not defined $a)             { return "s"}
  if(ref $a eq "CODE")           { return "perlsub";}
  if(ref $a eq "ARRAY")          { return "list";}
  if($a =~ m/^[+-]?\d+$/)        { return "n";}
  if($a =~ m/^[+-]?\d+(\.\d*)$/) { return "real";}
  if($a =~ m/^\[.*\]$/s)         { return "list";}
  if($a =~ m/^\{.*\}$/s)         { return "set";}
  if($a =~ m/^sub\s*{.*\}$/s)    { return "perlsubtxt";}
  if(1)                          { return "uni"}
  return "eq";
}

sub get_stats{
  my $topid = get_topid();
  my %user_total = ();			#placeholder for user data to be returned
  my %questions_total = ();		#placeholder for question data to be returned

  my %question_best_total = ();
  my $user_best_total = 0.0;
  my $questions_done = 0;
  my $nota;
  my $current_best;
  undef $current_best;

  for(keys %USER){
    for my $id(1..$topid-1){
        for(@{$USER{$_}{$id}}){
            my $nota = $_->[0]{total};
            $current_best = $nota if (defined $nota && $nota >= $current_best);
        }
        if(defined $current_best){
            $questions_done++;
            $user_best_total += $current_best;
            $question_best_total{$id}{done} = $question_best_total{$id}{done} + 1 || 1;
            $question_best_total{$id}{total} = $question_best_total{$id}{total} + $current_best || $current_best;
			$user_total{$_}{$id} = $current_best;
		    undef $current_best;
        }
    }
	$user_total{$_}{avg} = $user_best_total/$questions_done;
    $questions_done = 0;
    $user_best_total = 0.0;
  }

  for(1..$topid-1){
    my $curr = $question_best_total{$_};
	$questions_total{$_} = $curr->{total}/$curr->{done} if ($curr->{done} > 0);
  }

  return (\%user_total, \%questions_total);
}



sub get_all_user{
  return %USER;
}

sub exists_exercise_id{ my ($exid) = @_;
  defined $EXER{$exid};
}

sub exists_user_exercise{ my ($exid, $user) = @_;
  defined $USER{$user}{$exid};
}

sub add_user_exercise{ my ($exid, $user, @exs) = @_;
  my $tmp = $USER{$user};
  my $tmp2 = $tmp->{$exid};
  unshift (@{$tmp2}, [@exs]);
  $tmp->{$exid} = $tmp2;
  $USER{$user} = $tmp;
  $p1->sync();
}

sub get_user_exercise{ my ($exid, $user) = @_;
  $USER{$user}{$exid};
}

sub remove_exercise{ my (@id)=@_;
  for(@id){
     delete($EXER{$_});
  }
  $p1->sync()
}

sub get_exercise_enun{ my ($exid)=@_;
  my $aux = $EXER{$exid} || {};
  $aux->{enun}
}

sub get_exercise_html{ my ($exid)=@_;
  my $aux = $EXER{$exid} || {};
  $aux->{html}
}
sub get_exercise_answer{ my ($exid)=@_;
  my $aux = $EXER{$exid} || {};
  $aux->{answer}
}

sub get_exercise_verify_func{ my ($exid) = @_;
  my $aux = $EXER{$exid} || {};
  $aux->{verify_func}
}


sub get_number_answer{ my ($exid)=@_;
  my $aux = $EXER{$exid} || {};
  $aux->{n_answer}
}

sub set_exercise_test{ my ($exid, $exs) = @_;
  my $aux = $EXER{$exid} || {};
  $aux->{test} = $exs;
  $EXER{$exid} = $aux;
  $p1->sync();
}

sub get_exercise_test{ my ($exid) = @_;
  my $aux = $EXER{$exid} || {};
  $aux->{test}
}

sub set_exercise_enun{ my ($exid,$enun)=@_;
  my $aux = $EXER{$exid} || {};
  $aux->{enun} = $enun;
  $EXER{$exid} = $aux;
  $p1->sync()
}

sub set_exercise_html{ my ($exid,$html)=@_;
  my $aux = $EXER{$exid} || {};
  $aux->{html} = $html;
  $EXER{$exid} = $aux;
  $p1->sync()
}

sub set_exercise_answer{ my ($exid,$qs,$n)=@_;
  my $aux = $EXER{$exid} || {};
  $aux->{answer} = $qs;
  $aux->{n_answer} = $n;
  $EXER{$exid} = $aux;
  $p1->sync();
}

sub set_exercise_verify_func{ my ($exid, $verify_func) = @_;
  my $aux = $EXER{$exid} || {};
  $aux->{verify_func} = $verify_func;
  $EXER{$exid} = $aux;
  $p1->sync();
}

sub set_pass_basedir{ my $dir=shift;
  $passarola_dir = $dir;
  no warnings;
  if (not -d $passarola_dir) {
     mkdir $passarola_dir or return(0);
  }
  untie %EXER;
  untie %USER;

  $p1=tie %EXER, 'MLDBM',"$passarola_dir/mex.db" , O_CREAT|O_RDWR, 0666 or warn $!;
  $p2=tie %USER, 'MLDBM',"$passarola_dir/user.db", O_CREAT|O_RDWR, 0666 or warn $!;
  return(1);
}

sub set_exercise {my $e = shift; ##  exid enun html verify_func ans($%) verify($@)
  print STDERR "PASSDIR = ".$passarola_dir."\n" if $debug;
  print STDERR "Error: wrong exercise type\n"  unless ref($e) eq "HASH";
  print STDERR "Error: No passarola basedir: (".$passarola_dir.")\n" unless $p1;
  my $exid = $e->{exid} || pass_newid();

  if(!( $e->{answer}) and $e->{verify}){
    print STDERR "Error: wrong verify\n"  unless ref($e->{verify}) eq "ARRAY";
    my $n=0;
    for(@{$e->{verify}}){ $n++;
       $e->{answer}{"Q_$n"} = {v    => $_->{v1},
                            type => $_->{type},
                            func => $_->{func}}; }
  }

  $e->{n_ans} ||= scalar keys %{$e->{answer}};

  my $aux = $EXER{$exid} || {};

  for (keys %$e){$aux->{$_} = $e->{$_} }

  print STDERR "Error: No questions/answers provided \n"  unless  $aux->{n_ans};

  $EXER{$exid} = $aux;
  $p1->sync();
  return $exid;
}

sub pass_newid{
  my $topid = $EXER{topid} || 1;
  $EXER{topid} = $topid+1;
  $p1->sync();
  $topid;
}


sub get_topid{
  $EXER{topid} || 1;
}

sub dump_exer{
  print Dumper(%EXER);
}

sub get_pass_basedir{
  $passarola_dir
}

sub db_tie{
  $p1=tie %EXER, 'MLDBM',"$passarola_dir/mex.db" , O_CREAT|O_RDWR, 0666 or die $!;
  $p2=tie %USER, 'MLDBM',"$passarola_dir/user.db", O_CREAT|O_RDWR, 0666 or die $!;
}

sub db_untie{
  no warnings;
  untie %EXER;
  untie %USER;
}

END{
  no warnings;
  untie %EXER;
  untie %USER;
}


1;

__END__

=pod

=encoding utf8

=head1 NAME

 Exercise::Gen::Verify - Library for answer comparation and evaluation

=head1 SYNOPSIS

 use Exercise::Gen::Verify;

 set_exercise_answer(123,
  {
   q1a => {v=>'potatoes', type=>'s'},		//string: $a eq $b
   q1b => {v=>'potatoes', type=>'icstr'},	//string: ignore case
   q2a => {v=>'true', type=>'bool'},		//bool: 1, 't', 'v'
   q2b => {v=>'sin(x)', type=>'r_rfunmax'},	//maxima function
   q3 => {v=>3.001},				//3.001=3.001000000001
  }
 )

 verify_exercise(<submission>)
 verify_exercise(<submission>, <expected answer>)
 verify_exercise(<submission>, <version_id>)

 $sub = parse_submission()							// read from stdin
 $sub = parse_submission("#version_id 123 \n#q1 ... \n#qn ...}

 ok_exercise_base(123);								// dump a stub submission for ex

=head1 DESCRIPTION

 Validation module for Passarola (Exercise::Gen)

=head2 USER DEFINED VALIDATION

 The validation function (func => sub{...}),
 receives the expected value and the submited value
 and returns a boolean.

=head2 SUBMISSION FORMAT

=over

=item B<a>

 The expected answer is defined by a hash (question_id --> result)
 where result is a hash with:

 v    -- the value (or someting necessary for the validation function)
 type -- the type (each type has a comparion / validation function)
 func -- a user provided validation function (if usefull)
            (a CODE reference or a string with "sub{}")
 cot  -- cotation of that question

 If no type and no func is provided the "implicit type" is calculated (based
 on the value), making the 'v' enough for most cases.

=back

=head3 TYPES

=over

=item B<bool>

 boolean: accepts t, true, v, verdade, 1, ...

=item B<real>

 real: abs($a-$b) <= abs($a/100000)

=item B<n>

 integer: $a == $b

=item B<s>

 string: $a eq $b

=item B<icstr>

 string: ignore case string

=item B<icastr>

 string: ignore case and accents string

=item B<list>

 list: deep seq compare

=item B<tabfun>

 function: validation by sampling with a set of (result * args);
 test the funtion with those args

=item B<r_rfunmax>

 function: compare two maxima funtions
 memberof ($b in $a)

=back

=head1 EXAMPLES

=over

=item type example

 $answer=
 { ## strings
    q1a => {cot=>1,v=> "batatas",type=>"s"},
    q1b => {cot=>2,v=> "batatas",type=>'icstr'},
 ## boolean
    q0a => {cot=>2,v=>"t", type=>'bool'},
    q0b => {cot=>2,v=>"false"  , type=>'bool'},
 ## floats
    q2  => {cot=>3,v=>3.001,},
 ## list
    q3a => {       v=>[1,2,3]},
    q3b => {cot=>2,v=>[1,[2,3,3],3]},
    q3c => {cot=>2,v=>[1,'rui', 'joão']},
 ## member of
    q4  => {cot=>5,v=>[1,2,[5,5]],type=>'memberof'},
 ## user provided function
    q5  => {cot=>2,func=>  sub{my ($a,$b)=@_; $b =~ /\b(dog|cat)\b/} },
    q5b => {cot=>2,func=>q{sub{my ($a,$b)=@_; $b =~ /\b(dog|cat)\b/}}},
 ## undef
    q6  => {cot=>1,v=> undef},                  # undef = any
 ## perl function by a table
    q7a => {cot=>2,v=>[[9,3],[16,4],[100,10]],type => "tabfun"},
              # square(3)=9
    q7b => {cot=>2,v=>[[9,3,6],[16,4,12],[100,10,90]],type => "tabfun"},
              # sum(3,6)=9
 ## maxima real->real functions
    q8a => {cot=>5,v=>"sin(x)",type => "r_rfunmax"},
    q8b => {cot=>2,v=>"x^2+-3+x+x",type => "r_rfunmax"},
 }

=item check if a submited sentence contains the word cat or dog

 $answer= { q5 => { func=> sub{my ($a,$b)=@_;
					$b =~ /\b(dog|cat)\b/} }, ... }

 $sumission = { q5 => "John has got a cat and a bird", ... }

=back

=head2 EXPORT

=over

=item B<verify_exercise>

 verify_exercise(submission_hash)
 verify_exercise(submission_hash,expected_hash)
 verify_exercise(submission_str)

=item B<verify_test>

 ?

=item B<set_exercise_answer>

 ?

=item B<set_exercise_enun>

 ?

=item B<mk_exercise_base_str>

Returns a template for exercise answers submissions.
See also parse-submission and verify_exercise.

=item B<mk_exercise_base>

Prints a template for exercise answers.
See also parse-submission and verify_exercise.

=item B<parse_submission>

 ?

=back

=head1 SEE ALSO

perl(1)

=head1 AUTHOR

J. Joao, E<lt>jj@di.uminho.pt<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2013 by J.Joao

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.14.3 or,
at your option, any later version of Perl 5 you may have available.

=cut