Non-Blocking Execution in Perl

XChat is not a threaded application and is event based, as such, running a process will block XChat until the process is returned, and XChat can continue on. Many people will attempt to get around this issue by using threads, but using threads without careful consideration may cause problems within XChat. As an example, the following code may be fairly straight forward, but has unintended consequences.

badscript.pl
use strict;
use warnings;
use Xchat qw(:all);
use threads;
 
register('stupid error demo', '001', 'bah, base test case');
 
hook_command('demoproblem', sub {
        threads->create(\&the_thread);
        return EAT_XCHAT;
});
 
sub the_thread {
        command('say george');
}
 
hook_print('Your Message', sub {
        if ($_[0][1] =~ m/hi/) {}
        return EAT_NONE;
});

[Get Code]

With this code, running /demoproblem will result in the following output:

 Use of uninitialized value in pattern match (m//) at /path/to/your/badscript.pl line 18.

<@testuser> george

This is because the contents of $_[0][1] has been messed with by the thread. While it may work fine in this specific case, imagine if more scripts catch Your Message. The error list may end up being quite long, for a single problem.

Additionally, if you attempt to change the context within the thread, you could very easily cause XChat to crash. This solution is not ideal.

One Solution - threads and threads::shared

One solution to this problem is using Perl's threads::shared module in conjunction with XChat's hook_timer. In this scenario, an array is kept with the results that XChat could deal with, as well as where to run these results. As long as all XChat specific code (such as emit_print, command, and get_list) is not done within the thread, XChat should be fine. If you do need access to things found in get_list, consider getting this information first, passing it to the thread, and only using the thread for process that would otherwise block XChat.

This code requires using newer versions of the threads and threads::shared modules. The newer modules are found starting in Perl 5.10.

noblock-thread-hook_timer.pl
use strict;
use warnings;
use Xchat qw(:all);
use threads;
use threads::shared;
 
register('No-block: thread & timer', '001', 'demonstrate using thread & timer for non blocking');
 
my @result_commands = ();
share(@result_commands);
my $active = 0;
share($active);
 
hook_command('noblock', sub {
        deal_with('george');
        deal_with('bob');
        return EAT_XCHAT;
});
 
# called by threads->create, this is where any commands should be done that
# would otherwise block XChat
# $_[0] will be the context to run the output in
# $_[1] will be the string to deal with
sub thread_command {
        # this sleep does absolutely nothing, just used for demonstration
        sleep 2;
 
        # For simplicity, keep track of the context and input, as thread_command
        # takes two parameters
        my ($context, $input) = @_;
 
        # shared is straight forward in Perl 5.10.1, but this method works in 5.10
        my $result = [];
        share($result);
        $result->[0] = $context;
        # Normally, something more interesting than just 'say' could be done to
        # modify the input, some command could be run and the result used, but
        # a demonstration is a demonstration
        $result->[1] = 'say '.$input;
 
        # add the results and where to send them to the results list
        push(@result_commands, $result);
 
        # Now done with this thread, decrement so hook_timer may stop if need be
        $active--;
}
 
sub deal_with {
        # only really need to start up a thread if $active was 0
        # dealing with it outside of the thread due to the checking against 1 later
        $active++;
 
        # create a thread which will do the provided command, but context
        # is used for where the result should be added
        threads->create(\&thread_command, get_context(), $_[0]);
 
        # if $active is 1, start a hook_timer to deal with the results, as one
        # wouldn't be running
        if ($active == 1) {
                # start a timer at .1 seconds
                hook_timer( 100,
                        sub {
                                # is there any thing waiting in @commands?
                                while (scalar @result_commands) {
                                        # remove first result, set context to it, and run command
                                        my $command = shift @result_commands;
                                        set_context($command->[0]);
                                        command($command->[1]);
                                }
                                # do we keep it or remove? if $active 0, we aren't expecting any
                                # more data, so we can remove it, otherwise, keep
                                if ($active == 0) {
                                        return REMOVE;
                                }
                                else {
                                        return KEEP;
                                }
                        }
                ); 
        }
}

[Get Code]

In this case, you can run /noblock multiple times in a row, on different contexts, and it will print the lines in the correct channel. Additionally, the problem listed at the top of the page with the "Use of uninitialized value" will not show up when hooking Your Message.

What does the code do? Parameters are passed to deal_with, which then increments a counter for lines that are dealt with. It then calls the thread creation, passing these parameters to the thread, and then decides if a timer is needed to look for results. This is determined by checking if $active is 1, which would happen on the first instance. If $active is more than 1, a hook_timer already would be running (in theory). When a thread completes, it decrements the shared variable. When the timer completes its execution that time, if the value of $active is 0, all of the active threads have completed, and XChat doesn't need to look for anymore commands to send, otherwise it continues.

Note that this code is just an example, and fairly specific to the task at hand. Normally code won't need to simply say two lines and go on. The 2 seconds of sleep would normally hang XChat until execution, but XChat is able to handle the sleep, and still allow messages to come in, and input to be added. Instead, running some other code that would block XChat execution (such as waiting for a process in back ticks or making a TCP connection) would be done inside of thread_command. Any command XChat should run (for display, or messaging a user) would be done in $result->[1].

Non-Blocking Execution in Perl

One Solution - threads and threads::shared

Other solutions - Using CPAN modules