#!/usr/bin/perl use CGI qw/:standard/; use DBI; encabezado(); comienza_tabla1(); menu_final(); print end_html; sub encabezado { print header(); print < Búsqueda de proyectos
HTMLHEAD } sub comienza_tabla1{ print <
Tabla variables(); comienzatabla(); letranumero(); principal(); print <
Tabla1 } sub menu_final{ print < MenuFinal } # asignando los valores de letras y números sub variables { $Letras= param('Letras'); $Numero= param('Numero'); } #Comenzando la tabla en donde se colocaran los datos sub comienzatabla { print <
  1. Inicio
  2. Comisión Nacional para el Conocimiento y Uso de la Biodiversidad
  3. Acciones y Programas
  4. Proyectos

Proyectos Financiados

OUT } #En esta subrutina se concatenan los valores de letras numeros y se ponen los 0 sub letranumero { if ($Numero < 10) { $Web = $Letras; $Web .= "00"; $Web .= $Numero; print "
Proyecto $Web"; } else { if ($Numero < 100) { $Web = $Letras; $Web .= "0"; $Web .= $Numero; print "
Proyecto $Web
"; } else { $Web = $Letras; $Web .= $Numero; print "
Proyecto $Web
"; } } } #subrutina para poner las instituciones siempre y cuando un nivel no se repita sub poninstitucion { print "$institucion1
"; if($institucion2 ne $institucion1) { print "$institucion2
"; } if($institucion3 ne $institucion2) { print "$institucion3
"; } if($institucion4 ne $institucion3) { print "$institucion4"; } } #Funcion donde se ejecutan todos los querys sub principal { print < TABLAINTERNA abrirBD(); $sqlero = "SELECT P.Titulo, IP.IdInstitucion, PP.IdPersona FROM proyectos.dbo.Proyecto P, proyectos.dbo.Pers_Proy PP, proyectos.dbo.Insti_Proy IP WHERE ( P.Letras = IP.Letras ) and ( P.Numero = IP.Numero ) and ( P.Letras = PP.Letras ) and ( P.Numero = PP.Numero ) and ( ( P.Letras = '$Letras' ) and ( P.Numero = $Numero ) and ( PP.Responsable = 1 ) and ( IP.RespParticip = 1))"; procesar_resultado(); #IdInst y IdPers se usan a lo largo de toda esta mugre, o sea son las chidas $Titulo = $var{1}; $IdInst = $var{2}; $IdPers = $var{3}; # Se obtiene el grado academico y el nombre de la persona responsable */ $sqlero= "SELECT P.GradoAcademico + '. ' + P.Nombres + ' ' + P.Apellidos FROM directorio.dbo.Persona P WHERE P.IdPersona = $IdPers"; procesar_resultado(); $Responsable = $var{1}; print <
Responsable # Se obtiene el correo electronico de la persona segun la institucion donde trabaje $sqlero="SELECT IP.Email FROM directorio.dbo.RelInstitutPersona IP WHERE ( IP.IdPersona = $IdPers ) and ( IP.IdInstitucion = $IdInst )"; procesar_resultado(); $Email = $var{1}; if ($Email ne "") { print " "; # Se obtiene la institucion regenerando los niveles que esta contenga */ $sqlero = "SELECT Institucion1,Institucion2,Institucion3,Institucion4 FROM proyectos.dbo.datos_proyectos_view p WHERE p.letras = '$Letras' AND p.numero = $Numero"; procesar_resultado(); $institucion1 = $var{1}; $institucion2 = $var{2}; $institucion3 = $var{3}; $institucion4 = $var{4}; print " "; #Se obtiene la direccion de la institucion */ $sqlero= "SELECT D.Direccion + ', ' + D.Colonia + ', ' + D.Ciudad + ', ' + E.Abreviatura + ', ' + D.CodigoPostal + ', ' + P.NombrePais FROM directorio.dbo.Institucion I, directorio.dbo.Direccion D, directorio.dbo.RelInstDirec RID, directorio.dbo.Estado E, directorio.dbo.Pais P WHERE ( I.IdInstitucion = $IdInst ) and ( I.IdInstitucion = RID.IdInstitucion ) and ( RID.IdDireccion = D.IdDireccion ) and ( D.IdEstado = E.IdEstado ) and ( E.IdPais = P.IdPais )"; procesar_resultado(); print " "; #Se obtiene el teléfono $sqlero="SELECT T.Telefono FROM directorio.dbo.RelInstitutPersona T WHERE ( T.IdInstitucion = $IdInst ) and ( T.IdPersona = $IdPers )"; procesar_resultado(); $telefono=$var{1}; if ($telefono ne "") { print " "; } #Se obtiene Fecha de inicio $sqlero="SELECT FechaInicio, FechaDeTermino FROM proyectos.dbo.Proyecto P WHERE ( P.Letras = '$Letras' ) and ( P.Numero = $Numero )"; procesar_resultado(); $fechainicio = substr($var{1},0,11); $fechatermino = substr($var{2},0,11); print " "; print " "; #Aqui hiria el encuery para traerse el dato de estatus de conclucion del proyecto $sqlero = "SELECT S.Descripcion FROM proyectos.dbo.Status S, proyectos.dbo.proy_status_actual_view SA WHERE (SA.Letras = '$Letras' AND SA.Numero = $Numero) AND (S.IdStatus = SA.IdStatus)"; procesar_resultado(); $statusdesc = $var{1}; print " "; #codigo html para agregar un renglon a la tabla #Se obtiene Numero de ejemplares, numero de especies #Cambio en la consulta por Oscar Estrada: ahora se consulta a la vista llamada "Proyecto_EntregaSib_View" #para obtener los conteos de ejemplares y especies de los proyectos a publicar $sqlero = "SELECT p.numEjemplares,p.numEspecies FROM proyectos.dbo.Proyecto_EntregaSib_View p WHERE ( P.Letras = '$Letras' ) and ( P.Numero = $Numero )"; procesar_resultado(); $Ejemplares = $var{1}; $Especies = $var{2}; if ($Ejemplares != 0) { print " "; } if ($Especies != 0) { print " "; } #Cobertura Geografica 1 $sqlero = "SELECT C.descCobertura, C.Descripcion FROM proyectos.dbo.Cobertura C, proyectos.dbo.Proyecto P WHERE ( P.Letras = '$Letras' ) and ( P.Numero = $Numero ) and ( P.Letras = C.Letras ) and ( P.Numero = C.Numero )"; procesar_resultado(); $var{1} =~ s/^[ \t]+//; #quita ablancos del principio if ( $var{1} ne "" && $var{1} ne "NO APLICA" ) { print " "; } #Cobertura Geografica 2 $sqlero = "SELECT EV.NombreEstado, EP.Localidad FROM proyectos.dbo.Proyecto P, proyectos.dbo.Cobertura C, proyectos.dbo.Edo_Proy EP, proyectos.dbo.Estado_View EV WHERE ( P.Letras = '$Letras' ) and ( P.Numero = $Numero ) and ( P.Letras = C.Letras ) and ( P.Numero = C.Numero ) and ( EP.IdCobertura = C.IdCobertura ) and ( EP.IdEstado = EV.IdEstado )"; procesar_resultado(); $var{1} =~ s/^[ \t]+//; #quita ablancos del principio if ( $var{1} ne "" ) { print " "; } #Se obtiene Resumen $sqlero ="SELECT P.Resumen FROM proyectos.dbo.Proyecto P WHERE ( P.Letras = '$Letras' ) and ( P.Numero = $Numero )"; procesar_resultado(); # si no existe el resumen no se pone el renglon de resumen # $var{1} es el resumen solo existe una posibilidad $var{1} =~ s/^[ \t]+//; #quita ablancos del principio if ( $var{1} ne "" ) { print " "; } #Se obtiene el costo del proyecto y se imprime costo(); imprime_archivo(); print qq(); cerrar(); print < CERRARTABLA } sub costo { %mes=('January',1, 'February',2, 'March',3, 'April',4, 'May',5, 'June',6, 'July',7, 'August',8, 'September',9, 'October',10, 'November',11, 'December',12); $cost = "SELECT dbo.Pagos.Monto, datename(day,dbo.pagos.fechaest),datename(month,dbo.pagos.fechaest),datename(year,dbo.pagos.fechaest), dbo.Pagos.FechaEst, dbo.Proyecto.IVA FROM dbo.Pagos, dbo.Proyecto WHERE ( dbo.Pagos.Letras = dbo.Proyecto.Letras ) and ( dbo.Pagos.Numero = dbo.Proyecto.Numero ) and ( ( dbo.Pagos.Letras = '$Letras' ) AND ( dbo.Pagos.Numero = $Numero ) )"; $i=1; $sth_proy = $dbh_proy->prepare(qq{$cost}); $sth = $sth_proy->execute || die($dbh_proy->errstr); if ($sth) { my $suma = 0.0; while (@row = $sth_proy->fetchrow) { $dia = @row[1]; $mes = @row[2]; $ano = @row[3]; if ($ano <= 1994){ $iva = .10; $subtotal = @row [0] * $iva; $total = @row [0] + $subtotal; } if ($ano == 1995){ if ($mes{$mes} < 4){ $iva = .10; $subtotal = @row [0] * $iva; $total = @row [0] + $subtotal; } else{ $porcentaje = @row [5]/100; $subtotal = @row [0] * $porcentaje; $total = @row [0] + $subtotal; } } if ($ano > 1995){ $porcentaje = @row [5]/100; $subtotal = @row [0] * $porcentaje; $total = @row [0] + $subtotal; } $suma = $suma + $total; } # Codigo para redondear my $total_redondeado = sprintf("%.0f", $suma); if ( $total_redondeado == 0 ) { # Si no se le ha capturado pago que no ponga $0 $total_redondeado = ""; } my $comas = reverse $total_redondeado; # my $comas = reverse $suma; $comas=~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g; $fincomas = reverse $comas; print ""; } $sth_proy->finish; } #Saca el archivo correspondiente sub imprime_archivo { $archivo = "SELECT dbo.ObjetoExterno.Document_name, dbo.ObjetoExterno.MIME, dbo.Base.Document_relative, dbo.RelProyectoObjetoExterno.Titulo, dbO.RelProyectoObjetoExterno.FormaDeCitar, dbo.RelProyectoObjetoExterno.Orden, dbo.Base.Protocolo, dbo.Base.SiteName, dbo.Base.Document_base, dbo.RelProyectoObjetoExterno.ProyectoRelacionadoParcial, dbo.RelProyectoObjetoExterno.ProyectoRelacionadoTotal FROM dbo.Proyecto, dbo.RelProyectoObjetoExterno, dbo.ObjetoExterno, dbo.MIMECita, dbo.Base WHERE ( dbo.Proyecto.Letras = dbo.RelProyectoObjetoExterno.Letras ) and ( dbo.ObjetoExterno.IdObjetoExterno = dbo.RelProyectoObjetoExterno.IdObjetoExterno ) and ( dbo.MIMECita.MIME = dbo.ObjetoExterno.MIME ) and ( dbo.Base.IdBase = dbo.ObjetoExterno.IdBase ) and ( dbo.Proyecto.Numero = dbo.RelProyectoObjetoExterno.Numero ) and ( ( dbo.Proyecto.Letras = '$Letras' ) AND ( dbo.Proyecto.Numero = $Numero ) ) ORDER BY dbo.RelProyectoObjetoExterno.Orden, dbo.RelProyectoObjetoExterno.Titulo"; $sth_proy = $dbh_proy->prepare(qq{$archivo}); $sth = $sth_proy->execute || die($dbh_proy->errstr); print ""; print ""; if ($sth) { my $ban=0; my $ban1=0; my $letrasp; my $numerosp; my $letrast; my $numerost; my $urlp; my $urlt; my $flagp = 0; my $flagt = 0; while (@row = $sth_proy->fetchrow) { if(@row[5]<2) { print ""; print ""; } if(@row[5]==2) { if($ban==0) { print ""; print ""; $ban++; } print ""; print ""; } if((@row[5]>2) && (@row[5]<6)) { if((@row[5]==3) && ($ban1==0)) { print ""; print ""; $ban1++; } print ""; print ""; } if (@row[5]>5) { print ""; print ""; } if(length(@row[9])>1) { $flagp = 1; @proysp = split(",",@row[9]); foreach my $bdp (@proysp) { if(length($bdp) == 5){ $letrasp = substr($bdp,0,2); $numerosp = substr($bdp,2,3); $numerosp =~ s/^0+//; } else{ $letrasp = substr($bdp,0,1); $numerosp = substr($bdp,1,3); $numerosp =~ s/^0+//; } $urlp = $urlp."".$bdp.", "; } } if(length(@row[10])>1) { $flagt = 1; @proyst = split(",",@row[10]); foreach my $bdt (@proyst) { if(length($bdt) == 5){ $letrast = substr($bdt,0,2); $numerost = substr($bdt,2,3); $numerost =~ s/^0+//; } else{ $letrast = substr($bdt,0,1); $numerost = substr($bdt,1,3); $numerost =~ s/^0+//; } $urlt = $urlt."".$bdt.", "; } } } #Pinta los proyectos relacionados if($flagt == 1){ $urlt = substr($urlt,0,length($urlt)-2); print ""; print ""; } if($flagp == 1){ $urlp = substr($urlp,0,length($urlp)-2); #print ""; print ""; } #if($flagt == 1 || $flagp == 1){ # print ""; #} print ""; print ""; } $sth_proy->finish; } #Se abre la base de datos sub abrirBD { my ($user, $passwd, $servidor) = ("web_proyectos", "web_proyectos", "BIOTGEO"); $dsn_proy = "dbi:Sybase:server=$servidor;interfaces:database=proyectos"; $dbh_proy = DBI->connect($dsn_proy, $user, $passwd, { RaiseError => 1 }); die("Fallo la conexion a registro de proyectos $DBI::errstr") unless $dbh_proy; } #se ejecuta los querys sub procesar_resultado { for($contador=1; $contador<$i; $contador++) { $var{$contador} = ""; } $i=1; $sth_proy = $dbh_proy->prepare(qq{$sqlero}); $sth = $sth_proy->execute || die($dbh_proy->errstr); if ($sth) { while (@row = $sth_proy->fetchrow) { foreach(@row) { $var{$i} = $_; $i = $i + 1; } } } $sth_proy->finish; } sub cerrar { $dbh_proy->disconnect if $dbh_proy; # limpiadida a la conexion undef $dbh_proy; }
   
  Título: $Titulo
  Responsable: $Responsable
  Correo electrónico: "; print " ", $var{1}, " "; } print "
  Institución: "; poninstitucion(); print "
  Dirección: "; for ($contador=1; $contador<$i; $contador++) { #Elimina todos los posibles ND o nd que existan quitando la , tambor $var{$contador} =~ s/\b, ND\b//gi; #Elimina las dobles comas o mas $var{$contador} =~ s/(, )+/, /g; print $var{$contador}, "
