#!/usr/bin/perl

# ftestcurso.pl
# This script is copyright 2007, DOMINGO RAMOS CORPAS.
#
#########################################################################
##### USTED NO ESTA AUTORIZADO A COPIAR NI MODIFICAR ESTE SOFTWARE.
#####                                                                   
#####                                                                   
#########################################################################
#

$scripturl = "http://www.fetaltest.com/cgi-bin/ftestevaluacioncurso.cgi";
%rec = &get_data();
$rec{'nombre'}=~ s/\ /_/g;
$rec{'nombre'}=~tr/[a-z]/[A-Z]/;
$nombre=$rec{'nombre'};
@respuestas=("0","D","B","A","D","C","A","B","D","A","A","B","C","D","C","C","B","A","A","C","B","D","A","A","D","C","D","C","B","B","D","C","A","D","D","A","A","B","C","B","D","C","A","D","C","C","A","B","D","C","A","A","A","C","B","D","A","A","D","C","D","C");
@seleccionadas=();
$tope=46;

print "Content-type: text/html\n\n";
&cabeceradepagina();
&encabezamiento();



print <<EOF;
<form action="ftestevaluacioncurso.cgi" method="GET">
EOF
$codigo=$rec{'codigo'};
if (!$codigo){&codigo();
&condiciones();

}else{
if ($codigo eq "rcd00"){&domingo();}else{
@preguntas=();
@valores=();
$archivo = "ftestcursoclaves.db";
open(FILE,"$archivo");
flock(FILE, 1);
while(<FILE>) {
$linea= $_;
$linea =~ s/NULL//g;
@valores = split(/\|/, $linea);
if ($valores[0] eq $codigo){
@preguntas = split(/\|/, $linea);
$nombre=$preguntas[1];
}
}
close(FILE);
if (!$nombre){
print <<EOF;
<br><p>
<p><b>Usted no puede tener acceso en este momento al cuestionario de evaluaci&oacute;n. <br>Por Favor, asegurese de que reune los requisitos para dicho acceso.</b>
<br><p>
EOF
&condiciones();
}else{

&preguntas;
}}}



print <<EOF;
</form>
<br><p><br><p><br><p><br><p>
EOF
&piedepagina();

exit;

sub codigo{
print <<EOF;
<br><p>
<p>INTRODUZCA SU CODIGO DE ACCESO A LA PRUEBA DE EVALUACION: <INPUT TYPE="TEXT" NAME="codigo" SIZE=20> <INPUT TYPE="submit"  name="ACCION"  VALUE="Entrar">
<br><p>
<p><b>Para poder acceder a la prueba de evaluación es necesaria la inscripción previa al curso:</b>
EOF
}


sub condiciones {
print <<EOF;
<br><p>

<br><p>
<TABLE CLASS='Bordernegro' width=70%><tr><td CLASS="borde" vAlign=top><b>INSCRIPCION</b></TD></TR></TABLE>
<br><p>
<li>Requisitos
<dir>
<p align=justify>Solo se aceptar&aacute; la inscripci&oacute;n a los M&eacute;dicos Especialistas en Obstetricia y Ginecolog&iacute;a.
</dir>
<li>Forma Inscripci&oacute;n
<dir>
<p>Remitiendo al Dr. Ramos-Corpas (Director t&eacute;cnico del grupo de trabajo de cromosomopat&iacute;as de la SEGO), por <a href=mailto:ramoscor\@arrakis.es>email</a> la siguiente documentaci&oacute;n:
<dir>
<br>
<li>Carta de presentaci&oacute;n, que incluya breve curriculum.
</dir></dir>
<li>Precio Inscripci&oacute;n: 50 Euros. (Se abonar&aacute; mediante transferencia bancaria, una vez que haya sido aceptada la inscripci&oacute;n al curso).
<br><p>
<TABLE CLASS='Bordernegro' width=70%><tr><td CLASS="borde" vAlign=top><b>EVALUACION</b></TD></TR></TABLE>
<p align=justify>Una vez inscrito, el alumno será sometido a dos pruebas de evaluaci&oacute;n:
<li>Un cuestionario tipo test con preguntas relacionadas con el temario del curso.
<li>Junto con el cuestionario cumplimentado, el alumno deberá remitir 3 imagenes ecograficas, obtenidas por el alumno en su práctica clinica habitual, de cada una de las siguientes mediciones:
<dir>
<li>Translucencia Nucal
<li>Hueso Nasal
<li>Pliegue Nucal
<li>Pelvis Renal
<li>Longitud de H&uacute;mero
</dir>
<br><p>
EOF


}




