Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine
 
PerlMonks  

Re^2: learning tk and threads: what do these errors mean?

by bronto (Priest)
on Jan 08, 2005 at 20:32 UTC ( #420587=note: print w/ replies, xml ) Need Help??


in reply to Re: learning tk and threads: what do these errors mean?
in thread learning tk and threads: what do these errors mean?

First of all, thanks a lot for your help. Starting from your suggestions about Thread::Queue, I modified my program and made it finally work, left apart that when I closed the window the httpd thread was abruptedly stopped

Just after a couple of minutes I finished making my script work, I read yours, and I subscribe to the point that threads and Tk can play nicely together. I then took the time to examine your code and see how I could stop the httpd thread more gently. After collecting some advice from you via /msg, here is the result.

#!/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 ; }

I hope that this work will help other people that start playing with threads and/or is trying to make threads and Tk play together

Ciao and thanks!
--bronto


In theory, there is no difference between theory and practice. In practice, there is.


Comment on Re^2: learning tk and threads: what do these errors mean?
Download Code

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://420587]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others studying the Monastery: (7)
As of 2015-07-29 10:01 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (263 votes), past polls