#!/usr/bin/perl -s

## 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 strict;
use utf8::all;
use MLDBM qw(DB_File); use DB_File; use Fcntl ;
use Data::Dumper; $Data::Dumper::Terse=2; $Data::Dumper::Indent=0;

our($debug, $id, $passarola_dir);

my $id = shift;
my ($p1,$p2);

my %EXER;
my %USER;
my %compf;

BEGIN{
  # Make the .passarola directory (stores the db files)
  $passarola_dir ||= "$ENV{HOME}/.passarola";
  if (not -d $passarola_dir) { mkdir $passarola_dir }

  # Make the dbs
  $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
    f     => sub{ my($a,$b)=@_; return abs($a-$b) <= abs($a/100000)}, ## real
    n     => sub{ my($a,$b)=@_; return ($a == $b)},                 ## integer
    s     => sub{ my($a,$b)=@_; return ($a eq $b)},                 ## string
    bool  => sub{ my($a,$b)=@_; return (bool($a) eq bool($b))},     ## string
    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)=@_; }, #TO BE CONTINUED                 ## set of X
    list  => sub{ my($a,$b)=@_; return cmp_list($a,$b)},            ## seq of x
    #fun  => sub{},               #TO BE CONTINUED                  ## fun: A->B
    memberof=> sub{ my($a,$b)=@_; for(@$a){return 1 if is_eq($_,$b)}; return 0 },
    uni   => sub{ my($a,$b)=@_; return ($a eq $b)},                 ##
  );
}

# Try to guess and compare between variables (check table of comparation to see available types)
sub is_eq{ my ($a,$b,$c)=@_;
  if( ref($c) eq "CODE") { return $c->($a,$b);}
  if( not defined $c) {$c = impli_type_of($a);}
  warn("can compare '$a' '$b': what is type '$c'?\n") unless $compf{$c};
  if( not defined $a){ return 1;}
  return $compf{$c}->($a,$b);
}

#if( not defined $EXER{$id}){ die("Error...")}
#my $p=input_param();
#do_exercise($cod, $aluno,$p);

# Prints the data with a given tab character
sub printtab{ my $tab=shift;
 print map {Dumper($_)."\n"} @$tab
}

##TEST
 printtab verif_exercise( 
      { 1 => {v=> "batatas",type=>"s"},
        2 => {v=>3.001,},
        3 => {v=>"batatas",type=>'icstr'},
        4 => {v=>[1,2,3]},
        5 => {v=>[1,[2,3,3],3]},
        6 => {v=>[1,'rui', 'joão']},
        7 => {v=>[1,2,[5,5]],type=>'memberof'},
        8 => {func=>sub{my ($a,$b)=@_; $b =~ /\b(dog|cat)\b/}},
        9 => {v=> undef},                  # undef = any
      },
      { 1 => "batatas",
        2 => 3.001000001,                  # float comparation
        3 => "Batatas ",                   # eq with ic and accents
        4 => [1,2,3],
        5 => "[1,[2,3,3],3]",              #
        6 => "[1,rui, joão]",              # list compare
        7 => "[5,5]",                      # [5,5] ∈ correct option
        8 => "John has a cat and a bird",  # contains word cat or dog
        9 => 33,                           # undef = 33 OK
      }) ;

# Processes and returns the arguments
sub input_param{
  my $input = "\n".join("",<>);
  $input =~ s/\s*$//;
  my @l = split(/\s*\n#(\w+)\s*/,$input,0);
  my %args = ( _init => @l);

  print Dumper(\%args);
  return \%args;
}

# Make a domain comparison
sub verif_dom{ my ($expected,$answ,) = @_;
 1 ; #FIXME domains should be equal?
}

# Checks if an exercise is correct
sub verif_exercise{         ##  $EXER{$cod}{answer}
    my ($answ,$subm) = @_;
    verif_dom($answ,$subm);
    my @res;
    for(sort keys %$answ){
        my $item = $answ->{$_};
        print STDERR "Debug:Q$_-'$answ->{$_}{v}' =?= '$subm->{$_}'" if $debug ;
        if($subm->{$_}){
           my $type   = $item->{func} || $item->{type} || impli_type_of($item->{v});
           my $r = is_eq($item->{v},$subm->{$_},$type);
           if($r){ print STDERR "'Correcto!'\n" if $debug ; }
           else  { print STDERR "'Errado!'\n" if $debug ;   }
           push(@res,[$_,$type,$r,$item->{v},$subm->{$_}]);
        }
        else { push(@res,[$_,"",'-',$item->{v},"-"]);}
    }
    return \@res;
}

# Submit an exercise on behalf of a user
sub 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;
}


#  if(not $EXER{$cod}){
#      if(not $USER{$aluno}{$cod}){
#      }
#  }

# Runs the perl code in the argument
sub load_perl{
  my $x = shift;
  eval($x);
}  

# Adds a function to the compfi (table of comparition)
sub add_fun{
   my($id,$f,$type)=@_;
   $compf{$id}= $f;
}

# Shows the exercise and the given answers
sub 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
#############################

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

# Boolean comparison
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 eq "0"){ return 0;}
  return "?";
}

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

# List comparison
sub cmp_list{
  my ($answer, $input) = @_;
  if   (ref $input eq "ARRAY"){}
  elsif(ref $input ){ return ""}
  else { no strict;  $input = eval("$input");}
  
  return ($answer~~$input and $input~~$answer);
}  

# Normalizes (uncertain as to what it's supposed to do)
sub n{ $_[0] } ## FIXME: normalizer 

# Try to find what type the variable is of
sub impli_type_of{my $a=n(shift(@_)); # calculate a default type 
  if(ref $a eq "ARRAY")          { return "list";}
  if($a =~ m/^[+-]?\d+$/)        { return "n";}
  if($a =~ m/^[+-]?\d+(\.\d*)$/) { return "f";}
  if($a =~ m/^\[.*\]$/s)         { return "list";}
  if($a =~ m/^\{.*\}$/s)         { return "set";}
  if(1)                          { return "s"}
  return "eq";
}

untie %EXER;
untie %USER;