#!/usr/bin/perl -w
# ptkwhois v0.1
# A Whois Client for Perl/Tk
# By Alan Ford <alan@whirlnet.demon.co.uk> 17/04/99
#
# Distributed with no warranty under the GNU Public License

require 5.002;
use IO::Socket;
use Socket;
use English;
use Tk;
use Tk::DialogBox;
sub whois ;

my $default_server = "whois.internic.net";

my $MW = MainWindow->new;

$MW->title("Perl/Tk Whois");
$MW->Label(-text => "Version 0.1 - Written by Alan Ford <alan\@whirlnet.demon.co.uk>")->pack(-side => 'bottom');

my $lookup_frame = $MW->Frame()->pack(-expand => '1', -fill => 'both', -side => 'top');

$lookup_frame->Label(-text => "Whois Server:")->pack(-side => 'left');
my $lookup_server = $lookup_frame->Entry(-width => '20', -relief => 'sunken')->pack(-side => 'left', -expand => '1', -fill => 'x');
$lookup_frame->Label(-text => "Domain to Lookup:")->pack(-side => 'left');
my $lookup_host = $lookup_frame->Entry(-width => '20', -relief => 'sunken')->pack(-side => 'left', -expand => '1', -fill => 'x');

$lookup_server->insert('0', $default_server);

my $whois = $lookup_frame->Button(-text => 'Lookup Domain',
                                  -command => sub
    		                  {
			           whois;
			          });
$whois->pack(-side => 'left', -expand => '1', -fill => 'both');

my $exit = $lookup_frame->Button(-text => 'Exit',
                                 -command => sub
		                 {
		                  exit;
		                 });
$exit->pack(-side => 'left', -expand => '1', -fill => 'both');

my $scroll = $MW->Scrollbar();
$scroll->pack(-side => 'right', -fill => 'y');
my $display = $MW->Text(-height => '20', -width => '80', -yscrollcommand => ['set', $scroll])->pack(-side => 'bottom', -expand => '1', -fill => 'both');
$scroll->configure(-command => ['yview', $display]);

MainLoop;


sub whois {
$display->delete('1.0', 'end');

my $host = $lookup_host->get;
my $server = $lookup_server->get;
if ($server eq "") { 
    $server = $default_server;
    $lookup_server->insert('0', $default_server);
}
my $msg;

my $remote = IO::Socket::INET->new(
    	       Proto    => "tcp",
    	       PeerAddr => $server,
    	       PeerPort => "whois(43)",
      	      ); 

unless ($remote) { 
    $msg = "Cannot connect to $server\n";
    $display->insert('end', $msg);
    next;
}

$remote->autoflush(1);

# use CRLF network line terminators
print $remote "$host\015\012";

while ($_ = <$remote>) {
    #print;
    $_ =~ s/\r$//;  # trim annoying \r line-endings on some output
    $display->insert('end', $_);
}
close($remote)	or sub {
    $msg = "Can't close socket: $!\n";
    $display->insert('end', $msg);
    };
}
 