#!/usr/bin/perl -w

#--------------------------------------------------------------------------
# A GUI in Perl/Tk for WD4NMQ's "echolinux" command-line program.
# Copyright (C) 2003 Andrew D.S.Benham
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# Andrew Benham, G8FSL
# (g8fsl@adsb.co.uk).
#--------------------------------------------------------------------------

my $version = "0.02";

use strict;
use IO::Socket;
use Tk;
use Tk::Tree;
use Tk::ROText;
use Tk::ProgressBar;
use POSIX qw/:signal_h :errno_h :sys_wait_h/;

# Period (in ms) between automatic relogin and update of the station list
use constant RELOGIN_PERIOD => 300000;	# 300000 ms = 5 minutes

# One-off delay (in ms) between startup and logging in
use constant PRELOGIN_WAIT => 3000;	# 3000 ms = 3 seconds

# One-off delay (in ms) between logging in and first downloading the station list
use constant POSTLOGIN_WAIT => 7000;	# 7000 ms = 7 seconds

# Location of the echolinux binary. This is an example of
# a good name (TM) for a variable :-)
my $echolinux_binary = '/usr/bin/echolinux';

#-------------------------------------------------------
# You shouldn't need to touch anything below this point.
#
# Although you might want/need to play around with the
# font used in the Tree widget containing the currently
# available stations - search for '#--' to get there.
#-------------------------------------------------------

warn <<"EOT";
echolinux.pl version $version, Copyright (C) 2003 Andrew D.S.Benham.
echolinux.pl comes with ABSOLUTELY NO WARRANTY; for details see the
'LICENCE' file provided with the software.
This is free software, and you are welcome to redistribute it
under certain conditions; again for details see the 'LICENCE' file
provided with the software.

EOT

die "Error: Looks like the X Window System isn't running.\n" unless (defined $ENV{'DISPLAY'});

die "Error: HOME not set in environment.\n" unless (defined $ENV{'HOME'});

my $config_dir = "$ENV{'HOME'}/.echoLinux";
my $server_file = "$config_dir/servers.txt";
my $user_file = "$config_dir/userdata.txt";
my $friends_file = "$config_dir/friends.txt";

my @servers = &read_server_name();

my ($callsign,$name,$location,$password) = &read_user_details();

my @friends = &read_friends();
my %friends_to_watch = ();
foreach (@friends) {
	$friends_to_watch{$_} = 1;
}

my $doing_shutdown = 0;

my $child_pid;

$SIG{'PIPE'} = sub {
	unless ($doing_shutdown) {
		warn "Lost comms with echolinux binary (SIGPIPE)\n";
		&shutdown();
	}
};

$SIG{'CHLD'} = \&sigchild_handler;

sub sigchild_handler {
	# Called when a SIGCHLD is seen.
	# Means that a child process has died, =or= that the
	# child has seen a signal.

	# In practice, called when the echolinux binary exits,
	# or if one puts this script into the background.

	my $pid;
	$pid = waitpid -1, WNOHANG;
	# pid = -1 means no child processes
	# pid = 0  means (on some systems) child processes still running
	if ($pid > 0) {
		unless (WIFSTOPPED($?)) {
			unless ($doing_shutdown) {
				warn "Lost comms with echolinux binary (SIGCHLD)\n";
				&shutdown();
			}
		}
	}
	# Reinstall handler for those systems which are unreliable
	$SIG{'CHLD'} = \&sigchild_handler;
};


# Run the echolinux binary
pipe CHILD_READ, PARENT_WRITE or die "cr/pw pipe failure: $!\n";
pipe PARENT_READ, CHILD_WRITE or die "pr/cw pipe failure: $!\n";
if ($child_pid = fork) {
	# This is the parent
	close CHILD_READ;
	close CHILD_WRITE; 
	PARENT_WRITE->autoflush(1);
} elsif (defined $child_pid) {
	# This is the child
	close PARENT_READ;
	close PARENT_WRITE;
	open STDIN, "<&CHILD_READ" or die "Child stdin open failure: $!\n";
	open STDOUT, ">&CHILD_WRITE" or die "Child stdout open failure: $!\n";
	STDOUT->autoflush(1);
	exec($echolinux_binary) or die "Can't exec program '$echolinux_binary': $!\n";
	die "LOGIC ERROR: Err... what happened, how did I get here ?";
} else {
	# Neither parent nor child, 'cos it all went wrong
	die "Fork failed; $!\n";
}