sub domingo{

print <<EOF;
<br><p>

<p>INTRODUZCA SU CODIGO DE ACCESO A LA PRUEBA DE EVALUACION: <INPUT TYPE="TEXT" NAME="codigo" SIZE=20 value="$rec{'codigo'}"> 
<br><p>
<p>NOMBRE DEL ALUMNO : <INPUT TYPE="TEXT" NAME="nombre" SIZE=70 value="$nombre"> 
<br><p>
<p>CODIGO DEL ALUMNO : <INPUT TYPE="TEXT" NAME="alumno" SIZE=20 value="$rec{'alumno'}"> 
<br><p>


<INPUT TYPE="submit"  name="ACCION"  VALUE="Entrar" >
<br><p>
</center>
EOF
if ($rec{'alumno'} ne ""){

@valores=();
$cadena="0|";
$archivo = "ftestpreguntas.db";
open(FILE,"$archivo");
flock(FILE, 1);
while(<FILE>) {
$linea= $_;
$linea =~ s/NULL//g;
@valores = split(/\|/, $linea);
$cadena=$cadena.$valores[2]."|";
$numpreg++;
}
close(FILE);
@valores=();
@valores = split(/\|/, $cadena);

$cadena2=$rec{'alumno'}."|";
$cadena2.=$rec{'nombre'};
$cadena2.="|";
$numpreguntas=1;
$a=rand(10);
$a=int($a);

while ($numpreguntas<$tope){
&buscapreguntas();
$a=0;
}
print <<EOF;
<br><p>

<p>$cadena2
EOF
$output= "$cadena2\n";
$archivo = "ftestcursoclaves.db";
open (DB, ">>$archivo");
	print DB $output;
	close DB;

$codigo=$rec{'alumno'};
&preguntas();

}
}

sub buscapreguntas{

for ($i=1;$i<=$numpreg;$i++){
if ($numpreguntas<$tope){
if ($i>$a){
if ($valores[$i] eq $respuestas[$numpreguntas]){
$valores[$i]="";
$cadena2.=$i;
$cadena2.="|";
$numpreguntas++;
}
}
}
}

}



sub preguntas{
@preguntas=();
@valores=();
$archivo = "ftestcursoclaves.db";
open(FILE,"$archivo");
flock(FILE, 1);
while(<FILE>) {
$linea= $_;
$linea =~ s/NULL//g;
@valores = split(/\|/, $linea);
if ($valores[0] eq $codigo){
@preguntas = split(/\|/, $linea);
$nombre=$preguntas[1];
}
}
close(FILE);
print <<EOF;
<u><b>IMPORTANTE:</b></u>
<br><p>
<P align=justify>Por favor,  cumplimente y remitala por <a href=mailto:ramoscor\@arrakis.es>email</a>, la hoja de respuesta de esta prueba de evaluaci&oacute;n (que se incluye al final).

<br><p>Junto con esta prueba de evaluaci&oacute;n no olvide remitir:
<li>Fotocopia del título de Médico Especialista en Obstetricia y Ginecología
<li>Tres imagenes ecograficas de cada una de las siguientes mediciones: 
<dir>
<li>Translucencia Nucal 
<li>Hueso Nasal 
<li>Pliegue Nucal 
<li>Pelvis Renal 
<li>Longitud de Húmero 
</dir>
<br><p>
<p>Para efectuar el pago debe realizar una transferencia bancaria por importe de 50 Euros en la siguiente C/C:<br>
<p>ASOCIACION ESPAÑOLA DE MEDICINA FETAL
<p>0030 4066 51 0000693271
<p>BANESTO
<br>
<p>(La evaluaci&oacute;n no se finalizar&aacute; hasta que no se haya producido el pago).
<br><p>
<u><b>PRUEBA DE EVALUACION DEL ALUMNO $nombre</b></u>
EOF


for ($i=2;$i<=$tope;$i++){
$numpreguntas=$i;
$orden=$preguntas[$numpreguntas];
&buscapreguntas2();
}
&plantilla();
}

