Foro de elhacker.net

Programación => Scripting => Mensaje iniciado por: BigBear en 19 Marzo 2012, 02:05 am



Título: [Perl Tk] Diccionario Online 0.1
Publicado por: BigBear en 19 Marzo 2012, 02:05 am
Mientras estudiaba para unos examenes estaba buscando la definicion de algunas palabras asi que me hice este pequeño programa en perl para poder buscar la definicion de cualquier palabra mediante una pagina web.

Una imagen

(http://doddyhackman.webcindario.com/images/dic.jpg)

El codigo

Código
  1. #!usr/bin/perl
  2. #Diccionario Online 0.1
  3. #Coded By Doddy H
  4.  
  5. use Tk;
  6. use Tk::ROText;
  7. use LWP::UserAgent;
  8. use HTML::Entities;
  9.  
  10. if ( $^O eq 'MSWin32' ) {
  11.    use Win32::Console;
  12.    Win32::Console::Free();
  13. }
  14.  
  15. my $nave = LWP::UserAgent->new;
  16. $nave->agent(
  17. "Mozilla/5.0 (Windows; U; Windows NT 5.1; nl; rv:1.8.1.12) Gecko/20080201Firefox/2.0.0.12"
  18. );
  19. $nave->timeout(5);
  20.  
  21. my $fondo = "gray";
  22. my $letra = "black";
  23.  
  24. my $new = MainWindow->new( -background => $fondo, -foreground => $letra );
  25.  
  26. $new->title("Diccinario Online 0.1 || By Doddy H");
  27. $new->geometry("340x290+20+20");
  28. $new->resizable( 0, 0 );
  29.  
  30. $new->Label(
  31.    -text       => "Palabra : ",
  32.    -font       => "Impact1",
  33.    -background => $fondo,
  34.    -foreground => $letra
  35. )->place( -x => 20, -y => 20 );
  36. my $pal =
  37.  $new->Entry( -width => 25, -background => $fondo, -foreground => $letra )
  38.  ->place( -x => 95, -y => 24 );
  39. $new->Button(
  40.    -text             => "Buscar",
  41.    -width            => 7,
  42.    -background       => $fondo,
  43.    -foreground       => $letra,
  44.    -activebackground => $fondo,
  45.    -command          => \&start
  46. )->place( -y => 22, -x => 260 );
  47.  
  48. $new->Label(
  49.    -text       => "Significado",
  50.    -font       => "Impact1",
  51.    -background => $fondo,
  52.    -foreground => $letra
  53. )->place( -x => 120, -y => 70 );
  54. my $con = $new->ROText(
  55.    width       => 39,
  56.    -height     => 10,
  57.    -background => $fondo,
  58.    -foreground => $letra
  59. )->place( -x => 30, -y => 120 );
  60.  
  61. MainLoop;
  62.  
  63. sub start {
  64.  
  65.    $new->update;
  66.    $con->delete( "0.0", "end" );
  67.  
  68.    my $code = toma( "http://es.thefreedictionary.com/" . $pal->get );
  69.  
  70.    chomp $code;
  71.  
  72.    if ( $code =~ /<div class=runseg><b>1 <\/b>&nbsp; (.*?)[.:<]/ ) {
  73.        my $text = decode_entities($1);
  74.        $con->insert( "end", $text );
  75.    }
  76.  
  77. }
  78.  
  79. sub toma {
  80.    return $nave->get( $_[0] )->content;
  81. }
  82.  
  83. #The End ?
  84.  
  85.