my @station_types = (qw/ Repeaters Links Conferences Users /);
push @station_types,'Friends' if (scalar @friends);

my %repeaters = ();
my %links = ();
my %conferences = ();
my %users = ();
my %friends = ();

# mode is the current operating mode, one of IDLE, LOGGED_IN, BUSY
# BUSY is both manual and in qso.
my $mode = 'IDLE';

my $i_am_busy = 0;

my $in_qso_with;	# Used for label text in UI

my $strength;		# The audio strength, used for bar in UI

my $status_message = "Waiting...";
my $mw = MainWindow->new;
my $server_frame = $mw->Frame(-borderwidth => 2, -relief => 'groove')->pack(-side => 'left', -fill => 'both', -expand => 1);
my $server_label = $server_frame->Label(-text => 'Server')->pack;

my $qso_frame = $mw->Frame(-borderwidth => 2, -relief => 'groove')->pack(-side => 'right', -fill => 'both', -expand => 1);
my $qso_label = $qso_frame->Label(-text => 'QSO')->pack;
my $qso_status = $qso_frame->Label(-textvariable => \$in_qso_with) -> pack(-fill => 'x', -anchor => 'w');

my $qso_text = $qso_frame->Scrolled("ROText", -scrollbars => 'ose', -width => 40)->pack(-fill => 'both', -expand => 1);
my $qso_progressbar = $qso_frame->ProgressBar(-width => 20, -from => 0, -to => 100, -blocks => 100, -gap => 0, -relief => 'groove', -borderwidth => 2, -colors => [ 0, 'green', 50, 'yellow', 80, 'red'], -troughcolor => 'grey87', -variable => \$strength)->pack(-fill => 'x');

my $busy_button     = $server_frame->Button(-text => "Show Me Busy"  ,-command => \&toggle_busy  )->pack;
my $getlist_button  = $server_frame->Button(-text => "Get List"  ,-command => \&get_list  )->pack;

#--------------------------------------------------
# Tree widget to hold currently available stations.
# You might want to change the font - be sure to
# pick a non-proportionally spaced font, otherwise
# it'll look awful.
#--------------------------------------------------
#
my $station_tree_font = $mw->fontCreate('station_tree', -family => 'courier', -size => 11);
my $tree_width = 50;		# Used in code which writes into the Tree

my $stations_hlist = $server_frame->Scrolled("Tree", -scrollbars => 'ose', -width => $tree_width + 8, -font => 'station_tree')->pack(-fill => 'both', -expand => 1);

$stations_hlist->bind('<1>' => \&connect_to_station);
foreach (@station_types) {
        my $text = $_;
        $text =~ s/^\w+\.//;
        $stations_hlist->add($_, -text => $_);
        $stations_hlist->add("$_.dummy", -text => "");
}
$stations_hlist->autosetmode;
foreach (@station_types) {
        $stations_hlist->delete('offsprings', $_);
}
foreach (@station_types) {
	$stations_hlist->close($_);
}
my $server_message = $server_frame->Scrolled("ROText",-scrollbars => 'ose', -width => 40, -height => 4)->pack(-fill => 'both');
$server_message->insert("end",'Server messages appear here');

my $exit_button = $server_frame->Button(-text => "Exit",-command => \&shutdown)->pack;

my $disconnect_button = $qso_frame->Button(-text => "Disconnect",-command => \&disconnect, -state => 'disabled')->pack(-side => 'bottom');

my $chat_frame = $qso_frame->Frame()->pack(-fill => 'x');
my $chat_label = $chat_frame->Label(-text => 'Chat:')->pack(-side => 'left');
my $chat_entry = $chat_frame->Entry(-state => 'disabled') -> pack(-fill => 'x', -expand => 1,-side => 'right');
$chat_entry->bind('<Key-Return>' => \&send_chat_text);

my $ptt_button = $qso_frame->Checkbutton(-text => 'PTT', -indicatoron => 1, -relief => 'raised', -selectcolor => '#ff0000',-command => \&toggle_ptt, -state => 'disabled', -height => 2)->pack(-side => 'bottom',-fill => 'x');

