#!/usr/bin/perl -w
# ptkfinger v0.1
# A Finger Client (without using a special module) for Perl/Tk
# By Alan Ford <alan@whirlnet.demon.co.uk> 07/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 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);
    };
}
 