#!/usr/bin/perl
# ptkfinger v0.2
# A Finger Client (without using a special module) for Perl/Tk
# By Alan Ford <alan@whirlnet.co.uk> 07/04/99
#
# Changelog:
# 07/04/99 First Released Version (0.1)
# 06/06/99 Added support for giving finger address on command line (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 finger ;
sub help ;

my $version = "0.2";

my $MW = MainWindow->new;

$MW->title("Perl/Tk Finger");
$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 => "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]);

if ($ARGV[0]) {
   # Are they asking for help?
   if ($ARGV[0] =~ /help$/) {
      help;
   }
   if ($ARGV[0] eq "-?") { 
      help;
   }
   if ($ARGV[0] eq "-h") {
      help;
   }
   # Address (probably) specified as command-line option
   my $cmduser = $ARGV[0];
   my $cmdhost;
   ($cmduser, $cmdhost) = split /@/, $ARGV[0], 2;
   $lookup_user->insert('0', $cmduser);
   $lookup_host->insert('0', $cmdhost);
   finger;
}

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

sub help {
   print <<EOF

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

Address to finger can (but is not required) be specified as a parameter.

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

For more information: `man ptkfinger'

EOF
;
exit;
}
