elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.

 

 


Tema destacado: ¿Eres nuevo? ¿Tienes dudas acerca del funcionamiento de la comunidad? Lee las Reglas Generales


+  Foro de elhacker.net
|-+  Programación
| |-+  Scripting
| | |-+  RAE Search, soft [PERL]
0 Usuarios y 1 Visitante están viendo este tema.
Páginas: [1] Ir Abajo Respuesta Imprimir
Autor Tema: RAE Search, soft [PERL]  (Leído 2,838 veces)
leogtz
. . .. ... ..... ........ ............. .....................
Colaborador
***
Desconectado Desconectado

Mensajes: 3.069


/^$/


Ver Perfil WWW
RAE Search, soft [PERL]
« en: 6 Abril 2010, 01:59 am »

Hola, aquí les dejo este pequeño programita que hice para buscar entradas en la Real Academia Española, le puse interfaz gráfica con Gtk2:



Aquí está el código:

Código
  1. #!/usr/bin/perl
  2. use warnings;
  3. use strict;
  4. use LWP::Simple;
  5. use Gtk2 '-init';
  6. use constant TRUE => 1;
  7. use constant FALSE => 0;
  8.  
  9. binmode STDOUT, ":encoding(UTF-8)";
  10.  
  11. sub raeSearch()
  12. {
  13.        my $rae = get("http://buscon.rae.es/draeI/SrvltGUIBusUsual?LEMA=$_[0]");
  14. my $resultado;
  15.        while ($rae =~ m/name="[\d_]+"> (.*?) <\/p/smgix)
  16.        {
  17.                my $desc = $1;
  18.                # Quitar las marcas HTML
  19.                $desc =~ s/<.*?>//gsm;
  20.                # Quitar los espacios a los lados
  21.                $desc =~ s/^\s+//sm;
  22.                $desc =~ s/\s+$//sm;
  23.                # Quitar espacios excesivos
  24.                $desc =~ s/\s+/ /gsm;
  25. $resultado .= "$desc\n";
  26.        }
  27. return $resultado;
  28. }
  29.  
  30. # Propiedades de ventana:
  31. my $window = Gtk2::Window->new();
  32. $window->set_title("Rae Search");
  33. $window->set_border_width(3);
  34. $window->signal_connect(destroy => sub{Gtk2->main_quit});
  35. $window->set_auto_startup_notification(TRUE);
  36. $window->set_decorated(TRUE);
  37. $window->set_default_icon_from_file("camel.ico");
  38. $window->move(0, 0);
  39. $window->resize(700, 100);
  40. $window->set_resizable(TRUE);
  41.  
  42. # Frame:
  43. my $frame = Gtk2::Frame->new("Entrada");
  44.  
  45. # VBox:
  46. my $vbox = Gtk2::VBox->new(FALSE, 10);
  47. $vbox->pack_start($frame, TRUE, TRUE, 0);
  48.  
  49. # HBox:
  50. my $hbox = Gtk2::HBox->new(FALSE, 6);
  51.  
  52. # Entry:
  53. my $dir_entry = Gtk2::Entry->new_with_max_length(30);
  54. $dir_entry->set_text("encono");
  55. $dir_entry->set_activates_default(FALSE);
  56. $dir_entry->set_position(100);
  57.  
  58. # Button:
  59. my $button = Gtk2::Button->new("_Buscar");
  60. $button->set_focus_on_click(TRUE);
  61. my $rae;
  62.  
  63. # TextView  :
  64. my $textview = Gtk2::TextView->new();
  65. $textview->set_border_window_size('top', 1);
  66. my $buffer = $textview->get_buffer;
  67.  
  68. $button->signal_connect(clicked => sub
  69. {
  70. $buffer->set_text(&raeSearch($dir_entry->get_text));
  71. }
  72. );
  73.  
  74. # Scroll Window :
  75.  
  76. my $scroll = Gtk2::ScrolledWindow->new();
  77. $scroll->set_policy('automatic', 'automatic');
  78. $scroll->set_shadow_type('out');
  79. $scroll->add($textview);
  80. $vbox->pack_end($scroll, TRUE, TRUE, 0);
  81. $frame->add($hbox);
  82. $hbox->pack_start($dir_entry, FALSE, FALSE, 0);
  83. $hbox->pack_start($button, FALSE, FALSE, 0);
  84. $window->add($vbox);
  85. $window->show_all;
  86. Gtk2->main;

Agradezco a explorer de perlenespanol.com por la ayuda brindada.

El programa es sencillo, pero me sirvió mucho, aprendí bastantes cosas con este proyectito.

