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

my $MW = MainWindow->new;

$MW->title("Perl/Tk Finger");
$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 => "Address to Finger:")->pack(-side => 'left');
my $lookup_user = $lookup_frame->Entry(-width => '10', -relief => 'sunken')->pack(-side => 'left', -expand => '1', -fill => 'x');
$lookup_frame->Label(-text => "\@")->pack(-side => 'left');
my $lookup_host = $lookup_frame->Entry(-width => '25', -relief => 'sunken')->pack(-side => 'left', -expand => '1', -fill => 'x');

my $long_value = '0';
my $long_output = $lookup_frame->Checkbutton(-onvalue => '1', -offvalue => '0', -variable => \$long_value, -text => 'Long Output')->pack(-side => 'left');

my $finger = $lookup_frame->Button(-text => 'Finger',
                                   -command => sub
                                   {
                                    finger;
                                   });
$finger->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 => '25', -width => '80', -yscrollcommand => ['set', $scroll])->pack(-side => 'bottom', -expand => '1', -fill => 'both');
$scroll->configure(-command => ['yview', $display]);

MainLoop;
 

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

my $host = $lookup_host->get;
if ($host eq "") {
    $host = "localhost";
    $lookup_host->insert('0', "localhost");
}
my $user = $lookup_user->get;
my $msg;

my $remote = IO::Socket::INET->new(
               Proto    => "tcp",
               PeerAddr => $host,
               PeerPort => "finger(79)",
              );

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

$remote->autoflush(1);

# use CRLF network line terminators
if ($long_value == 1) {
    print $remote "/W $user\015\012";
} else {
    print $remote "$user\015\012";
}
while ($_ = <$remote>) {
    #print;
    $_ =~ s/\r$//;  # trim annoying \r line-endings on some finger output
    $display->insert('end', $_);
}
close($remote)  or sub {
    $msg = "Can't close socket: $!\n";
    $display->insert('end', $msg);
    };
}