#!/usr/local/bin/perl

############################################################################
#
# M˘dulo:       parser.pl
# Autor:        Salvador Castej˘n.
# Versi˘n:      1.1
# Versiones:    1.1 (23Ago99, David): Introduzco, antes de la gesti˘n del SID,
#               la comprobaci˘n de un par metro (procedure), que sirve para
#               decirle al parser que debe llamar a una funci˘n; toda
#               funci˘n que sea llamada asˇ debe devolver el nombre de una
#               p gina, que ser  la que parsear  parser.pl.
#               1.2 (1Dic99, David): Aparte de algunos retoques que he ido metiendo,
#               lo más importante es meter en ModificaLink una comprobación
#               para no intentar parsear identificadores entre $$, !! o || cuando
#               estamos dentro de un bloque <script>, ya que que se producen
#               desastres varios.
#               1.3 (13Ene00, David): Permito que en el los tags de funciones se
#               pasen parámetros, cogiendo todo lo que queda entre paréntesis
#               detrás del tag.
#

$debug = 0;
$enscript = 0;

require "./config.pl";
require "./cgi-lib.pl";
require "./sesion.pl";
require "./forms.pl";


%ARGS=();

&ReadParse(*ARGS);

&Cookie();

# Si en el formulario viene un campo que sea 'procedure', debemos ejecutar
# una funci˘n antes de seguir con la gesti˘n del SID.
if ($ARGS{procedure})
{
   $ARGS{page} = &{$ARGS{procedure}};
}

if ($debug == 1) {print "<p>".$globalError."</p>";}

#if (!$ARGS{sid} || !$ARGS{page})
if (!$ARGS{page})
{
	PaginaInicio();
	exit 0;
}

$plantilla_page = $plantillas . $ARGS{page};
open (PLANTILLA_PAGE, "$plantilla_page");

$line_mod="";
undef $select;

while (<PLANTILLA_PAGE>)
{
	$line_mod = ModificaLink($_);
	print $line_mod;
}

close PLANTILLA_PAGE;


#######################
# Parse Form Subroutine

sub parse_form {

   local(@pairs)=();

   # Get the input
   read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});

   # Split the name-value pairs
   @pairs = split(/&/, $buffer);

   foreach $pair (@pairs) {
      ($name, $value) = split(/=/, $pair);
#print $name."=".$value."<br>\n";
      # Un-Webify plus signs and %-encoding
      $value =~ tr/+/ /;
      $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
      $value =~ s/<!--(.|\n)*-->//g;

      $ARGS{$name} = $value;
   }
}


sub PaginaInicio
{

	local($line_mod);

        undef $select;

	open(PLANTILLA, "$plantilla_inicio");
	while (<PLANTILLA>)
	{
		$line_mod = ModificaLink($_);
		print $line_mod;
	}
	close PLANTILLA;
}


sub ModificaLink
{
        local ($linea) = @_;
        local ($tmp, $tmp2);

        # Comprobamos si estamos dentro de un bloque de <script>.
        if ($linea =~ /<script/) {
           $enscript = 1;
        }
        if ($linea =~ /<\/script/) {
           $enscript = 0;
        }

        if ($enscript == 0) {
           # Sólo parseo $$, !!, || fuera de los bloques <script>.

           # Lo que hago es buscar cualquier cosa entre $, y sustituirlo
           # por una variable que se llame así.
           if ($linea =~ /\$(.*)\$/) {
              $tmp = ${$1};
              $linea =~ s/\$$1\$/$tmp/ ;
           }

           # Ahora busco cosas entre admiraciones, y lo sustituyo por variables
           # pasadas en el formulario (si existe).
           if ($linea =~ /!(.*)!/) {
              $tmp = $ARGS{$1};
              $linea =~ s/!$1!/$tmp/ ;
           }

           # Ahora busco cosas entre pipes, y llamo a una función que se
           # llame así. Cojo lo que pueda haber entre paréntesis detrás del
           # tag como parámetros de llamada a la función.
           if ($linea =~ /^(.*)\|(.*)\|(.*)$/) {
              print $1;
              $tmp = $2;
              $tmp2 = $3;
              if ($tmp =~ /(.*)\((.*)\)/) {
                 &{$1} ($2);
              } else {
                 &{$tmp};
              }
              
              # Con esta línea hago que, si hay algo por detrás del tag de
              # llamada a la función, se siga parseando.
              $linea = $tmp2;
           }
        }

        # Mediante este código puedo hacer que se seleccione una opción de un
        # <select>, si existe una variable llamada como el <select>, y su
        # valor coincide con una opción.
        if ($select) {
           if ($linea =~ /<\s*\/select.*>/) {
              undef $select;
           } else {
              if ($linea =~ /<\s*option.*value\s*=.*${$select}.*>/) {
                 $linea =~ s/option/option selected/ ;
                 undef $select;
              }
           }
        } else {
           if ($linea =~ /<\s*select.*name\s*=\s*(\S+)\s*.*>/) {
              $select = $1;
              $select =~ s/"//g ;
              # S˘lo compruebo el select si hay una variable que se llame
              # como el select.
              if (! ${$select}) {
                 undef $select;
              }
           }
        }

        local($resto) = $linea;
        local($total) = "";
	

        while ( $resto =~ /HREF=\"/i)
	{
		$izquierda = $`;
		$centro = $&;
		$derecha = $';


		$total .= $izquierda . $centro;


		if ($derecha =~ /^\/cgi-local\/[^?]*\?/)
		{
# No dejo que modifique los enlaces hacia scripts.
#			$total .= $&;
#			$total .= "sid=$sid_global&";
#			$derecha = $';
			
		} elsif ($derecha =~ /^http:\/\// || $derecha =~ /^#/)
		{
			nop;
		} elsif ($derecha =~ /^mailto:/)
		{
			nop;
		} else {
			$total .= "/cgi-local/parser.pl?sid=$sid_global&page=";
		}

		$resto = $derecha;
	}

        $total .= $resto;

        return $total;
}
