Analicemos la situación. Supongamos que test.txt es esto:
- Código: Seleccionar todo
/<Baina>/<HAS_MAI>/
(LOT JNT AURK)
(ADI SIN ADOIN)
/<du>/<HAS_MIN>/
(ADI SIN ADOIN)
(ADJ ARR)
Entonces, con tu código,
Using perl Syntax Highlighting
#!/usr/bin/perl
use warnings
;
use strict
;
my @auxi;
my $auxiliar;
open AE
, "<test.txt" or die;
while( my $reng = <AE> ) {
if ($reng !~ m/^\/\</) {
$auxiliar = $auxiliar.$reng;
}
else {
push (@auxi, $auxiliar);
$auxiliar = "";
$auxiliar = $auxiliar.$reng;
}
}
close AE
;
use Data
::Dumper;
print Dumper
(\@auxi);Coloreado en 0.001 segundos, usando
GeSHi 1.0.8.4
la salida es:
- Código: Seleccionar todo
$VAR1 = [
undef,
'/<Baina>/<HAS_MAI>/
(LOT JNT AURK)
(ADI SIN ADOIN)
'
];
Es decir:
* Falta un registro (el último)
* Sobra un registro (el primero, fantasma, el
undef).
Aquí tenemos un problema.
Veamos la segunda parte, la creación de
$bloque:
Using perl Syntax Highlighting
my $kontador;
my $bloque;
foreach my $elemento ( @auxi ) {
my @fila_array = split (/\n/, $elemento);
foreach my $fila ( @fila_array ) {
if ( $kontador != 0
) {
$bloque = $bloque."\n".$fila;
}
$kontador++;
}
print Dumper
($bloque);
#my $result = index ($anb_klaseak, $bloque);
#print $result . "\n";
}Coloreado en 0.001 segundos, usando
GeSHi 1.0.8.4
la salida es:
- Código: Seleccionar todo
Use of uninitialized value in split at ./kk.pl line 29.
$VAR1 = undef;
Use of uninitialized value in numeric ne (!=) at ./kk.pl line 32.
Use of uninitialized value in concatenation (.) or string at ./kk.pl line 33.
$VAR1 = '
(LOT JNT AURK)
(ADI SIN ADOIN)';
Así que, aparte de las salidas de error, lo importante es el contenido de
$bloque, que vemos que tiene un retorno de carro en demasía, al principio.
Así que aquí tenemos otro problema.
En cuanto a que el código sea más o menos sucio, eso depende de quien lo vaya a mantener.
Aquí te voy a dar una serie de soluciones al problema planteado, que, naturalmente, no son únicas, y además, son aplicables a muchos otros casos similares. Están adaptadas para el foro en que estamos (Básico).
Por el principio:
Using perl Syntax Highlighting
#!/usr/bin/perl
use warnings
;
use strict
;
# Lectura del principal
my $anb_klaseak;
open(SS
,"<corp_anb_klaseak.txt") or die;
while( my $rang = <SS> ) {
$anb_klaseak .= $rang;
}
close(SS
);
Coloreado en 0.001 segundos, usando
GeSHi 1.0.8.4
que es casi lo mismo que tienes tu, salvo reducida la escritura del operador concatenación.
De la segunda parte:
Using perl Syntax Highlighting
# Lectura de los test
my @auxi;
my $auxiliar;
open(AE
, "<test.txt") or die;
while( my $reng = <AE> ) {
if ( $reng =~ m/^\/\</ and $auxiliar ) {
push(@auxi, $auxiliar);
$auxiliar = $reng;
}
else {
$auxiliar .= $reng;
}
}
push(@auxi, $auxiliar) if $auxiliar;
close AE
;
use Data
::Dumper;
print Dumper
(\@auxi);Coloreado en 0.001 segundos, usando
GeSHi 1.0.8.4
que también es casi lo mismo que el tuyo, con los siguientes cambios:
* Cambiado !~ por =~ (es más fácil de leer)
* Hacer el último push() después del bucle, por si queda algún test por añadir al
@auxi.
Y la tercera parte:
Using perl Syntax Highlighting
# Búsqueda de los test dentro del principal
foreach my $elemento ( @auxi ) {
my @fila_array = split (/\n/, $elemento);
my $bloque;
my $kontador = 0;
foreach my $fila ( @fila_array ) {
if ( $kontador > 0
) {
if ( $bloque ) {
$bloque = $bloque . "\n" . $fila;
}
else {
$bloque = $fila;
}
}
$kontador++;
}
print Dumper
($bloque);
my $result = index ($anb_klaseak, $bloque);
print "=> $result <= \n";
}Coloreado en 0.001 segundos, usando
GeSHi 1.0.8.4
que, igual que antes, sigue siendo lo mismo que lo tuyo, pero con los cambios:
* añadida una comprobación más, para saber si
$bloque está vacío o no. Esto lo hacemos para evitar el caso de poner un retorno de carro solitario, al principio
* agregamos una salida Dumper, para ver realmente lo que tenemos. Recuerda: Data::Dumper es tu amigo.
Entonces, dado el texto principal
- Código: Seleccionar todo
<1><ANB_TAL_002><9856>
(LOT JNT AURK)
(ADI SIN ADOIN)
<2><ANB_TAL_002><5508>
(IZE ARR BIZ-)
(IZE ARR BIZ- ABS MG)
<3><ANB_TAL_002><3434>
(IZE ARR)
(IZE ARR ABS MG)
y dado el fichero de test
- Código: Seleccionar todo
/<Baina>/<HAS_MAI>/
(LOT JNT AURK)
(ADI SIN ADOIN)
/<du>/<HAS_MIN>/
(ADI SIN ADOIN)
(ADJ ARR)
entonces la salida del programa es
- Código: Seleccionar todo
$VAR1 = [
'/<Baina>/<HAS_MAI>/
(LOT JNT AURK)
(ADI SIN ADOIN)
',
'/<du>/<HAS_MIN>/
(ADI SIN ADOIN)
(ADJ ARR)
'
];
$VAR1 = '(LOT JNT AURK)
(ADI SIN ADOIN)';
=> 23 <=
$VAR1 = '(ADI SIN ADOIN)
(ADJ ARR)';
=> -1 <=
Observa como los elementos de
@auxi se separan bien. Y que index() encuentra el primer test (23), pero no el segundo (-1), lo cual es correcto, según el ejemplo que hemos escogido.
Otra forma de hacer el programa podría ser esta:
Using perl Syntax Highlighting
#!/usr/bin/perl
use Data
::Dumper;
use warnings
;
use strict
;
my $anb_klaseak;
{
local $/ = undef; # Modo 'slurp'
# Lectura del principal
open(SS
,"<corp_anb_klaseak.txt") or die;
$anb_klaseak = <SS>;
close(SS
);
print $anb_klaseak, "\n";
}
# Lectura de los test
my @auxi;
my $auxiliar;
open(AE
, "<test.txt") or die;
while ( my $linea = <AE> ) {
if ( $linea =~ m{/<} ) { # Si estamos a principio de bloque
if ( $auxiliar ) { # Si tenemos un bloque anterior
push @auxi, $auxiliar; # lo guardamos
$auxiliar = "";
} # Si no tenemos un bloque anterior, no hacemos nada
} else { # Si es una línea de un bloque, vamos guardando
$auxiliar .= $linea;
}
}
close AE
;
push @auxi, $auxiliar if $auxiliar; # Guardamos último bloque, si lo hubiera
print Dumper
(\@auxi);
# Búsqueda de los test dentro del principal
foreach my $bloque ( @auxi ) {
my $result = index($anb_klaseak, $bloque);
print "=> $result <= \n";
}Coloreado en 0.001 segundos, usando
GeSHi 1.0.8.4
Las diferencias son:
* usamos el modo 'slurp' para leernos todo el fichero principal, de golpe
* la lectura de los test la modificamos un poco, para quitarles la primera línea
* con lo que la búsqueda se convierte en algo trivial.
Otra forma:
Using perl Syntax Highlighting
#!/usr/bin/perl
use warnings
;
use strict
;
local $/;
my $anb_klaseak = do{ open(SS
,"<corp_anb_klaseak.txt") or die; <SS>; };
my $tests = do{ open(AE
,"<test.txt") or die; <AE>; };
my @auxi = split( /^\/<.*?$/simo, $tests );
foreach my $bloque ( @auxi ) {
$bloque =~ s/^\s*//;
next if !$bloque;
print '=> '. index($anb_klaseak, $bloque) . " <= \n";
}Coloreado en 0.001 segundos, usando
GeSHi 1.0.8.4
leyendo los ficheros completos, a memoria, y luego dividiendo los tests por las cabeceras. Como esto genera valores vacíos en algunas ocasiones, las quitamos con la expresión regular del último bucle.
Aún puede quedar un poco más reducido, con
Using perl Syntax Highlighting
#!/usr/bin/perl
use File
::Slurp;
use warnings
;
use strict
;
my $anb_klaseak = read_file
('corp_anb_klaseak.txt');
my $tests = read_file
('test.txt' );
my @bloques = $tests =~ m{^/.*?\n([^/]+)}sigmo
;
foreach my $bloque ( @bloques ) {
print '=> '. index($anb_klaseak, $bloque) . " <= \n";
}Coloreado en 0.001 segundos, usando
GeSHi 1.0.8.4
Usando un módulo para leer ficheros, queda más corto. Y una expresión regular nos divide los bloques, quitándonos las cabeceras. Pero esto solo funciona si sabemos que los test no contienen el carácter '/'.
Para más seguridad, se puede usar entonces la siguiente expresión regular:
Using perl Syntax Highlighting
my @bloques = $tests =~ m{^/.*?\n(.*?)(?=^/|\z)}sigmo
;Coloreado en 0.001 segundos, usando
GeSHi 1.0.8.4
que quiere decir:
"Saca todos los
@bloques desde
$tests, que estén compuestos por un número de caracteres mínimo (
(.*?)) entre una línea que comienza por '/' (
^/.*?\n) y una línea con un '/' al principio (
^/) o (
|) fin de string (
\z)". El '
?=' indica que esta última comprobación no forma parte del actual patrón encontrado, por lo que nos servirá para encontrar el patrón siguiente.
