deadpickle has asked for the wisdom of the Perl Monks concerning the following question:

I would like to create an IRC client in Gtk2. I based the code on a simple-bot example found at IRC hacks. So far the program connects to the server just fine, the problem I encounter is when the user closes the window. The program tends to hang and becomes non-responsive. I made an attempt to fix it but but I still cant find where it is hanging.
#!/usr/local/bin/perl -w use strict; use Gtk2 '-init'; use Glib qw/TRUE FALSE/; use threads; use threads::shared; use IO::Socket; #-------------------Shared Variables------------------- my $server:shared = "irc.freenode.net"; my $nick:shared = "simple_bot"; my $login:shared = "simple_bot"; my $channel:shared = "#GRRUVI"; my $die:shared = 0; ################################################# my $thread = threads->new( \&magic); ################################################# #-------------------Main Loop------------------- my $window = Gtk2::Window->new('toplevel'); $window->signal_connect( delete_event => sub { $die = 1; $thread->join; Gtk2->main_quit; }); $window->set_default_size( 300, 200 ); my $table = Gtk2::Table->new(2, 1, FALSE); my $scroller = Gtk2::ScrolledWindow->new; my $textview = Gtk2::TextView->new; my $entry = Gtk2::Entry->new; $scroller->add($textview); $table->attach_defaults($scroller, 0, 1, 0, 1); $table->attach_defaults($entry, 0, 1, 1, 2); $window->add($table); $window->show_all; Gtk2->main; ################################################# #-------------------IRC Thread------------------- sub magic { # Connect to the IRC server. my $sock = new IO::Socket::INET( PeerAddr => $server, PeerPort => 6667, Proto => 'tcp') or die "Can't connect\n"; # Log on to the server. print $sock "NICK $nick\r\n"; print $sock "USER $login 8 * :Perl IRC Hacks Robot\r\n"; # Read lines from the server until it tells us we have connected. while (my $input = <$sock>) { # Check the numerical responses from the server. if ($input =~ /004/) { # We are now logged in. last; } elsif ($input =~ /433/) { die "Nickname is already in use."; } } goto END if $die == 1; # Join the channel. print $sock "JOIN $channel\r\n"; # Keep reading lines from the server. while (my $input = <$sock>) { chop $input; if ($input =~ /^PING(.*)$/i) { # We must respond to PINGs to avoid being disconnected. print $sock "PONG $1\r\n"; } else { # Print the raw line received by the bot. print "$input\n"; } goto END if $die == 1; } END: undef $sock; } #################################################

Replies are listed 'Best First'.
Re: IRC Client (non-bot)
by pc88mxer (Vicar) on Feb 09, 2008 at 18:45 UTC
    Update: added Thread::Cancel solution.

    I haven't used threads in perl (gotta try it sometime), but I'll take a wild stab at this....

    okay, I've been playing with it, and determined that this is not a wild stab after all.

    I noticed that you are using blocking I/O in your thread. $thread->join merely waits for the thread to terminate. I think the thread is blocking on I/O and thus not noticing that $die = 1.

    As a quick fix, try sharing the thread's $sock variable, and adding close($sock) in your shutdown code (i.e. right after $die = 1;.) Basically, you have to find a way to wake up the thread from its I/O call. Another option is to send yourself a signal that is caught by the thread. Or, re-write your thread I/O to include a timeout so you can periodically check to see if it should exit.

    I'm sure there are cleaner ways to do this. Like I said, I really should check out perl threads.

    Update: The close($sock) probably won't work. If you don't care about cleanly shutting down the thread, just detach it and then call exit().

    Update: Check out Thread::Cancel. It uses a signal to cancel threads. Very handy!

Re: IRC Client (non-bot)
by Anonymous Monk on Feb 10, 2008 at 11:42 UTC
    What did you try to find out where the program is hanging? Try Devel::Trace
      Thanks for the replies. I think you are right in saying that the program is IO blocked. I think rewriting the program code to include a Glib::IO->add_watch might fix the problem. Devel::Trace is a very great tool thanks for sharing.
        OK. I added the IO watch but it gets hung up for some reason and stops receiving data and does not finish logging in. I cant seem to see where the problem is so heres the code:
        #!/usr/local/bin/perl -w use strict; use Gtk2 '-init'; use Glib qw/TRUE FALSE/; use IO::Socket; #-------------------Shared Variables------------------- my $server = "irc.freenode.net"; my $nick = "simple_bot"; my $login = "simple_bot"; my $channel = "#GRRUVI"; #-------------------Main Loop------------------- my $window = Gtk2::Window->new('toplevel'); $window->signal_connect( delete_event => sub { Gtk2->main_quit; }); $window->set_default_size( 300, 200 ); my $table = Gtk2::Table->new(2, 1, FALSE); my $scroller = Gtk2::ScrolledWindow->new; my $textview = Gtk2::TextView->new; my $entry = Gtk2::Entry->new; $scroller->add($textview); $table->attach_defaults($scroller, 0, 1, 0, 1); $table->attach_defaults($entry, 0, 1, 1, 2); $window->add($table); $window->show_all; # Connect to the IRC server. my $sock = new IO::Socket::INET( PeerAddr => $server, PeerPort => 6667, Proto => 'tcp' ) or die "Can't connect\n"; Glib::IO->add_watch( fileno $sock, [qw/in hup err/], \&incoming_data, +$sock ); # Log on to the server. print $sock "NICK $nick\r\n"; print $sock "USER $login 8 * :Perl IRC Hacks Robot\r\n"; Gtk2->main; #-------------------Incoming data------------------- sub incoming_data { my ( $fd, $condition, $fh ) = @_; if ( $condition eq 'in' ) { my $input = <$fh>; chop $input; # if ( defined $data ) { # # do something useful with the text. # my $buffer = $textview->get_buffer; # $buffer->insert( $buffer->get_end_iter, $data ); # } # Check the numerical responses from the server. if ($input =~ /004/) { # We are now logged in. # Join the channel. print $sock "JOIN $channel\r\n"; } elsif ($input =~ /433/) { die "Nickname is already in use."; } elsif ($input =~ /^PING(.*)$/i) { # We must respond to PINGs to avoid being disconnected. print $sock "PONG $1\r\n"; } else { # Print the raw line received by the bot. print "$input\n"; } } # if ( $condition >= 'hup' or $condition >= 'err' ) { # End Of File, Hang UP, or ERRor. that means # we're finished. # stop ability to send # $entry->set_editable(0); # $entry->signal_handler_block ($send_sig); # my $buffer = $textview->get_buffer; # $buffer->insert( $buffer->get_end_iter, "Server connection +lost !!\n" ); #close socket # $fh->close; # $fh = undef; #allow for new connection #$button->set_label('Connect'); #$button->set_sensitive(1); #$button->grab_focus; #Gtk2->main_iteration while Gtk2->events_pending; # } # if ($fh) { # the file handle is still open, so return TRUE to # stay installed and be called again. # print "still connected\n"; # possibly have a "connection alive" indicator # return TRUE; # } # else { # we're finished with this job. start another one, # if there are any, and uninstall ourselves. # return FALSE; # } }