save(/home/jj/inscritos2)
mail(jj)
cginame(/home/jj/public_html/bin/_2)
feedback(f)
formtitle(Trabalho prático 1 Factorial)

{

 {{Enunciado: escreva uma função perl que calcule o factorial de um número passado como parámetro.}};

 *fact                    : string 50 * 10 ;

 {{Enunciado: escreva uma função que traduza quantias de escudos para euros
 -- (as quantias em escudos têm ...$..). Os Euros devem aparecer com 2 casa
decimais. <p>
  Exemplo de teste: esc2eur('os bolos custam 60$00') deve dar:
 'os bolos custam 0.30 euros'}};

 *esc2eur                 : string 50 * 10 ;
 *nome                    ;
 *email                   : inv-mail
 
}

##

use warnings FATAL => qw(recursion) ;

sub mail { if( $_[0] =~ /\@/) {""} else { "Não parece ser um email"} }

sub f{
 join(";",
  testperlf( {timout=>2},"fact", $_[0]{fact},( 0 => 1, 3 => 6, 4 => 24)),
  testperlf( {timout=>2},"esc2eur", $_[0]{esc2eur},( 
    'os bolos custam 60$00' => 'os bolos custam 0.30 euros',
    'os bolos custam 60' => 'os bolos custam 60',
    'os bolos custam 60$00 e o café 55$00' => 'os bolos custam 0.30 euros e o café 0.28 euros' )
));
}

sub testperlf{
  my %opt =(timout => 1);                # tens um segundo para calculos...
  if(ref($_[0]) eq "HASH") {%opt = (%opt , %{shift(@_)}) } ;
  my ($name,$f,%tab)=@_;
  eval $f;
  if($@){ red("Erro $@\n")}
# elsif(not defined $main::{$name}){ red("Erro Não encontrei a função $name\n")}
  else  { testperlf1( \%opt,$main::{$name},%tab); }
}

sub testperlf1{
  my %opt =(timout => 1);                # tens um segundo para calculos...
  if(ref($_[0]) eq "HASH") {%opt = (%opt , %{shift(@_)}) } ;
  my ($f,%tab)=@_;
  my $i=0;
  my $ok=0;
  my $r="Resultados dos testes".CGI::start_ol();

  for(keys %tab){
    $i++;
    $SIG{'ALRM'} = sub {die "timeout\n"};
    eval{
      alarm($opt{timout});
      if(&$f($_) eq $tab{$_}){ $r.= li(" .. Ok");       $ok ++}
      else                   { $r.= li(red(" .. not ok
(",&$f($_),"),(",$tab{$_},")"));}
      alarm(0)
    };
    if($@){
      alarm(0);
      if   ( $@ =~ /timeout/ )   { $r.= li(red(" .. timeout")) }
      elsif( $@ =~ /recursion/i ){ $r.= li(red(" .. Recur. infinita(?)")); }
      else                       { $r.= li(red(" .. $@")); }
    }
  }
  $r.= CGI::end_ol(). p(sprintf("Total: %2d",int($ok*100/$i)));
  $r
}
##