--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/interpro/paso4.pl	Thu May 22 05:09:07 2014 -0400
@@ -0,0 +1,132 @@
+#!/usr/bin/perl -w
+$| = 1;
+
+# Dado un fichero en formato GFF3 que incluye el análisis de varias secuencias,
+# el programa devuelve un fichero de texto que incluye los valores comunes a todas las secuencias dadas
+# para los atributos:
+    # Name -> Entrada de la base de datos de donde se ha obtenido una característica determinada;
+    # Ontology_term -> Entradas de Gene Ontology para una característica dada;
+    # Dbxref -> Entra de Interpro para una característica dada.
+
+use strict;
+
+
+# Declaración e inicialización de variables
+
+my $fichero_ent = "";                               #Nombre de fichero en formato GFF3 a analizar tomado de líneas de comandos
+my $output="";                                      #Fichero de salida pasado como parámetro
+my (@id_1, @id_2) = ();                             #Almacenan temporalmente las líneas directivas e ID de las secuencias
+my @ids = ();                                       #Todos los ID-seq del archivo
+my @temp = ();                                      #Todas las líneas de características del archivo
+my $lin = "";                                       #Recupera cada ID del @ids
+my @lin_id = ();                                    #Todas las líneas de características para un ID determinado
+my (@t1, @t3) = ();                                 #Almacenan temporalmente las características y atributos de una línea dada
+my $atributo = "";                                  #Únicamente la característica "Atributos" de cada línea de características
+my @etiquetas = ("Name","Ontology_term","Dbxref");  #Son los tres tipos de atributos comunes que se van a extraer del fichero
+my @sel_atrib = ();                                 #Los atributos correspondientes a una etiqueta dada en cada fila 
+my ($etiq, $atrib) = "";                            #La etiqueta y el valor respectivamente, de un atributo en una línea
+my @val_atrib = ();                                 #Los diferentes posibles valores de un atributo en una línea
+my (@valores, @valores_rep) = ([],[],[]);           #Valores de cada atributo para cada ID-seq y los valores repetidos para todos los ID-seq
+my @repetidos = ();                                 #Almacena temporalmente los valores comunes para cada atributo, entre los ID-seq analizados
+
+
+######## Abrir fichero y seleccionar lineas #########
+
+($fichero_ent,$output) = @ARGV;
+
+open(ARCHGFF3, $fichero_ent) || die "Failure to open the file \"$fichero_ent\"\n\n";      #Abre el fichero
+        
+while (<ARCHGFF3>)  {                                   #Lee el archivo
+    chomp $_;
+    if ($_ =~ /^##FASTA/) {                             #Elimina la parte de secuencias fasta
+        last;
+    }elsif ($_ =~ /^##sequence-region./) {      
+        push (@id_1, $_)                                #Las líneas directivas de sequence-region, para obtener su ID correspondiente
+    }elsif ($_ =~ /^#+/) {                              #Elimina líneas de comentarios y directivas, excepto el tipo anterior
+        next;   
+    }else { push (@temp, $_)};                          #Almacena las líneas con los atributos de todos los ID
+}; 
+close ARCHGFF3;                                    
+
+###########  Seleccionar ID de la línea directiva  ##################
+
+foreach (@id_1) {
+    @id_2 = split(/\s/,$_,3); 
+    push (@ids, $id_2[1]);                              #Almacena todos los ID-seq que hay en el archivo
+}
+
+###########  Seleccionar un ID-seq determinado y todas sus filas de características  ##################
+
+my $i = 0;                                              #Para distinguir entre la primera secuencia y el resto
+foreach $lin (@ids) {
+    @lin_id = grep (/^$lin/, @temp);                    #Todas las líneas de características correspondientes al ID seleccionado 
+
+###########  Seleccionar, para cada línea de características, la columna novena de atributos  ##################
+
+    foreach (@lin_id) {
+        @t1 = split(/\t/,$_);                           #Cada elemento es una característica de la línea dada
+        $atributo = $t1[8];                             #Únicamente la característica "atributos" de la línea dada
+            
+    #Seleccionar los atributos "Name", "Ontology_term" y "Dbxref" de la columna 9
+    
+        @t3 = split(/;/, $atributo);                    #Cada elemento es un atributo de la característica "Atributos" de una línea dada 
+        
+###########  Almacenar los diferentes valores de cada atributo (Name, Ontology_term y Dbxref) #############
+###########  de un ID_seq determinado en un @rray diferente                                   #############
+    
+        for my $cont (0..2){ 
+            if (@sel_atrib = grep (/^$etiquetas[$cont]./, @t3)) {      #Evitar valores no definidos para un atributo concreto
+                ($etiq, $atrib) = split (/=/, $sel_atrib[0], 2); 
+                @val_atrib = split (/,/, $atrib); 
+                foreach my $valor (@val_atrib) {                              
+                    if (!grep (/$valor/, @{$valores[$cont]})) {        #Evitar valores repetidos de un mismo atributo para un ID-seq determinado
+                            push (@{$valores[$cont]}, $valor);         #Todos los valores diferentes de cada atributo para un ID-seq determinado    
+                    }
+                }    
+            }
+        }    
+    }
+    
+###########  Comprobar los atributos comunes a todos los ID-seq y guardarlos  #################
+
+    if ($i == 0) {                                                     #Para el primer ID-seq se guardan todos sus atributos
+        for my $cont (0..2) {                                          #no repetidos. Como mucho, serán todos estos la solución.
+            $valores_rep[$cont] = [@{$valores[$cont]}];                
+            $valores[$cont] = [];
+        }
+        $i++;
+    } else {                                                                        
+        for my $cont (0..2) {
+            foreach my $valor (@{$valores[$cont]}) {
+                if (grep (/$valor/, @{$valores_rep[$cont]})) {         #Búsqueda valores comunes para cada tipo atributo entre los
+                    push (@repetidos, $valor);                         #ID-seq analizados.
+                }
+            }
+            $valores_rep[$cont] = [@repetidos];                        #Todos los valores comunes de los tres tipos de atributos para
+            $valores[$cont] = [];                                      #todas las secuencias del fichero.
+            @repetidos = ();
+        }
+    }
+    
+}
+
+
+############ Impresión de resultados ######################
+
+if (!open(FICHEROUT, ">$output")) { 
+    print "The file \"$output\" can not be opened";
+} else {
+    print FICHEROUT "The common atributes of the sequences ","@ids"," are:\n";
+    for my $cont (0..2) {
+        print FICHEROUT "For atribute ","$etiquetas[$cont]" ," : ";
+        if (scalar @{$valores_rep[$cont]} == 0) {
+            print FICHEROUT "No common atributes \n";
+        }else { print FICHEROUT "@{$valores_rep[$cont]}", "\n"}
+    }
+    close (FICHEROUT);
+}
+exit;
+  
+
+    
+