[Perl Tk] Whois Online 0.1

[BigBear]

Version Tk de un cliente whois que funciona mediante una pagina online.

Una imagen

El codigo

Código (perl) [Seleccionar] Expandir


#!usr/bin/perl
#Whois Online 0.1
#Version Tk
#Coded By Doddy H

use Tk;
use Tk::ROText;
use LWP::UserAgent;

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);

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

my $color_fondo = "black";
my $color_texto = "white";

my $newas =
  MainWindow->new( -background => $color_fondo, -foreground => $color_texto );
$newas->geometry("400x300+50+50");
$newas->title("Whois Online 0.1 || Coded By Doddy H");
$newas->resizable( 0, 0 );

$newas->Label(
    -text       => "Domain : ",
    -font       => "Impact2",
    -background => $color_fondo,
    -foreground => $color_texto
)->place( -x => "10", -y => "10" );
my $dom = $newas->Entry(
    -width      => "30",
    -background => $color_fondo,
    -foreground => $color_texto
)->place( -x => "85", -y => "13" );

my $console = $newas->Scrolled(
    "ROText",
    -scrollbars => "e",
    -width      => 36,
    -height     => 15,
    -background => $color_fondo,
    -foreground => $color_texto
)->place( -x => 15, -y => 50 );

$newas->Button(
    -text             => "Search",
    -command          => \&buscar,
    -width            => "10",
    -background       => $color_fondo,
    -foreground       => $color_texto,
    -activebackground => $color_texto
)->place( -x => 310, -y => "50" );
$newas->Button(
    -text             => "Clean",
    -command          => \&limpiar,
    -width            => "10",
    -background       => $color_fondo,
    -foreground       => $color_texto,
    -activebackground => $color_texto
)->place( -x => 310, -y => "80" );
$newas->Button(
    -text             => "Exit",
    -command          => \&salir,
    -width            => "10",
    -background       => $color_fondo,
    -foreground       => $color_texto,
    -activebackground => $color_texto
)->place( -x => 310, -y => "110" );

MainLoop;

sub buscar {
    $console->delete( "0.1", "end" );
    my $target = $dom->get;
    $newas->update;
    $console->insert( "end", whois($target) );
    $newas->update;
}

sub limpiar {
    $console->delete( "0.1", "end" );
    $dom->delete( "0.1", "end" );
}

sub salir {
    exit 1;
}

sub whois {

    my $ob   = shift;
    my $code = tomar(
        "http://networking.ringofsaturn.com/Tools/whois.php",
        { "domain" => $ob, "submit" => "submit" }
    );

    my @chau = ( """, ">>>", "<<<" );

    if ( $code =~ /<pre>(.*?)<\/pre>/sig ) {
        my $resul = $1;
        chomp $resul;

        for my $cha (@chau) {
            $resul =~ s/$cha//ig;
        }

        if ( $resul =~ /Whois Server Version/ ) {
            return $resul;
        }
        else {
            return "Not Found";
        }
    }
}

sub tomar {
    my ( $web, $var ) = @_;
    return $nave->post( $web, [ %{$var} ] )->content;
}

# The End ?