my $status_frame = $server_frame->Frame()->pack(-side => 'bottom', -fill => 'x');
my $status_fixed_label = $status_frame->Label(-text => 'Status:')->pack(-side => 'left');
my $status_label  = $status_frame->Label (-textvariable => \$status_message,-anchor=>'w') -> pack(-fill => 'x',-side => 'right',-expand => 1);

my $initial_timer_id = $mw->after(PRELOGIN_WAIT,\&first_login);
my $repeat_timer_id = $mw->repeat(RELOGIN_PERIOD,\&relogin);

$mw->protocol('WM_DELETE_WINDOW',\&shutdown);

$mw->fileevent(\*PARENT_READ, 'readable' => \&do_line_from_binary);


MainLoop;

#---------------------------------------

sub first_login {
	&login;
	if ($mode eq 'LOGGED_IN') {
		my $initial_timer_id = $mw->after(POSTLOGIN_WAIT,\&get_list);
	}
}

sub relogin {
	if ($mode eq 'IDLE') {
		# Do nothing
	} elsif ($mode eq 'LOGGED_IN') {
		&login();
	} elsif ($mode eq 'BUSY') {
		&busy();
	} else {
		warn "LOGIC ERROR: Unknown mode '$mode'\n";
	}
	unless ($mode eq 'IDLE' or defined $in_qso_with) {
		&get_list();
	}
}

sub toggle_busy {
	if ($i_am_busy) {
		$i_am_busy = 0;
		$busy_button->configure(-text => 'Show Me Busy');
		&login();
	} else {
		$i_am_busy = 1;
		$busy_button->configure(-text => 'Show Me Free');
		&busy();
	}
}

sub busy {
	$status_message ="Attempting busy...";
	$mw->Busy;
	my $time = &make_time_string();
	my $busy_string;
	if (defined $in_qso_with) {
		$busy_string = "In QSO with $in_qso_with";
	} else {
		$busy_string = $location;
	}
	my $rc = &simple_command_to_server("l$callsign\254\254$password\015BUSY3.40($time)\015$busy_string\015");
	$mw->Unbusy;
	if ($rc) {
		$status_message = "Busy";
		$mode = 'BUSY';
	} else {
		$status_message = "Busy FAILED";
	}
}

sub login {
	$status_message ="Attempting login...";
	$mw->Busy;
	my $time = &make_time_string();
	my $rc = &simple_command_to_server("l$callsign\254\254$password\015ONLINE3.38($time)\015$location\015");
	$mw->Unbusy;
	if ($rc) {
		$status_message = "Logged in and ready";
		$mode = 'LOGGED_IN';
	} else {
		$status_message = "Login FAILED";
	}
}

sub logout {
	$status_message ="Attempting logout...";
	$mw->Busy;
	my $rc = &simple_command_to_server("l$callsign\254\254$password\015OFF-V3.40\015$location\015");
	$mw->Unbusy;
	if ($rc) {
		$status_message = "Logged out";
		$mode = 'IDLE';
	} else {
		$status_message = "Logout FAILED";
	}
}

sub simple_command_to_server {
	my $command = shift;
	my $rc = 0;

	my $socket = &open_server_socket(@servers);

	if ($socket) {
		print $socket $command;

		my $response = <$socket>;

		close $socket;

		if (defined $response and $response =~ m/^OK/) {
			$rc = 1;
		}
	}
	return $rc;
}

sub read_server_name {
	my @servers = ();
	open FILE,"<$server_file" or die "Can't open $server_file: $!\n";
	while (my $server_name = <FILE>) {
		chomp $server_name;
		push @servers,$server_name;
	}
	close FILE;
	die "No servers found\n" unless (scalar @servers);
	return @servers;
}

sub read_user_details {
	open FILE,"<$user_file" or die "Can't open $user_file: $!\n";
	my $line_num = 0;
	my ($callsign,$name,$location,$password);
	while (<FILE>) {
		chomp;

		$callsign = uc $_ if ($line_num == 0);
		$name = $_ if ($line_num == 1);
		$location = $_ if ($line_num == 2);
		$password = uc $_ if ($line_num == 3);

		$line_num++;
	}
	close FILE;

	die "No callsign found in $user_file\n" unless (defined $callsign and $callsign);
	die "No name found in $user_file\n" unless (defined $name and $name);
	die "No location found in $user_file\n" unless (defined $location and $location);
	die "No password found in $user_file\n" unless (defined $password and $password);

	return ($callsign,$name,$location,$password);
}