"; } print "
  Teléfono/Fax: "; print " $telefono
  Fecha de inicio: "; print " $fechainicio
  Fecha de término: "; print " $fechatermino
  Estatus: "; print " $statusdesc
  Ejemplares: "; print $var{1}; print "
  Especies: "; print $var{2}; print "
  Cobertura: "; print " "; for ($contador=1; $contador<$i; $contador = $contador + 2) { $var{$contador} =~ s/^[ \t]+//; #quita ablancos del principio if ( $var{$contador} ne "" && $var{$contador} ne "NO APLICA" ) { $cadena1 = substr($var{$contador}, 0,1); $cadena2 = substr($var{$contador}, 1); ucfirst($cadena1); $cadena2=~tr/A-Z/a-z/; #$var{$contador}; print "
", $cadena1, $cadena2, "     "; $var{$contador + 1} =~ s/^[ \t]+//; #quita ablancos del principio if ( $var{$contador + 1} ne "" ) { print $var{$contador + 1}, "
"; } } } print "
"; print "
  Región: "; print " "; for ($contador=1; $contador<$i; $contador = $contador + 2) { $var{$contador} =~ s/^[ \t]+//; #quita ablancos del principio if ( $var{$contador} ne "" && $var{$contador} ne "NO APLICA" ) { print "
