Foro - Perl en Español

La comunidad de programadores en Perl de habla hispana.

Obviar


  • Publicidad

Consulta sobre HTML::TableExtract

¿Apenas comienzas con Perl? En este foro podrás encontrar y hacer preguntas básicas de Perl con respuestas aptas a tu nivel.
Publicar una respuesta

Consulta sobre HTML::TableExtract

Notapor enric73 » 2013-12-11 10:56 @497

Hola, compañeros.

Con el siguiente código interpreto la información de una web utilizando HTML::TableExtract. Se leen dos tablas. Por pantalla sale lo que he pegado después del código, y necesitaría guardar la información en un fichero csv en el formato que indico en la parte inferior de esta consulta. Muchas gracias por adelantado.

Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. #!/usr/local/bin/perl
  2. use strict;
  3. use warnings;
  4. use utf8::all;
  5. use v5.10;
  6. use LWP::Simple;
  7. use HTML::TableExtract;
  8. use String::Util qw< trim >;
  9. use Text::CSV;
  10.  
  11. my $page = "http://www.tuixent-lavansa.com/pagina/inicial";
  12. my $html = get( $page );
  13.  
  14. my $te = HTML::TableExtract->new();
  15. $te->parse($html);
  16. my @tables = $te->tables;
  17. my @rows = $tables[0]->rows;
  18. shift @rows;
  19.  
  20. my @titles = map { trim( $_->[0] ) } @rows;
  21. my @values = map { trim( $_->[1] ) } @rows;
  22. my $csv = Text::CSV->new ( { binary => 1, eol => $/ } ) or die;
  23. $csv->print( \*STDOUT, \@titles);
  24. $csv->print( \*STDOUT, \@values);
  25.  
  26. my $te2 = HTML::TableExtract->new();
  27. $te2->parse($html);
  28. my @tables2 = $te2->tables;
  29. my @rows2 = $tables2[1]->rows;
  30. shift @rows2;
  31.  
  32. my @titles2 = map { trim( $_->[0] ) } @rows2;
  33. my @values2 = map { trim( $_->[1] ) } @rows2;
  34.  
  35.  
  36. my $csv = Text::CSV->new ( { binary => 1, eol => $/ } ) or die;
  37. $csv->print( \*STDOUT, \@titles2 );
  38. $csv->print( \*STDOUT, \@values2 );
  39.  
Coloreado en 0.003 segundos, usando GeSHi 1.0.8.4


Resultado por pantalla es:
Sintáxis: [ Descargar ] [ Ocultar ]
Using bash Syntax Highlighting
  1. [enric@localhost parsejar]$ ./tuixentOK.pl
  2. "my" variable $csv masks earlier declaration in same scope at ./tuixentOK.pl line 36.
  3. "ACCÉS","ESTACIÓ",LLOGUER,"RESTAURANT L'ARP"
  4. OBERT,OBERTA,OBERT,OBERT
  5. QUALITAT,"GRUIX MINÍM","GRUIX MÀXIM","KM MARCATS"
  6. Pols,"15 cm","50 cm","20 Km"
Coloreado en 0.003 segundos, usando GeSHi 1.0.8.4


Lo que necesito es guardar en un csv una parte de estos datos y en dos líneas, eliminado cm., km., añadiendo guiones en los campos (REMUNTADORS y PISTAS) donde la web no ofrece información y en el formato siguiente, la cabecera en la primera línea y en la segunda los datos.

ESTACIÓ,ESTAT, ACCÉS,NEU,GRUIX.MAX,GRUIX.MIN,REMUNTADORS, PISTES,KM
Tuixent, oberta,obert, Pols, 50,15,-,-,20

Saludos y gracias.
¿Alguien me puede ayudar en este tramo final?
enric73
Perlero nuevo
Perlero nuevo
 
Mensajes: 154
Registrado: 2012-03-16 06:27 @311
Arriba

Publicidad

Re: Consulta sobre HTML::TableExtract

Notapor explorer » 2013-12-11 21:01 @917

Antes de eso debes aclarar un tema...

La página está codificada en ISO-8859-15. En el código no haces ningún tipo de transformación de caracteres. Pero tienes activado el módulo utf8::all, con lo que todas las salidas y entradas las tomará en UTF-8.

El caso es que es importante saber en qué codificación quieres que sea la salida, la del csv.
JF^D Perl programming & Raku programming. Grupo en Telegram: https://t.me/Perl_ES
Avatar de Usuario
explorer
Administrador
Administrador
 
Mensajes: 14480
Registrado: 2005-07-24 18:12 @800
Ubicación: Valladolid, España
Arriba

Re: Consulta sobre HTML::TableExtract

Notapor explorer » 2013-12-11 22:13 @967

Esta es una posible solución. La salida se hace en utf8.
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. #!/usr/bin/perl
  2. use v5.10;
  3. use autodie;
  4. use utf8::all;
  5. use strict;
  6. use warnings;
  7. use diagnostics;
  8.  
  9. ## Obtener la página
  10. use LWP::Simple;
  11. my $html = get("http://www.tuixent-lavansa.com/pagina/inicial");        # la página llega en iso-8859-15 y se pasa a unicode
  12.  
  13.  
  14. ## Interpretación del contenido
  15. use HTML::TableExtract;
  16. my $te = HTML::TableExtract->new();
  17. $te->parse($html);
  18. my @tables = $te->tables;
  19.  
  20.  
  21. ## Primera tabla
  22. my @rows = $tables[0]->rows;
  23. shift @rows;                                                    # la primera línea no interesa
  24.    
  25. #my @titles = map { $_->[0] } @rows;
  26. my @values = map { $_->[1] } @rows;
  27.  
  28.  
  29. ## Segunda tabla
  30. @rows = $tables[1]->rows;
  31. shift @rows;
  32.  
  33. #@titles = (@titles, map { $_->[0] } @rows);                    # agregamos a los que teníamos
  34. @values = (@values, map { $_->[1] } @rows);
  35.  
  36.  
  37. ## Arreglar valores
  38. #@titles = map { arregla($_) } @titles;
  39. @values = map { arregla($_) } @values;
  40.  
  41.  
  42. ## Agregar datos
  43. my @titles = qw(ESTACIÓ ESTAT ACCÉS NEU GRUIX.MAX GRUIX.MIN REMUNTADORS PISTES KM);
  44.  
  45. splice @values,  0, 0, 'Tuixent';                               # nombre de la estación
  46. @values[1,2] = @values[2,1];                                    # intercambiar estado y acceso
  47. splice @values, 3, 2;                                           # quitar lloguer i restaurant
  48. splice @values, -1, 0, '-',  '-';                               # remontadors i pistes
  49.  
  50. ## Salida en formato CSV
  51. use Text::CSV;
  52.  my $csv = Text::CSV->new ({
  53.     binary => 1,
  54.     eol    => $/,
  55. });
  56. $csv->print( \*STDOUT, \@titles);                               # la salida es pasada a UTF-8
  57. $csv->print( \*STDOUT, \@values);
  58.  
  59. ### Subrutinas
  60. sub arregla {
  61.     my $txt = shift;
  62.  
  63.     if (defined $txt) {                                         # si tenemos un valor definido
  64.                                                                 # $txt sigue estando en unicode
  65.         $txt =~ s/^\s+//;                                       # le quitamos los espacios (toda clase de espacios)
  66.         $txt =~ s/\s+$//;
  67.  
  68.         $txt =~ s/\s+(c|k)m$//i;                                # quitamos unidades
  69.         #say "[$txt]";
  70.     }
  71.     return $txt;
  72. }
  73.  
  74. __END__
Coloreado en 0.002 segundos, usando GeSHi 1.0.8.4
Sale:
Sintáxis: [ Descargar ] [ Ocultar ]
Using text Syntax Highlighting
"ESTACIÓ",ESTAT,"ACCÉS",NEU,GRUIX.MAX,GRUIX.MIN,REMUNTADORS,PISTES,KM
Tuixent,OBERTA,OBERT,Pols,15,50,-,-,20
Coloreado en 0.000 segundos, usando GeSHi 1.0.8.4

Algunas consideraciones:
  • solo necesitas crear e interpretar una sola vez la página que recibes. Una vez interpretada, solo tienes que acceder al array @tables para acceder a las distintas tablas
  • no es necesario procesar los títulos, porque ya sabemos cuáles son. O dicho de otra manera: necesitaríamos unas cuántas líneas para cambiar de nombre, insertar nuevos o borrar títulos nuevos. En lugar de eso, los asignamos en la línea 43 y ya solo queda arreglar la posición de los @values (esa también es la razón por la cual están comentadas casi todas las líneas que leen los @titles)
  • la clave está en la línea 34, donde unimos los @values de las dos tablas
JF^D Perl programming & Raku programming. Grupo en Telegram: https://t.me/Perl_ES
Avatar de Usuario
explorer
Administrador
Administrador
 
Mensajes: 14480
Registrado: 2005-07-24 18:12 @800
Ubicación: Valladolid, España
Arriba

Re: Consulta sobre HTML::TableExtract

Notapor enric73 » 2013-12-12 06:47 @324

Muchas gracias, explorer.

Un par de preguntas.
  1. dentro de la subrutina arregla() he añadido una conversión de mayúsculas a minúsculas para dos palabras. ¿Hay alguna manera de transformar todas las mayúsculas a minúsculas para todas las palabras que puedan aparecer?
    Sintáxis: [ Descargar ] [ Ocultar ]
    Using perl Syntax Highlighting
    1. $txt =~ s/OBERTA/oberta/g;
    2. $txt =~ s/OBERT/obert/g;
    Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4

  2. si estuviera interesado en sumar dos elementos del array @values (por ejemplo, sumar GRUIX.MAX y GRUIX.MIN), ¿cómo lo harías? Es un simple ejemplo


Muchas gracias y saludos.
enric73
Perlero nuevo
Perlero nuevo
 
Mensajes: 154
Registrado: 2012-03-16 06:27 @311
Arriba

Re: Consulta sobre HTML::TableExtract

Notapor Aceitunas » 2013-12-12 06:59 @333

De la web:

Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. my $string = "URIEL";
  2.  
  3. print lc($string); #Imprime uriel
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4


No me digas que no sabes sumar dos elementos. :roll:
Voy a llegar hasta el final, voy a subir la velocidad - Migue Benítez.
Aceitunas
Perlero nuevo
Perlero nuevo
 
Mensajes: 117
Registrado: 2013-11-07 15:25 @684
Ubicación: Ciudad Real, España.
Arriba

Re: Consulta sobre HTML::TableExtract

Notapor enric73 » 2013-12-12 07:16 @344

Gracias, Aceitunas.

Lo he introducido de esta manera:
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. $txt = lc($txt);
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4


Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. my $var = $values[4] + $values[5];
  2. print   $var;
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4