sub read_friends {
	my @friends = ();
	if (open FILE,"<$friends_file") {
		while (my $friend = <FILE>) {
			chomp $friend;
			push @friends,uc $friend;
		}
		close FILE;
	} else {
		warn "Can't open your friends file ($friends_file).\nThen again, perhaps you haven't got any friends....\n";
	}
	return @friends;
}

sub open_server_socket {
	foreach my $server (@_) {
		my $socket = IO::Socket::INET->new(
			PeerAddr => $server,
			PeerPort => 5200,
			Type => SOCK_STREAM,
			Timeout => 10,
			MultiHomed => 1);

		return $socket if ($socket);

		$status_message = "Can't connect to $server";
		$mw->update;
	}
	$status_message = "Can't connect to any servers";
	return 0;
}

sub make_time_string {
	# Local or GMT ??

	my ($hour,$minute) = (localtime())[2,1];
	return sprintf("%02d:%02d",$hour,$minute);
}

sub get_list {
	$status_message = "Attempting to download list...";
	$mw->Busy;
	my $socket = &open_server_socket(@servers);

	if ($socket) {
		print $socket "s";

		my $line_num;
		my $assemble_count = 0;
		my $clean_end = 0;

		my ($call,$data,$id,$ip);

		my @server_info = ();

		my $total_record_count;
		my $record_count = 0;

		while (<$socket>) {
			if (!defined $line_num) {
				if ($_ eq "@@@\n") {
					$line_num = 0;	# Seen the start marker
				} else {
					die "Start marker not seen\n";
				}
			} elsif ($line_num == 0) {
				$total_record_count = $_;
				chomp $total_record_count;
				die "Record count from server not numeric" unless ($total_record_count =~ m/^\d+$/);
				$line_num = 1;
			} else {
				if ($_ eq "+++") {
					$clean_end = 1;
					last;
				}

				if ($assemble_count == 0) {
					$call = $_;
					chomp $call;
				} elsif ($assemble_count == 1) {
					$data = $_;
					chomp $data;
				} elsif ($assemble_count == 2) {
					$id = $_;
					chomp $id;
				} elsif ($assemble_count == 3) {
					$ip = $_;
					chomp $ip;
				}
				$assemble_count++;

				if ($assemble_count == 4) {
					$record_count++;
					my $percent_done = int(100 * $record_count/$total_record_count);
					$status_message = "Station list $percent_done% complete";
					$assemble_count = 0;
					$mw->update;
					if ($ip =~ m/^127.0.0.1$/) {
						push @server_info,"$data\n";
					} elsif (defined $call and $call !~ m/^\s*$/) {
						if ($call =~ m/-R$/) {
							$repeaters{$call} = [$data,$ip]
						} elsif ($call =~ m/-L$/) {
							$links{$call} = [$data,$ip]
						} elsif ($call =~ m/^\*/) {
							$conferences{$call} = [$data,$ip]
						} else {
							$users{$call} = [$data,$ip];
						}
						if (exists $friends_to_watch{$call}) {
							$friends{$call} = [$data,$ip];
						}
					} else {
						warn "Unknown data: $call $data $id $ip\n";
					}
				}
				$line_num++;
			}
		}
		close $socket;
		warn "Didn't see end marker\n" unless ($clean_end);
		$mw->Unbusy;
		$status_message = "Sorting and loading list";
		$mw->update;

		# Clear the station list
		foreach (@station_types) {
			$stations_hlist->delete('offsprings', $_);
		}

		foreach my $station_type (@station_types) {
			my %hash_name = eval '%' . lc $station_type;

			foreach my $key (sort keys %hash_name) {

				# Now it would be ever so neat if the Perl/Tk Tree widget
				# processed <TAB>s, and even better if it could do
				# an 'aligned-right' TAB. But it can't, so we have
				# to do the formatting by hand. Hence the 'spaces_needed'
				# variable.

				my $location = $hash_name{$key}->[0];
				my $spaces_needed = $tree_width - length($key) - length($location);
				my $text = $key . ' ' x $spaces_needed . $location;
				$stations_hlist->add("$station_type.$key", -text => $text);
				$mw->update;
			}
			$stations_hlist->open($station_type);
			$stations_hlist->close($station_type);
			$mw->update;
		}

		$server_message->delete('1.0','end');
		foreach my $line (@server_info) {
			$server_message->insert('end',$line);
		}
		$mw->update;
		if ($mode eq 'LOGGED_IN') {
			$status_message = "Logged in and ready";
		} elsif ($mode eq 'BUSY') {
			$status_message = "Busy";
		} else {
			$status_message = "";
		}
		$mw->update;
	} else {
		$mw->Unbusy;
		$status_message = "Get list FAILED";
		$mw->update;
	}
}

