use strict;
use CGI qw( :all ) ;
use XML::DT ;

undef $/;
my $texto = <>;
$texto =~ s/.*\n//;                  # elimina a 1.a linha ...

print $texto;

my %par= CGI::Vars();  

print header,
      start_html( -title=>'teste',
                  -author=>'jj@di.uminho.pt');
print teste2html($texto,\%par);
print end_html();

sub teste2html{
  my $texto = shift;
  my $par   = shift;
  my $k=0;
  my %sol=();                          #solução do teste

  my %handler=(
     -type => { escolham => "SEQ",
                questao  => "MAP",
                exame    => "SEQ",
              }, 
     '-outputenc' => 'ISO-8859-1',
     '-default'   => sub{$c},
     'alinea'     => sub{$sol{++$k}=($v{validacao} eq "true" ? 1: 0);
                         +{val => $v{validacao}, texto => $c}},
     'questao'    => sub{+{n=>$v{numeroQ}, %$c }},
  );
  my $tre= dtstring($texto,%handler); # calcula %sol, $k como efeito lateral

  if (param){ print classifica(\%sol,\%par,$k,$tre) }
  else      { print start_form(), mkform($tre), end_form();}

}

sub mkform{
  my $tre=shift;
  my $sol=shift || {};
  for(keys %$sol){ $sol ->{$_} = ($sol ->{$_} ? "x":"_") }
  my $r="";
  my $n=0;
  for(@$tre){
    $r .= hr ;
    $r .= $_->{enunciado};
    for (@{$_->{escolham}}){
      $r .= br . $sol->{++$n}
         . checkbox(-name=> $n, -label=> $_->{texto});
    }
  }
  $r .= hr.submit(-name=>"Done");
  $r
}

sub classifica{
 my ($sol,$par,$k,$tre)=(@_);
 my $cert=0;
 for(keys %$sol){
   $cert ++ if ($par->{$_} && $sol->{$_} or !$par->{$_} && !$sol->{$_} ) }
 sprintf('Classificação final: %2.0f%%',($k-($k-$cert)*2)*100/$k) .  mkform($tre,$sol) 
}