Bienvenido a Tecnohackers

Tecnohackers » Programacion » Area de Programacion » Scripting. VBS, Batch, Bash, JavaSript.
 » 

[Perl Tk] Diccionario Online 0.1



Autor Tema: [Perl Tk] Diccionario Online 0.1  (Leído 727 veces)

Desconectado Doddy

  • Veterano
  • ***
  • Mensajes: 249
  • Slow Mind
[Perl Tk] Diccionario Online 0.1
« en: Marzo 19, 2012, 02:00:09 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


El codigo

Código: You are not allowed to view links. Register or Login
#!usr/bin/perl
#Diccionario Online 0.1
#Coded By Doddy H

use Tk;
use Tk::ROText;
use LWP::UserAgent;
use HTML::Entities;

if ( $^O eq 'MSWin32' ) {
    use Win32::Console;
    Win32::Console::Free();
}

my $nave = LWP::UserAgent->new;
$nave->agent(
"Mozilla/5.0 (Windows; U; Windows NT 5.1; nl; rv:1.8.1.12) Gecko/20080201Firefox/2.0.0.12"
);
$nave->timeout(5);

my $fondo = "gray";
my $letra = "black";

my $new = MainWindow->new( -background => $fondo, -foreground => $letra );

$new->title("Diccinario Online 0.1 || By Doddy H");
$new->geometry("340x290+20+20");
$new->resizable( 0, 0 );

$new->Label(
    -text       => "Palabra : ",
    -font       => "Impact1",
    -background => $fondo,
    -foreground => $letra
)->place( -x => 20, -y => 20 );
my $pal =
  $new->Entry( -width => 25, -background => $fondo, -foreground => $letra )
  ->place( -x => 95, -y => 24 );
$new->Button(
    -text             => "Buscar",
    -width            => 7,
    -background       => $fondo,
    -foreground       => $letra,
    -activebackground => $fondo,
    -command          => \&start
)->place( -y => 22, -x => 260 );

$new->Label(
    -text       => "Significado",
    -font       => "Impact1",
    -background => $fondo,
    -foreground => $letra
)->place( -x => 120, -y => 70 );
my $con = $new->ROText(
    width       => 39,
    -height     => 10,
    -background => $fondo,
    -foreground => $letra
)->place( -x => 30, -y => 120 );

MainLoop;

sub start {

    $new->update;
    $con->delete( "0.0", "end" );

    my $code = toma( "http://es.thefreedictionary.com/" . $pal->get );

    chomp $code;

    if ( $code =~ /<div class=runseg><b>1 <\/b>&nbsp; (.*?)[.:<]/ ) {
        my $text = decode_entities($1);
        $con->insert( "end", $text );
    }

}

sub toma {
    return $nave->get( $_[0] )->content;
}

#The End ?

You are not allowed to view links. Register or Login

Tags:
Tags:

 


SMF 2.0.19 | SMF © 2016, Simple Machines
Paginas Afiliadas
Twitter - FaceBook - Daraxblog
Designed by Smf Personal