sub connect_to_station {
	my $station = $stations_hlist->nearest($Tk::event->y);

	if (defined $station and $station =~ /\./) {
		$station =~ s/^.*\.//;

		my $ip;
		if ($station =~ /-R$/) {
			$ip = $repeaters{$station}->[1];
		} elsif ($station =~ /-L$/) {
			$ip = $links{$station}->[1];
		} elsif ($station =~ /^\*/) {
			$ip = $conferences{$station}->[1];
		} else {
			$ip = $users{$station}->[1];
		}
		print PARENT_WRITE "C $ip\n";
	}
}

sub shutdown {
	$doing_shutdown = 1;	# To stop us going recursive from signal handlers
	&logout() unless ($mode eq 'IDLE');
	print PARENT_WRITE "Q\n";
	$mw->destroy() if (defined $mw);
}

sub disconnect {
	# Send a 'D' to the echolinux binary
	print PARENT_WRITE "D\n";
}

sub toggle_ptt {
	# Send a <SPACE> to the echolinux binary
	print PARENT_WRITE " \n";
}	

sub do_line_from_binary {
	my $data = <PARENT_READ>;

	# This check shouldn't be necessary, because it's checking
	# for eof on the pipe, and we should have seen a SIGCHLD
	# before this happens.
	die "Lost comms with echolinux binary (PARENT_READ)\n" unless (defined $data);

	chomp $data;
	$data =~ s/\r/\n/g;
	#print "\007Received '$data' from $echolinux_binary\n";
	my $command = substr($data,0,1);

	if ($command eq 'D') {
		# Got a DISCONNECT
		$in_qso_with = undef;

		$disconnect_button->configure(-state => 'disabled');
		$ptt_button->configure(-state => 'disabled');
		$ptt_button->deselect();
		$chat_entry->configure(-state => 'disabled');

		print PARENT_WRITE "SF\n";

		if ($i_am_busy) {
			&busy();
		} else {
			&login;
		}
		$mw->update;

	} elsif ($command eq 'C') {
		# Got a CONNECT
		# ---- Careful, because this comes in regularly whilst in QSO ---

		my $previous_in_qso_with = $in_qso_with;
		my @connect_info = split /\s+/,$data;
		$in_qso_with = $connect_info[1];

		$disconnect_button->configure(-state => 'normal');
		$ptt_button->configure(-state => 'normal');
		$chat_entry->configure(-state => 'normal');

		print PARENT_WRITE "SN\n";
		$mw->update;

		&busy if (!defined $previous_in_qso_with or $in_qso_with ne $previous_in_qso_with);

	} elsif ($command eq 'I') {
		# Got INFO
		$data =~ s/^I\s//;
		$qso_text->insert('end',$data . "\n\n");
		$qso_text->see('end');

	} elsif ($command eq 'N') {
		# Got chat text
		$data =~ s/^N\s//;
		$qso_text->insert('end',$data . "\n\n");
		$qso_text->see('end');

	} elsif ($command eq 'R') {
		# Got RX
		$ptt_button->deselect();

	} elsif ($command eq 'T') {
		# Got TX
		$ptt_button->select();

	} elsif ($command eq 'S') {
		# Got audio signal strength
		if ($data =~ m/(\d+)$/) {
			my $raw_strength = $1;
			# Trap strength of 0, because the log() call will
			# fail. Thanks to Petra, DL9HCP.
			$raw_strength = 1 if ($raw_strength == 0);
			$strength = 100 + (20 * log($raw_strength/32768));
		}

	} else {
		warn "Don't know how to process an incoming '$data'.\n";
	}
}

sub send_chat_text {
	my $text = $chat_entry->get();

	# Send the text to the binary
	print PARENT_WRITE "N $text\n";

	# Put the text in the QSO textbox
	$qso_text->insert("end","$callsign> $text\n");
	$qso_text->see('end');

	# Clear the text from the entry widget
	$chat_entry->delete(0, 'end');
}
