#!/usr/bin/perl

use strict ;
use warnings ;

use constant DEBUG => 0 ;

use threads ;
use threads::shared ;

use Tk ;
use AppConfig qw(:expand :argcount) ;
use HTTP::Daemon ;
use HTTP::Status ;
use LWP::UserAgent ;
use CGI ;
use Thread::Queue ;
use Time::HiRes qw(sleep) ;

$| = 1 if DEBUG ;

# Define configuration variables
my $conf = AppConfig->new({CASE => 1, GLOBAL => { ARGCOUNT => ARGCOUNT_ONE }}) ;
$conf->define('peerhost', { DEFAULT => 'localhost' }) ;
$conf->define('peerport', { DEFAULT => 1080 }) ;
$conf->define('localport', { DEFAULT => 1080 }) ;
$conf->define('mynick', { DEFAULT => $ENV{USER} || $ENV{USERNAME} || "Mr.X" }) ;

# Parse command line arguments
$conf->args() ;
my $peerhost  = $conf->get("peerhost") ;
my $peerport  = $conf->get("peerport") ;
my $localport = $conf->get("localport") ;
my $nick      = $conf->get("mynick") ;

# This will do the trick of updating the text window
my $queue : shared = Thread::Queue->new ;
my $keep_running : shared = 1 ;
my $httpd_timeout : shared = 10 ;

my $httpdt = threads->new(\&httpd) ;

$httpdt->detach ;

  # Create an user agent to send messages
print STDERR "Creating an HTTP user agent\n" if DEBUG ;
my $ua = LWP::UserAgent->new ;
die "Cannot create an User Agent" unless defined $ua ;

# Configure application window
print STDERR "Building the main window\n" if DEBUG ;
my $mw = MainWindow->new ;
$mw->title("ChatBG - $nick chatting with $peerhost:$peerport") ;

my $etext = "" ;

print STDERR "Creating chat window\n" if DEBUG ;
my $tbox  = $mw->Scrolled("Text", -width => 80, -height => 10,) ;

print STDERR "Creating text entry field\n" if DEBUG ;
my $ebox  = $mw->Entry(-width => 70, -textvariable => \$etext) ;

print STDERR "Configuring send button\n" if DEBUG ;
my $bsend = $mw->Button(-text => 'Send', -command => \&send_text) ;

print STDERR "Filling server information in chat window\n" if DEBUG ;
$tbox->insert('end',"Listening on port $localport\n") ;
$tbox->configure(-state => 'disabled') ;

print STDERR "packing...\n" if DEBUG ;
$tbox->pack(-side => 'top', -expand => 1, -fill => 'x') ;
$ebox->pack(-side => 'left', -expand => 1) ;
$bsend->pack(-side => 'right', -expand => 1, -fill => 'x') ;

print STDERR "Waiting for incoming messages\n" if DEBUG ;
$tbox->repeat(300,\&update_chat_window) ;

MainLoop ;

print STDERR "GUI is being destroyed!\n" if DEBUG ;
{
  lock $keep_running ;
  $keep_running-- ;
}

print STDERR "Giving httpd a chance to terminate" ;
for (my $i = $httpd_timeout ; $i >= 0 ; $i--) {
  if ($keep_running == 0) {
    print STDERR ".\n" ;
    exit 0 ;
  }
  print STDERR "...$i" ;
  sleep(1) ;
}

print STDERR "\nExit forced!" ;
exit 1 ;


exit ;

sub send_text {
  unless (length $etext > 0) {
    print STDERR "Empty text, won't send\n" ;
    return ;
  }

  print STDERR "Sending message...\n" if DEBUG ;
  $queue->enqueue(qq(you say: $etext\n)) ;
  $ua->post("http://$peerhost:$peerport/message",
	    {
	     nick => $nick, message => $etext }) ;
  $etext = "" ;
}

sub update_chat_window {
  my $message = $queue->dequeue_nb ;
  return if not defined $message ;
  post_to_chat_window($message) ;
}

sub post_to_chat_window {
  my $message = shift ;
  return unless length $message ;
  $tbox->configure(-state => 'normal') ;
  $tbox->insert('end',$message) ;
  print STDERR "Disabling text box\n" if DEBUG ;
  $tbox->configure(-state => 'disabled') ;
}

sub httpd {
  # Create a daemon to run in a thread
  print STDERR "Creating an HTTP daemon\n" if DEBUG ;
  my $httpd = HTTP::Daemon->new(LocalPort => $localport,
				Timeout   => $httpd_timeout,
                                ReuseAddr => 1) ;

  die "Cannot create an HTTP daemon" unless defined $httpd ;

  {
    lock $keep_running ;
    $keep_running ++ ;
  }

  print STDERR "HTTP daemon listening on port $localport\n" if DEBUG ;
  LISTEN: {
    my $client = $httpd->accept ;
    if (not defined $client) {
      redo LISTEN if $keep_running == 2 ;

      # $keep_running is now 1
      $httpd->close ;
      {
	lock $keep_running ;
	$keep_running-- ;
      }
      return ;
    }

    print STDERR "httpd got an incoming message\n" if DEBUG ;
    my $request = $client->get_request ;
    unless ($request->method eq 'POST' and
            $request->url->path eq '/message') {
      $client->send_error(RC_FORBIDDEN) ;
      $client->close ;
      redo LISTEN ;
    }

    my $q = CGI->new($request->content) ;
    my ($nick,$message) = map $q->param($_),qw(nick message) ;
    $queue->enqueue(qq($nick says: $message\n)) ;
    print STDERR "httpd enqueued message" if DEBUG ;
    $client->send_status_line ;
    $client->close ;
    redo LISTEN ;
  }

  print STDERR "httpd is being destroyed!\n" if DEBUG ;
}