From cba4ec1c8ae5acc82e95cd512170ba76a7b66df6 Mon Sep 17 00:00:00 2001 From: Leandro Lucarella Date: Thu, 29 Jan 2004 20:09:40 +0000 Subject: [PATCH] Se agrega base.epl necesario para los sistemas en embperl. --- embperl/README | 1 + embperl/base.epl | 302 +++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 303 insertions(+) create mode 100644 embperl/base.epl diff --git a/embperl/README b/embperl/README index 709d56e..8e24f85 100644 --- a/embperl/README +++ b/embperl/README @@ -9,6 +9,7 @@ Archivo Ruta SimpleXMLISO.pm /usr/share/perl5/Apache/Session/Serialize/ DumperISO.pm /usr/share/perl5/XML/ Php2Embperl_Session.epl /var/www/htdocs/ (DocumentRoot del apache) +base.epl /var/www/htdocs/ (DocumentRoot del apache) Instalar paquete libapache-tempfile-perl_0.04-1_all.deb. diff --git a/embperl/base.epl b/embperl/base.epl new file mode 100644 index 0000000..cc1b64f --- /dev/null +++ b/embperl/base.epl @@ -0,0 +1,302 @@ +[$ if ($ENV{'SCRIPT_NAME'} ne "/index.epl" && $ENV{'SCRIPT_NAME'} ne "/Php2Embperl_Session.epl")$] +[- $http_headers_out{'Location'}="./index.epl" if(!$udat{'user'}); -] +[- +use DBI; +use Data::Dumper; +#Conecciones a las bases +$CLEANUP{'bases'} = 0; +our $bases->{'newsclient'}=[ + "dbi:mysql:dbname=MEconDAV;host=localhost", + "mark", + "mark", + {RaiseError=>1, AutoCommit=>1}]; +our $bases->{'menu'}=[ + "dbi:mysql:dbname=USUARIOS;host=localhost", + "menu", + "menu", + {RaiseError=>1, AutoCommit=>1}]; +our $bases->{'liq'}=[ + "dbi:mysql:dbname=liquidaciones;host=localhost", + "me", + "me", + {RaiseError=>1, AutoCommit=>1}]; +our $bases->{'partidos'}=[ + "dbi:mysql:dbname=partidos;host=localhost", + "partidos", + "partidos", + {RaiseError=>1, AutoCommit=>1}]; +-] +[! +#Precarga del Arbol que genera el menu +$CLEANUP{'dbh'} = 0; +my $dbh=DBI->connect(@{$bases->{'menu'}}); +$CLEANUP{'menu'} = 0; +our $menu = $dbh->selectall_arrayref(' + SELECT pagina.pagina, pagina.link, pagina.nombre, pagina.tipo, pagina.icono, + pagina.descr, pagina.tipo, area.color_obscuro, area.color_claro + FROM pagina, area + WHERE tipo="A" + AND pagina.pagina=area.pagina + ORDER BY pagina.pagina'); + +#Estructura del menu: +#array de: +# arrays con: +# 0 numero +# 1 link +# 2 nombre +# 3 tipo +# 4 icono +# 5 descripcion +# 6 array con las paginas inferiores +# 7 color claro +# 8 color obscuro +# cada pagina inferior tiene: +# 0 numero +# 1 link +# 2 nombre +# 3 tipo +# 4 icono +# 5 descripcion +# 6 array con las paginas inferiores + +#esta es una lista invertida de los links y las areas para rastrear que menu mostrar a partir de que pagina muestra +#se podria hacer del arbol pero seria algo lento +$CLEANUP{'busc_area'} = 0; +our $busc_area; +$busc_area->{"$_->[1]"} = $_->[0]-1 foreach (@$menu); + +#Carga recursiva de hojas +sub cargarinferiores($$) +{ + my $pag = shift; + my $area = shift; + $pag->[6]= $dbh->selectall_arrayref(" + SELECT pagina.pagina, pagina.link, pagina.nombre, pagina.tipo, pagina.icono, pagina.descr + FROM pagina + WHERE pagina.pagina_sup=$pag->[0] +# AND pagina.tipo <> 'O' + ORDER BY pagina.tipo, pagina.nombre"); + my $tmp= $dbh->selectall_arrayref(" + SELECT pagina.link + FROM pagina + WHERE pagina.pagina_sup=$pag->[0] + AND pagina.tipo <> 'L'"); + $busc_area->{"$_->[0]"}=$area foreach (@$tmp); + + cargarinferiores($_,$area) foreach (@{$pag->[6]}); +}; + +cargarinferiores($_,$_->[0]-1) foreach (@$menu); +#estas variables se usan para generar el codigo del menu, se inicializan fuera por velocidad +my $bg_color; my $fg_color; my $tam; my $link_ini; my $link_fin; +my $b_ini; my $b_fin; my $tab; my $new_frame; +!] +[! +sub rama_abierta($$) +{ + $rama = shift; + $link = shift; + return 1 if ($rama->[1] eq $link); + return 1 if ($rama->[1] =~ /^$link?/); + foreach (@{$rama->[6]}) + { + return 1 if rama_abierta($_, $link); + } + return 0; +}; + +#global para saber en que nivel estoy; +$xtab=''; + +sub Linea($$$) +{ + my $l = shift; + my $color_oscuro = shift; + my $color_claro = shift; + $activo = ''; + foreach (@{$l->[6]}) + { $activo = true if ($_->[1] =~ /^$ENV{'SCRIPT_NAME'}/); } + $bg_color = 'CCCCCC'; + if ($l->[1] =~ /^$ENV{'SCRIPT_NAME'}/ or $activo ) + { + $bg_color = $color_claro; + $tipo_pag = $l->[3]; + } + $fg_color= '000000'; + $tam = "size='0'"; + $link_ini = ''; $link_fin=''; + $b_ini=''; $b_fin=''; + $tab='- '; + $new_frame=''; + $new_frame='target=_blank' if($l->[3] eq 'L'); + if ($l->[1]) + { $link_ini = ""; $link_fin = ""; } + if($l->[3] eq 'S') + { + $bg_color = $color_oscuro; + $fg_color = 'FFFFFF'; + $tam = "size='2'"; + $b_ini = ""; $b_fin= ""; + $tab=''; + } + my $linea_html = " + + + $b_ini$link_ini + + $xtab$tab$l->[2] + + $link_fin$b_fin + + "; + foreach (@{$l->[6]}) + { + if ($_->[3] ne 'O') + { + my $oldtab = $xtab; + $xtab .= '   ' if (($l->[3] ne "S")and($l->[3] ne "S")); + $linea_html .= Linea($_, $color_oscuro, $color_claro) if + (rama_abierta($l,$ENV{'SCRIPT_NAME'})or(!$l->[1])); + $xtab = $oldtab; + } + } + return $linea_html; +}; + +sub DesplegarMenu($) +{ + $area = shift; + $tipo_pag = 'A'; + foreach (@{$area->[6]}) + { + $menu_html .= Linea($_, $area->[7], $area->[8]); + $tipo_pag = 'A' if ($_->[1] =~ /^$ENV{'SCRIPT_NAME'}/ ); + } + return $menu_html; +}; +!] +[- +our $char_menu = DesplegarMenu($menu->[$busc_area->{"$ENV{'SCRIPT_NAME'}"}]) +-] +[- +$ret = shift; +$ret->{'bases'} = $bases; +$ret->{'menu'} = $menu; +$ret->{'busc_area'} = $busc_area; +-] + + + + INTRANET DEL MINISTERIO DE ECONOMIA + + + + + + + + + [$ if defined $fdat{'debug'} $] + [- Execute ('debug.epl') -] + [$ else $] + [- Execute ('cabecera.epl') -] + [$ endif $] + [$ if ($ENV{'SCRIPT_NAME'} ne '/mapa.epl') $] + + + + + + + + + + + + [$ else $] + + + + [$ endif $] +
+ + [+ $char_menu +] + +
+ 		+ + + + + + + +
+ [- Execute('barra_areas.epl')-] +
+ [- + if (-f $ENV{'SCRIPT_FILENAME'}) + { Execute('*'); } + else + { Execute('auto_pag.epl') } + -] +
+
+ + Información | Servicios | Consultas | Gestión Horizontal | Gestión Local + +
+ + Copyright © 2001 Ministerio de Economía + +
+ [- Execute('*'); -] +
+ + +[$ else $] + [- Execute('*') -] +[$ endif $] -- 2.43.0