Ya he aprendido a sumar :( Era fácil
enric73
Perlero nuevo
Perlero nuevo
 
Mensajes: 154
Registrado: 2012-03-16 06:27 @311
Arriba

Re: Consulta sobre HTML::TableExtract

Notapor enric73 » 2013-12-12 19:10 @840

Hola, compañeros.

Siguiendo la línea de otro tema planteado esta semana, en este script se capturan diferentes columnas de una tabla de una web, el resultado está al final, donde tengo alguna duda.
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. #!/usr/local/bin/perl
  2. use v5.10;
  3. use autodie;
  4. use utf8::all;
  5. use strict;
  6. use warnings;
  7. use diagnostics;
  8.      
  9. ## Obtener la página
  10. use LWP::Simple;
  11. my $html = get("http://www.naturlandia.ad/activitats/estat");        # la página llega en iso-8859-15 y se pasa a unicode
  12.  
  13. ## Nombre fichero salida    
  14. my $output_file = 'rabassa.csv';
  15.    
  16. ## Interpretación del contenido
  17. use HTML::TableExtract;
  18. my $te = HTML::TableExtract->new();
  19. $te->parse($html);
  20. my @tables = $te->tables;
  21.      
  22.      
  23. ## tabla
  24. my @rows = $tables[0]->rows;
  25. shift @rows;                                                    # la primera línea no interesa
  26.        
  27.  
  28. my @values = map { $_->[1],$_->[2],$_->[3],$_->[5] } @rows;     #tomo las columnas de interés
  29. @values = map { arregla($_) } @values;    
  30. my @titles = qw(ESTACIO ESTAT ACCES NEU GRUIX.MAX GRUIX.MIN REMUNTADORS PISTES KM);    
  31.  
  32. splice @values, 3, 3;
  33. splice @values, 4, 3;
  34. splice @values, 5, 3;
  35. splice @values, 7, 7;
  36. splice @values,  0, 0, 'Rabassa';
  37. splice @values, -1, 0, '-',  '-';
  38. my $km = $values[3] + $values[4]+ $values[5] + $values[6];   #sumo km de pistas abiertas
  39. splice @values, 3, 4;
  40. splice @values, 6, 0, $km;
  41.  
  42. ## Salida en formato CSV
  43. open my $fh, ">:encoding(utf8)", $output_file or die $!;
  44. use Text::CSV;
  45. my $csv = Text::CSV->new ({
  46. binary => 1,
  47. eol    => $/,
  48. });
  49. $csv->print( \*STDOUT, \@titles);                               # la salida es pasada a UTF-8
  50. $csv->print( \*STDOUT, \@values);
  51. ##$csv->print( $fh, \@titles);                               # la salida es pasada a UTF-8
  52. ##$csv->print( $fh, \@values);
  53.  
  54. close $fh;
  55.  
  56. ### Subrutinas
  57. sub arregla {
  58. my $txt = shift;
  59.      
  60. if (defined $txt) {                                         # si tenemos un valor definido
  61.                                                                     # $txt sigue estando en unicode
  62. $txt =~ s/^\s+//;                                       # le quitamos los espacios (toda clase de espacios)
  63. $txt =~ s/\s+$//;
  64. $txt = lc($txt);
Coloreado en 0.002 segundos, usando GeSHi 1.0.8.4


Resultado al ejecutar:
Sintáxis: [ Descargar ] [ Ocultar ]
Using text Syntax Highlighting
[enric@localhost parsejar]$ ./rabassa.pl
ESTACIO,ESTAT,ACCES,NEU,GRUIX.MAX,GRUIX.MIN,REMUNTADORS,PISTES,KM
Rabassa,"mín: 30","mín: 60",dura,-,-,14.8,
Coloreado en 0.000 segundos, usando GeSHi 1.0.8.4


Dudas:
  1. no he podido eliminar del 2 y 3 elemento la palabra "mín: " y que solamente quede el número, ¿Cómo puedo eliminarlo?
  2. al final del array, aparece una coma, "14.8," ¿Cómo puedo eliminar esta coma final?


Gracias
enric73
Perlero nuevo
Perlero nuevo
 
Mensajes: 154
Registrado: 2012-03-16 06:27 @311
Arriba

Re: Consulta sobre HTML::TableExtract

Notapor explorer » 2013-12-12 21:42 @946

Para quitar la palabra 'mín:', se podría intentar con una expresión regular y el operador de sustitución s///.

En cuanto a la coma... algo anda mal... tienes 9 columnas en la cabecera, pero en la línea de datos solo hay 8. Esa es la razón de que hay una coma más: falta un dato.
JF^D Perl programming & Raku programming. Grupo en Telegram: https://t.me/Perl_ES
Avatar de Usuario
explorer
Administrador
Administrador
 
Mensajes: 14480
Registrado: 2005-07-24 18:12 @800
Ubicación: Valladolid, España
Arriba

Re: Consulta sobre HTML::TableExtract

Notapor enric73 » 2013-12-13 04:10 @215

Hola explorer,

Gracias, lo de la coma ya está solucionado.

En cuanto a la expresión regular y el operador s///, he introducido en la subrutina arregla() el siguiente código para quedarme con las cifras pero, lógicamente, se carga todas las palabras que están en otros elementos
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. $txt =~ s/[^0-9]//g;
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4

He intentado eliminar solamente 'mín:' de los elementos "mín: 30","mín: 60", pero no resulta:
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. $txt =~ s/(mín:)//g;
  2. $txt =~ s/mín://g;
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4

¿La solución sería aplicar la primera expresión regular que elimina las letras aplicándolo en el segundo y tercer elemento, en vez de introducirla dentro de la subrutina?

Saludos y gracias.
enric73
Perlero nuevo
Perlero nuevo
 
Mensajes: 154
Registrado: 2012-03-16 06:27 @311
Arriba

Re: Consulta sobre HTML::TableExtract

Notapor explorer » 2013-12-13 09:59 @458

El problema creo que está en la letra 'í': no sabemos en qué codificación te llegan los datos; y no sabemos en qué codificación tienes hecho el programa (como estás usando utf8::all sospechamos que editas tus programas en un ambiente utf-8).

Mira, a mí sí que me funciona:
Sintáxis: [ Descargar ] [ Ocultar ]
Using bash Syntax Highlighting
  1. $ perl  -E '$x = "mín: 60"; $x =~ s/^mín: //; say "[$x]";'
  2. [60]
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4
estoy en una terminal con codificación utf-8. Incluso puedo indicarle a Perl que el código está en utf-8 y también funciona:
Sintáxis: [ Descargar ] [ Ocultar ]
Using bash Syntax Highlighting
  1. $ perl  -E 'use utf8::all; $x = "mín: 60"; $x =~ s/^mín: //; say "[$x]";'
  2. [60]
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4
JF^D Perl programming & Raku programming. Grupo en Telegram: https://t.me/Perl_ES
Avatar de Usuario
explorer
Administrador
Administrador
 
Mensajes: 14480
Registrado: 2005-07-24 18:12 @800
Ubicación: Valladolid, España
Arriba
Siguiente
Publicar una respuesta

Volver a Básico

¿Quién está conectado?

Usuarios navegando por este Foro: No hay usuarios registrados visitando el Foro y 9 invitados

Powered by phpBB® Forum Software © phpBB Group
Traducción al Español Mexicano por nextgen en colaboración con phpbb-es.com
phpBB SEO
Advertisements by Advertisement Management