#!/usr/bin/perl
# ptkwhois v0.2
# A Whois Client for Perl/Tk
# By Alan Ford <alan@whirlnet.co.uk> 17/04/99
#
# Changelog:
# 17/04/1999 Initial Release Version (0.1)
# 06/06/1999 Added support for command-line host and server specification (0.2)
#
# 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 ;
sub help ;

my $version = "0.2";

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

my $MW = MainWindow->new;

$MW->title("Perl/Tk Whois");
$MW->Label(-text => "Version $version - Written by Alan Ford <alan\@whirlnet.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]);

if ($ARGV[0]) {
   # Are they asking for help?
   if ($ARGV[0] =~ /help$/) {
       help;
   }
   if ($ARGV[0] eq "-?") {
       help;
   }
   if ($ARGV[0] eq "-h") {
       help;
   }
   my $cmdhost = $ARGV[0];
   my $cmdserver;
   if ($ARGV[1]) {
      $cmdserver = $ARGV[1];
   } else {
      $cmdserver = $default_server;
   }
   $lookup_host->insert('0', $cmdhost);
   $lookup_server->delete('0', 'end');
   $lookup_server->insert('0', $cmdserver);
   whois;
}

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

sub help {
   print <<EOF

ptkfinger - Perk/Tk Whois Client for X version $version (requires Perl/Tk)

Optional Parameters: [domain [server]]

domain being the domain to look up, server being the whois server to use
(default is $default_server)

Report bugs to the author, Alan Ford <alan\@whirlnet.co.uk>

For more information: `man ptkwhois'

EOF
;
exit;
}
