El problema estaba en que los archivos están en formato MSDOS (las líneas terminan en dos caracteres: el carácter de retorno de carro (13) y el de avance de línea (10)).
Como yo trabajo en Linux, me llamó la atención que solo pudiera leer un registro. Es debido precisamente a la distinta terminación de los finales de línea.
Si estás trabajando en Windows, entonces Perl lo sabría y no notarías nada (podrías leer las líneas tal cual). El problema está si los archivos se han generado/descargado de un sistema MSDOS y los vas a procesar en un sistema distinto (Linux o Mac). Hay que tener en cuenta estos detalles, para evitar sorpresas.
Una forma de solventarlo es indicando expresamente a Perl que los archivos a leer/escribir tengan siempre los finales de línea con caracteres tipo MSDOS. En
perldoc PerlIO está la documentación sobre la capa ':crlf', que transforma, en la lectura, los dos bytes 13-10 al carácter "\n" y, en escritura, justo al revés.
El siguiente programa hace la lectura y procesamiento correcto del archivo de secuencias, y saca los registros que coincidan con alguna de los nombres de la lista.
Using perl Syntax Highlighting
#!/usr/bin/perl
use open IO => ':crlf'; # la entrada y la salida, en formato MSDOS
### Lectura de las secuencias a extraer
open(F,"<lista_de_secuencias.txt") or die "can't open lista\n";
my @palabras = <F>;
close F;
chomp @palabras;
### Procesamiento del argumento
-e $ARGV[0] or die "ERROR: No encuentro [$ARGV[0]]: $!\n"; # si no encontramos el argumento, terminamos
open(INPUT , "<", $ARGV[0]);
open(OUTPUT, ">", "$ARGV[0].out");
my $registro = ''; # aquí almacenamos cada registro
while(my $linea = <INPUT>) { # leemos línea a línea
if ($linea =~ /^>/) { # si la línea comienza con marca de registro
procesar_registro($registro) if $registro; # procesamos el registro almacenado antes (si lo hay, claro)
$registro = ''; # y lo ponemos a cero (perdón, a nada)
}
$registro .= $linea; # vamos guardando cada $linea en $registro
}
procesar_registro($registro) if $registro; # en caso de terminar, procesamos el último $registro
close INPUT;
close OUTPUT;
sub procesar_registro { # aquí procesamos cada $registro
my $registro = shift;
foreach my $palabra (@palabras) { # para cada $palabra, de entre todas las @palabras
if ($registro =~ /\b$palabra\b/) { # si el $registro contiene esa $palabra
print OUTPUT $registro; # volcamos el $registro fuera
last; # y terminamos
}
}
}
Coloreado en 0.001 segundos, usando
GeSHi 1.0.8.4
Lo he comprobado con tus ejemplos, y la salida es idéntica al original, ya que la lista de secuencias coincide con todos los registros.