", $var{$contador}, "     "; $var{$contador + 1} =~ s/^[ \t]+//; #quita ablancos del principio if ( $var{$contador + 1} ne "" ) { print $var{$contador + 1}, "
"; } } } print "
"; print "
  Resumen: "; print $var{1}, "
"; print "
Costo: $", $fincomas, "
  
 Productos:
  
 
@row[3]@row[1]"; print "

",@row[4],"

"; print "
  
 
"; print "

La base de datos del proyecto fue migrada al modelo de datos del Sistema Nacional de Información sobre Biodiversidad (SNIB) en formato Access. (Modelo y diccionario de datos)

"; print "
  
 
@row[3]@row[1]"; print "

",@row[4],"

"; print "
  
 
"; print "

La información de la base de datos también esta disponible en el estándar Darwin Core (DwC) vr 2015-06-05 en texto delimitado por comas.

"; print "
  
 
@row[3]@row[1]"; print "

",@row[4],"

"; print "
  
 
@row[3]@row[1]"; print "

",@row[4],"

"; print "
  
 
"; print "El contenido de la base de datos fue integrado o actualizado de manera total en: ".$urlt."."; print " El detalle se muestra en los diagramas de actualización."; print "
  
 
"; print "El contenido de la base de datos fue integrado o actualizado de manera parcial en: ".$urlp."."; print " El detalle se muestra en los diagramas de actualización."; print "
 
"; # print " El detalle se muestra en los diagramas de actualización."; # print "
  
 
"; print "Los archivos que se pueden consultar en la sección de Productos, no necesariamente incluyen todos los resultados aportados por el proyecto. Si requiere más información puede comunicarse con Servicios Externos al correo electrónico servext\@conabio.gob.mx

"; print "