#! perl -slw use strict; use Carp qw[ cluck croak ]; use threads; use threads::shared; use Thread::Queue; our $NICK ||= 'Me'; our $PEERHOST ||= 'localhost'; our $PEERPORT ||= '1080'; our $LOCALPORT ||= '1081'; our $DEBUG ||= 0; { no warnings; our $cluck; *cluck = sub () {} unless $DEBUG; } ## Allow the daemon thread to communicate with the interface thread. my $Q = new Thread::Queue; my $running : shared = 0; ## Start the daemon my $deamon = threads->new( \&httpd, $Q, \$running ); ## Start the UI my $UI = threads->new( \&ui, $Q, \$running ); ## Sleep until they are done sleep 1 until $running; sleep 1 while $running; exit; sub httpd { my( $Q, $runningRef ) = @_; { lock $$runningRef; $$runningRef++ } ## Setup daemon require CGI; require HTTP::Daemon; require HTTP::Status; my $httpd = HTTP::Daemon->new( LocalPort => $LOCALPORT, ReuseAddr => 1, ) or die "Cannot create an HTTP daemon"; $httpd->timeout( 2 ); ## Make sure the UI is running; sleep 1 until $$runningRef == 2; ## And do our thing until the UI goes away. while( $$runningRef == 2 ) { my $client = $httpd->accept or next; cluck "$NICK: Accepted"; my $request = $client->get_request; unless ( $request->method eq 'POST' and $request->url->path eq '/message' ) { cluck "$NICK: Rejected"; $client->send_error( RC_FORBIDDEN() ); $client->close; next; } my $q = CGI->new($request->content); my( $nick, $message ) = map{$q->param( $_ ) } qw[ nick message ]; cluck "$NICK: Queued '$nick:'$message'"; $Q->enqueue( "$nick says: $message\n" ); $client->send_status_line; $client->close; } { lock $$runningRef; $$runningRef-- } } sub ui { my( $Q, $runningRef ) = @_; { lock $$runningRef; $$runningRef++ } ## require LWP; my $ua = LWP::UserAgent->new or die "Cannot create an User Agent"; ## Build the UI require Tk; my $mw = MainWindow->new; $mw->title("ChatBG - $NICK chatting with $PEERHOST:$PEERPORT"); my $tbox = $mw->Scrolled( "Text", -width => 80, -height => 10,); $tbox->insert( 'end', "Listening on port $LOCALPORT\n" ); $tbox->configure( -state => 'disabled' ); $tbox->pack( -side => 'top', -expand => 1, -fill => 'x' ); my $etext = ""; my $ebox = $mw->Entry( -width => 70, -textvariable => \$etext ); $ebox->pack(-side => 'left', -expand => 1); my $bsend = $mw->Button( -text => 'Send', -command => sub { return unless length $etext; cluck "$NICK: Sending '$etext' to '$PEERHOST:$PEERPORT'"; $ua->post( "http://$PEERHOST:$PEERPORT/message", { nick => $NICK, message => $etext } ) or die "$!"; $etext = ''; } ); $bsend->pack( -side => 'right', -expand => 1, -fill => 'x' ); ## Make sure the deamon is running; sleep 1 until $$runningRef == 2; ## Arrange for the interface to be updated $mw->repeat( 100, sub { while( $Q->pending ) { $tbox->configure( -state => 'normal' ); $tbox->insert( 'end', $Q->dequeue ); $tbox->configure( -state => 'disabled' ); } } ); ## Run the insterface $mw->MainLoop; cluck "$NICK: MainLoop ended"; { lock $$runningRef; $$runningRef-- } }