Foro - Perl en Español

por **explorer** » 2012-04-03 09:32 @438

En efecto, me refiero a los rowspan...

Fíjate en la segunda tabla, segunda fila de datos: en realidad son dos filas, ya que las celdas de Receiver, Time Lag, y Last Modify Time están compartidas en las dos filas, con sendos rowspan.

No es un problema sencillo el desenrollar esas celdas compartidas...

La solución sería usar el módulo HTML::TableExtract, que con la opción gridmap se puede controlar la forma de extracción de los datos, en árbol o en rejilla, ocupándose él de estos casos de celdas fantasma.

Usando el método rows() nos devolverá el contenido de las filas, pero en las celdas fantasma su contenido será undef, por lo que habrá que recordar el valor de la celda correspondiente de la fila anterior para saber el verdadero de la celda.

O mejor aún: usar space(), que sí hace todo ese trabajo. Lo único que hay que hacer es un doble bucle de filas y columnas de la tabla, extraer la información con space(), y guardarlo en un array bidimensional, o como indicas más arriba, en un array de hashes.

He encontrado una solución con Mojolicious, ya que he visto que las tablas, sus celdas expandidas, se concentran en la primera parte de cada fila (la parte izquierda de cada fila). Si las tablas siguen esa regla, entonces es fácil "parchear" la solución: si una fila tiene menos celdas que la anterior, quiere decir que tenemos que insertarle por delante celdas que hay en la fila anterior, ya que son celdas expandidas (rowspan="2").

Con este programa:

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

#!/usr/bin/perl
use Modern::Perl '2012';
use Mojo::Asset::File;
use Mojo::DOM;
use List::MoreUtils 'zip';
 
@ARGV == 2 or die "Uso: $0 <archivo.html> <master>\n";          # Comprobamos los argumentos
 
my($archivo, $master) = @ARGV;                                  # Leemos los argumentos
 
my $file_asset = Mojo::Asset::File->new(path => $archivo);      # Crear acceso al archivo
my $mojo = Mojo::DOM->new($file_asset->slurp);                  # Leer el archivo y analizar
 
### Buscar el master
# Buscamos el párrafo que contiene el master, mirando uno por uno
my $master_collection
    = $mojo->find("p center[class=page-subtitle] a");           # La colección de master
 
my $posicion = -1;                                              # Posición en la que estará nuestro master
my $i = 0;                                                      # Contador de posición actual
for my $parrafo_master ($master_collection->each) {             # Para cada master
    if ($parrafo_master->text eq $master) {                     # Encontrado
        $posicion = $i;                                         # Lo anotamos
        last;                                                   # y salimos
    }
 
    $i++;                                                       # No encontrado, seguimos
}
 
die "ERROR: No encuentro master [$master] en la hoja.\n"
    if $posicion == -1;
 
say "Tabla número $posicion";
 
### Extraemos la tabla correspondiente
my $tabla = $mojo->find("table[class=bgColor9]")->[$posicion];
 
### Filas de la tabla
my @filas = $tabla->find("tr")->each;
say "Número de filas: ", scalar @filas -2;
 
### Fila de cabecera: suponemos que siempre es la fila 1
# Recorremos la fila extrayendo el texto de cada celda
my @headers = $filas[1]->find("th")->map(sub{shift->text})->each;
$" = ']['; say "[@headers]"; 
 
### Procesado
# Recorremos de la fila 2 hasta el final.
# Si el número de celdas es menor que la línea anterior,
# insertamos delante las celdas que faltan, copiándolas de la fila anterior.
# Luego, la fila es almacena como hash, usando las celdas de cabecera como claves.
# El hash se almacena como un elemento del array @registros.
my @registros;                                  # Resultado final: un array de hash
 
my @fila_anterior = ();                         # Necesario por si tenemos que duplicar contenido
 
for my $fila (2 .. $#filas) {                   # Para todas las filas de la 2 hasta el final
    my @celdas                                  # Las celdas serán
        = $filas[$fila]                         # de la $fila actual
        ->find("td")                            # de las marcas <td>
        ->map(                                  # La convertimos
            sub{                                # a
                shift->all_text;                # simplemente todo su texto
            }
        )
        ->each                                  # y lo repetimos para todas las demás
        ;
  
    if (@celdas < @fila_anterior) {             # Si el número de @celdas es menor que el de la línea anterior
        @celdas                                 # Modificamos nuestras celdas
            = (                                 # Insertando celdas de la fila anterior (las primeras por la izq.)
                @fila_anterior[0 .. @fila_anterior - @celdas -1],
                @celdas                         # más las que tenemos
            )
            ;
    }
    
    #say "[@celdas]";
 
    push @registros, { zip @headers, @celdas }; # Almacenamos el resultado en un hash, dentro de un array
                                                # Con zip, se va colocando cada pareja:clave(cabecera) y su valor(celda)
 
    @fila_anterior = @celdas;                   # Ahora @celdas será nuestra @fila_anterior
}
 
use Data::Dumper::Simple;                       # Volcado de la estructura
say Dumper @registros;                          # de los registros
 
Coloreado en 0.004 segundos,  usando GeSHi 1.0.8.4

ejecutado de esta manera:

Sintáxis: [ Descargar ] [ Ocultar ]

Using bash Syntax Highlighting