sub buscapreguntas2{

@valores=();
$archivo = "ftestpreguntas.db";
open(FILE,"$archivo");
flock(FILE, 1);
while(<FILE>) {
$linea= $_;
$linea =~ s/NULL//g;
@valores = split(/\|/, $linea);
if ($valores[0]==$orden){
$apreg++;
print <<EOF;
<br><p>
<p><b>$apreg</b>  $valores[1]
<dir>
<p>A) $valores[3]
<p>B) $valores[4]
<p>C) $valores[5]
<P>D) $valores[6]
</dir>
EOF

}
}
close(FILE);
}



sub plantilla {
print <<EOF;
<br><p>
<u><b>HOJA DE RESPUESTAS DE LA PRUEBA DE EVALUACION DEL ALUMNO $nombre</u></b>
<br><p>
<center><table width=70%>
EOF


for ($i=1;$i<=25;$i++){
$j=$i+25;
print <<EOF;
<tr><td width=50%><b>$i</b> (A) (B) (C) (D) </TD><td width=50%><b>$j</b> (A) (B) (C) (D)</TD></tr>
EOF
}
print <<EOF;
</table></center>

EOF
}






sub encabezamiento{
print <<EOF;
<table border=0 cellpadding=5 cellspacing=3 width=100% align=center valign=top><tr><td colspan=2 bgcolor="#140059"><b><FONT FACE="Tahoma, arial,helvetica" size=3 color="#FFFFFF"> PRUEBA DE EVALUACION DEL CURSO FETALTEST SOBRE CRIBADO DE ANEUPLOIDIAS</b></td></tr></table></center>
<br>
<blockquote>
EOF
}

sub piedepagina{
print <<EOF;
</blockquote>
<br><p>

EOF
$archivo = "pienuevo";
open(FILE,"$archivo");
while($entry = <FILE>) {
        print $entry;
}
close(FILE);
}


sub cabeceradepagina{
$archivo = "cabeceranueva";
open(FILE,"$archivo");
while($entry = <FILE>) {
        print $entry;
}
close(FILE);
$archivo = "cabeceranueva2";
open(FILE,"$archivo");
while($entry = <FILE>) {
        print $entry;
}
close(FILE);
}




sub get_data {
    local($string);

    # get data
    if ($ENV{'REQUEST_METHOD'} eq 'GET') {
        $_ = $string = $ENV{'QUERY_STRING'};
	tr/\"~;/_/;
	$string = $_;

    }				
    else { read(STDIN, $string, $ENV{'CONTENT_LENGTH'});
        $_ = $string;
	$OK_CHARS='a-zA-Z0-9=&%\n\/_\-\.@';
	tr/\"~;/_/;
	$string = $_;
	   }

    # split data into name=value pairs
    @rec = split(/&/, $string);
   
    # split into name=value pairs in associative array
    foreach (@rec) {
	split(/=/, $_);
	$_[0] =~ s/\+/ /g; # plus to space
	$_[0] =~ s/%(..)/pack("c", hex($1))/ge; # hex to alphanumeric
	$rec{"$_[0]"} = $_[1];
    }

    # translate special characters
    foreach (keys %rec) {
	$rec{"$_"} =~ s/\+/ /g; # plus to space
	$rec{"$_"} =~ s/%(..)/pack("c", hex($1))/ge; # hex to alphanumeric
    }

    %rec;			# return associative array of name=value
}


sub parse_form {
# --------------------------------------------------------
# Parses the form input and returns a hash with all the name
# value pairs. Removes SSI and any field with "---" as a value 
# (as this denotes an empty SELECT field.

	my (@pairs, %in);
	my ($buffer, $pair, $name, $value);	

	if ($ENV{'REQUEST_METHOD'} eq 'GET') {
		@pairs = split(/&/, $ENV{'QUERY_STRING'});
	}
	elsif ($ENV{'REQUEST_METHOD'} eq 'POST') {
		read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
 		@pairs = split(/&/, $buffer);
	}
	else {
		&cgierr ("This script must be called from the Web\nusing either GET or POST requests\n\n");
	}
	PAIR: foreach $pair (@pairs) {
		($name, $value) = split(/=/, $pair);
		 
		$name =~ tr/+/ /;
		$name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;

		$value =~ tr/+/ /;
		$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;

		$value =~ s/<!--(.|\n)*-->//g;			  # Remove SSI.
		if ($value eq "---") { next PAIR; }		  # This is used as a default choice for select lists and is ignored.
		(exists $in{$name}) ?
			($in{$name} .= "$value") :	      # if ( we have multiple select, then we tack on
			($in{$name}  = $value);				  # using the ~~ as a seperator.
	}
	return %in;
}