El código necesita este icono para funcionar:
http://icone.goldenweb.it/download_file/d2/animals/c/jenanimals/file/camel/ext/.ico/default.html

O sino quieren  descargar el icono, solo quiten esta línea:
Código
  1. $window->set_default_icon_from_file("camel.ico");

Saludos.


« Última modificación: 6 Abril 2010, 02:30 am por Leo Gutiérrez. » En línea

Código
  1. (( 1 / 0 )) &> /dev/null || {
  2. echo -e "stderrrrrrrrrrrrrrrrrrr";
  3. }
  4.  
http://leonardogtzr.wordpress.com/
leogutierrezramirez@gmail.com
xassiz_

Desconectado Desconectado

Mensajes: 273


Ich werde dich töten..


Ver Perfil WWW
Re: RAE Search, soft [PERL]
« Respuesta #1 en: 6 Abril 2010, 18:20 pm »

Lo portaste a Perl ;D ;D

Esta bueno, nunca viera una interfaz gráfica así con Perl ;-)


En línea



YXVuIGVyZXMgbWF0YWRvIHBhcmEgcG9uZXJ0ZSBhIGRlc2NpZnJhciBlc3RvIHhE
leogtz
. . .. ... ..... ........ ............. .....................
Colaborador
***
Desconectado Desconectado

Mensajes: 3.069


/^$/


Ver Perfil WWW
Re: RAE Search, soft [PERL]
« Respuesta #2 en: 6 Abril 2010, 21:21 pm »

Gracias, lo he actualizado ya, quedó algo así:


También le agregué un botón para copiar todo al portapapeles.



Y por supuesto la licencia GPL:


El código queda así:

Código
  1. #!/usr/bin/perl
  2. use warnings;
  3. use strict;
  4. use LWP::Simple;
  5. use Gtk2 '-init';
  6. use constant TRUE => 1;
  7. use constant FALSE => 0;
  8. use utf8;
  9.  
  10. binmode STDOUT, ":encoding(UTF-8)";
  11.  
  12. sub raeSearch()
  13. {
  14.        my $rae = get("http://buscon.rae.es/draeI/SrvltGUIBusUsual?LEMA=$_[0]");
  15. my $resultado;
  16.        while ($rae =~ m/name="[\d_]+"> (.*?) <\/p/smgix)
  17.        {
  18.                my $desc = $1;
  19.                # Quitar las marcas HTML
  20.                $desc =~ s/<.*?>//gsm;
  21.                # Quitar los espacios a los lados
  22.                $desc =~ s/^\s+//sm;
  23.                $desc =~ s/\s+$//sm;
  24.                # Quitar espacios excesivos
  25.                $desc =~ s/\s+/ /gsm;
  26. $resultado .= "$desc\n";
  27.        }
  28. # Saber si $resultado está vacio:
  29. if(!defined($resultado))
  30. {
  31. return "La palabra \"$_[0]\" no se encuentra en el diccionario. RAE\n";
  32. } else {
  33. return $resultado;
  34. }
  35. }
  36.  
  37. sub hide_on_delete
  38. {
  39. my ($widget) = @_;
  40. $widget->hide;
  41. return 1;
  42. }
  43.  
  44. # Propiedades de ventana:
  45. my $window = Gtk2::Window->new();
  46. $window->set_title("RAE Search");
  47. $window->set_border_width(3);
  48. $window->signal_connect(destroy => sub{Gtk2->main_quit});
  49. $window->set_auto_startup_notification(TRUE);
  50. $window->set_decorated(TRUE);
  51. $window->set_default_icon_from_file("camel.ico");
  52. $window->move(0, 0);
  53. $window->resize(700, 100);
  54. $window->set_resizable(TRUE);
  55.  
  56. # Frame :
  57.  
  58. my $frame = Gtk2::Frame->new("Entrada");
  59.  
  60. # VBox :
  61.  
  62. my $vbox = Gtk2::VBox->new(FALSE, 10);
  63. $vbox->pack_start($frame, TRUE, TRUE, 0);
  64.  
  65. # HBox :
  66.  
  67. my $hbox = Gtk2::HBox->new(FALSE, 6);
  68.  
  69. # Entry:
  70.  
  71. my $dir_entry = Gtk2::Entry->new_with_max_length(30);
  72. $dir_entry->set_text("encono");
  73. $dir_entry->set_activates_default(FALSE);
  74. $dir_entry->set_position(100);
  75.  
  76. # Button :
  77.  
  78. my $button = Gtk2::Button->new("_Buscar");
  79. $button->set_alignment(2.6, 4.5);
  80. $button->set_focus_on_click(TRUE);
  81.  
  82. # TextView :
  83.  
  84. my $textview = Gtk2::TextView->new();
  85. $textview->set_border_window_size('top', 1);
  86. my $buffer = $textview->get_buffer;
  87.  
  88. # Button (button and clipboard widget) :
  89.  
  90. my $button_clipboard = Gtk2::Button->new("_Clipboard");
  91. $button_clipboard->set_focus_on_click(TRUE);
  92. my $clipboard = Gtk2::Clipboard->get(Gtk2::Gdk->SELECTION_CLIPBOARD);
  93.  
  94. $button->signal_connect(clicked => sub
  95. {
  96. $buffer->set_text(&raeSearch($dir_entry->get_text));
  97. }
  98. );
  99.  
  100. $button_clipboard->signal_connect(clicked => sub
  101. {
  102. $clipboard->set_text(&raeSearch($dir_entry->get_text));
  103. }
  104. );
  105.  
  106. # Button (Quit) :
  107.  
  108. my $button_quit = Gtk2::Button->new("_Salir");
  109. $button_quit->set_alignment(3.5, 4.5);
  110. $button_quit->set_focus_on_click(TRUE);
  111. $button_quit->signal_connect(clicked => sub
  112. {
  113. Gtk2->main_quit;
  114. }
  115. );
  116.  
  117. # AboutDialog :
  118.  
  119. my $about = Gtk2::AboutDialog->new;
  120. $about->set_comments("Un buscador de palabras en el diccionario de la Real Academia Española");
  121. $about->set_website("leorocko13\@hotmail.com");
  122. $about->set_authors("Leo Gutierrez Ramirez");
  123. $about->set_copyright("(c) Leo Gutiérrez Ramírez");
  124. $about->set_program_name("RAE Search");
  125. $about->set_version("1.0");
  126. $about->set_website_label("leorocko13\@hotmail.com");
  127. open(my $file, q[<], "./licencia.txt") or die("No se pudo abrir el archivo \"licencia.txt\". _$!");
  128. my $license;
  129. while(<$file>)
  130. {
  131. $license .= $_;
  132. }
  133. close($file) or warn("Error cerrando el archivo \"licencia.txt\"");
  134. $about->set_license($license);
  135.  
  136. # Button (about) :
  137.  
  138. my $button_about = Gtk2::Button->new("_About ...");
  139. $button_about->set_focus_on_click(TRUE);
  140. $button_about->signal_connect(clicked => sub {
  141. $about->run;
  142. &hide_on_delete($about);
  143. }
  144. );
  145.  
  146. # Scroll Window :
  147.  
  148. my $scroll = Gtk2::ScrolledWindow->new();
  149. $scroll->set_policy('automatic', 'automatic');
  150. $scroll->set_shadow_type('out');
  151. $scroll->add($textview);
  152.  
  153. $vbox->pack_start($scroll, TRUE, TRUE, 0);
  154. $vbox->pack_start($button_clipboard, TRUE, TRUE, 2);
  155. $frame->add($hbox);
  156. $hbox->pack_start($dir_entry, FALSE, FALSE, 0);
  157. $hbox->pack_start($button, FALSE, FALSE, 0);
  158. $hbox->pack_end($button_about, FALSE, FALSE, 0);
  159. $hbox->pack_end($button_quit, FALSE, FALSE, 0);
  160. $window->add($vbox);
  161. $window->show_all;
  162. Gtk2->main;
  163.  
  164.  

Con perl se pueden hacer muchísimas cosas, en cpan hay más de 8000 módulos que te permiten hacer lo que quieras, está gtk, gtk2, tk, Qt, etc, etc.

Por cierto, he visto que en los repositorios hay un software llamada lemurae, hecho en python, parecido al que yo hice, ¿alguno sabe como poner un programita simple como este en los repositorios?
En línea

Código
  1. (( 1 / 0 )) &> /dev/null || {
  2. echo -e "stderrrrrrrrrrrrrrrrrrr";
  3. }
  4.  
http://leonardogtzr.wordpress.com/
leogutierrezramirez@gmail.com
Páginas: [1] Ir Arriba Respuesta Imprimir 

Ir a:  

Mensajes similares
Asunto Iniciado por Respuestas Vistas Último mensaje
[Perl] Search MD5
Scripting
BigBear 0 1,605 Último mensaje 7 Octubre 2011, 15:56 pm
por BigBear
[Perl] Search in google for scan SQLI
Scripting
BigBear 1 2,590 Último mensaje 4 Noviembre 2011, 17:48 pm
por BiteAciD
[Perl] search.cpan.org cierra tras 20 años de servicio
Scripting
explorer 0 1,773 Último mensaje 17 Mayo 2018, 22:14 pm
por explorer
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines