home
zeus project page

Xchat & Perl/Tk HowTo

Background

While writing Zeus, I could not find any other examples of a xchat script utilizing a GUI interface through the use of Tk. Hopefully this document will save others from the countless hours and different attempts I tried until I found the successful solution.

The real "problem" with using Perl/Tk with xchat is that Perl/Tk requires a MainLoop function call that will hang xchat.

Failed Solutions

My first thought was to fork off a process right before the loop started so that the child could remain in the Tk loop while the parent handled the IRC events. This works, only it causes anomolous behaviour, including being able to unload and reload the script (or close the Tk window) without crashing xchat.

Final Solution

The best solution I've found is to have two separate scripts. One script to load with xchat, responsible for all the event loops etc and another script responsible for all the GUI (Perl/Tk) functionality.

The little gem that makes this possible is IPC::Shareable. With IPC::Shareable you are able to share a memory space between processes or programs. Here is a little example I wrote to test it out, note this doesn't use any Perl/Tk modules etc, check out Zeus to see exactly how you would do it with Tk (example mostly taken from the module page):
Script to load with xchat

#!/usr/bin/perl
                                                                                                                                                                                    
use IPC::Shareable;
                                                                                                                                                                                    
IRC::register("test_script", "1", "irc_shutdown", "");
                                                                                                                                                                                    
my $glue = 'data';
my %options = (
               create    => 'yes',
               exclusive => 0,
               mode      => 0644,
               destroy   => 'yes',
              );
my %colours;
tie %colours, 'IPC::Shareable', $glue, { %options } or
  die "server: tie failed\n";
%colours = (
            red => [
                    'fire truck',
                    'leaves in the fall',
                   ],
            blue => [
                     'sky',
                     'police cars',
                    ],
           );
((print "server: there are 2 colours\n"), sleep 5)

  while scalar keys %colours == 2;
print "server: here are all my colours:\n";
foreach my $c (keys %colours) {
  print "server: these are $c: ",
    join(', ', @{$colours{$c}}), "\n";
}
                                                                                                                                                                                    
                                                                                                                                                                                    
sub irc_shutdown {
  IPC::Shareable->clean_up_all;
}
GUI Script
#!/usr/bin/perl
                                                                                                                                                                                    
use strict;
use IPC::Shareable;
my $glue = 'data';
my %options = (
               create    => 0,
               exclusive => 0,
               mode      => 0644,
               destroy   => 0,
              );
Bmy %colours;
tie %colours, 'IPC::Shareable', $glue, { %options } or
     die "client: tie failed\n";
foreach my $c (keys %colours) {
     print "client: these are $c: ",
       join(', ', @{$colours{$c}}), "\n";
   }
delete $colours{'red'};
exit;

Ideas, bugs or suggestions?

Mail me, Jon Feldhammer, or join the mailing list and talk to the crowd! ;-)

zeus project page


This page is hosted by
SourceForge Logo