$ ./programa.pl code_30381.html ldap1-2.ddol-test.com:1389
Coloreado en 0.002 segundos,  usando GeSHi 1.0.8.4

sale:

Sintáxis: [ Descargar ] [ Ocultar ]

Using text Syntax Highlighting

Tabla número 1

Número de filas: 5

[Receiver][Time Lag][Max CSN][Last Modify Time][Supplier][Sent/Skipped][Update Status][Update Started][Update Ended][Schedule][SSL?]

@registros = (

               {

                 'Update Started' => '04/02/2012 12:28:54',

                 'Update Status' => '0 Replica acquired successfully: Incremental update succeeded',

                 'Update Ended' => '04/02/2012 12:28:54',

                 'Time Lag' => '0:00:00',

                 'Last Modify Time' => '1/1/1970 01:00:00',

                 'Sent/Skipped' => '0 / 0',

                 'SSL?' => 'n',

                 'Receiver' => 'ldap1-1.ddol-test.com:1389 Type: master',

                 'Supplier' => 'ldap1-2.ddol-test.com:1389',

                 'Schedule' => 'always in sync',

                 'Max CSN' => '4f7959ae000000020000 (04/02/2012 09:47:58)'

               },

               {

                 'Update Started' => '04/02/2012 12:34:54',

                 'Update Status' => '0 Replica acquired successfully: Incremental update succeeded',

                 'Update Ended' => '04/02/2012 12:34:54',

                 'Time Lag' => '0:00:00',

                 'Last Modify Time' => '1/1/1970 01:00:00',

                 'Sent/Skipped' => '0 / 0',

                 'SSL?' => 'n',

                 'Receiver' => 'ldap2-1.ddol-test.com:1389 Type: consumer',

                 'Supplier' => 'ldap1-2.ddol-test.com:1389',

                 'Schedule' => 'always in sync',

                 'Max CSN' => '4f7959ae000000020000 (04/02/2012 09:47:58)'

               },

               {

                 'Update Started' => '04/02/2012 12:36:46',

                 'Update Status' => '0 Replica acquired successfully: Incremental update succeeded',

                 'Update Ended' => '04/02/2012 12:36:46',

                 'Time Lag' => '0:00:00',

                 'Last Modify Time' => '1/1/1970 01:00:00',

                 'Sent/Skipped' => '0 / 0',

                 'SSL?' => 'n',

                 'Receiver' => 'ldap2-1.ddol-test.com:1389 Type: consumer',

                 'Supplier' => 'ldap1-1.ddol-test.com:1389',

                 'Schedule' => 'always in sync',

                 'Max CSN' => '4f7959ae000000020000 (04/02/2012 09:47:58)'

               },

               {

                 'Update Started' => '04/02/2012 12:34:54',

                 'Update Status' => '0 Replica acquired successfully: Incremental update succeeded',

                 'Update Ended' => '04/02/2012 12:35:01',

                 'Time Lag' => '0:00:00',

                 'Last Modify Time' => '1/1/1970 01:00:00',

                 'Sent/Skipped' => '0 / 0',

                 'SSL?' => 'n',

                 'Receiver' => 'ldap2-2.ddol-test.com:1389 Type: consumer',

                 'Supplier' => 'ldap1-2.ddol-test.com:1389',

                 'Schedule' => 'always in sync',

                 'Max CSN' => '4f7959ae000000020000 (04/02/2012 09:47:58)'

               },

               {

                 'Update Started' => '04/02/2012 12:36:39',

                 'Update Status' => '0 Replica acquired successfully: Incremental update succeeded',

                 'Update Ended' => '04/02/2012 12:36:39',

                 'Time Lag' => '0:00:00',

                 'Last Modify Time' => '1/1/1970 01:00:00',

                 'Sent/Skipped' => '0 / 0',

                 'SSL?' => 'n',

                 'Receiver' => 'ldap2-2.ddol-test.com:1389 Type: consumer',

                 'Supplier' => 'ldap1-1.ddol-test.com:1389',

                 'Schedule' => 'always in sync',

                 'Max CSN' => '4f7959ae000000020000 (04/02/2012 09:47:58)'

               }

             );Coloreado en 0.001 segundos,  usando GeSHi 1.0.8.4

Ejemplo de acceso a un dato:

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

say $registros[1]->{'Receiver'}; # ldap2-1.ddol-test.com:1389 Type: consumer
Coloreado en 0.001 segundos,  usando GeSHi 1.0.8.4

He visto también que la columna de Schedule tiene en todas las filas un colspan="2", lo cual puede significar, o un descuido del programador, o es que quizás, en alguna ocasión, sí que aparece una columna más. Si este es el caso, entonces sí que se nos pueden descuadrar los datos.

por **magiza83** » 2012-04-04 04:37 @234

¡Hola, explorer!

No puedo decir nada más que: ¡espectacular! Funciona tal cual esperaba. En principio no debería modificarse más la estructura de la tabla.

De todas maneras, aun no entiendo muy bien cómo funciona el módulo y alguna parte del script. ¡Pero voy a estudiarmelo!

¡muchas gracias de nuevo!

Foro - Perl en Español

Obtener datos tabla HTML

Re: Obtener datos tabla HTML

Publicidad

Re: Obtener datos tabla HTML

Re: Obtener datos tabla HTML

¿Quién está conectado?