Multithreading

[Dan Lyke <danlyke flutterby com>]

Dan Lyke writes:
> As someone who has done a *lot* of threading stuff, albeit not in GUI
> type applications (a big XML based distributed database system), is
> there any reason you're averse to forking and using processes?

It turns out that I think I misunderstood what Jens was really
looking for. If I'm understanding this right, Jens wants multiple
independent windows running in the same program, and for that, rather
than worrying about separate processes, he should just create new top
level windows, keep track of them, and only call Gtk2->main_quit when
the last one has been destroyed.

However, I hadn't yet written the background processing portions of
the app I'm playing with, and this seemed like a good time to do some
example code. I have a bunch of processes that the user shouldn't wait
for, like image rotation in a photo album, or uploading. So given that
the best documentation seems to be list archives, here's a quick "how
to fork a process that does stuff and deal with it in your main loop"
example. This is exactly what Gtk2::Helper was created for, just
spelled out rather pedantically.

No guarantees of portability to Win32, I do that stuff for a living
(struggled with stupid .NET revision incompatibilities for hours
yesterday) and subject myself to it as little as possible in my
off-hours.

So: a little app that lets you start processes, each process sends
messages back to the parent at 1 second intervals, the parent reads
'em and displays them in a label. Obviously you could also modify this
to use IPC::Open3 to talk to STDIN, STDOUT and STDERR of any spawned
program.

Dan


#!/usr/bin/perl -w
use strict;
use Socket;
use Gtk2 -init;
use Gtk2::Helper;
use FileHandle;
use POSIX;

# How many lines we want to present in the label
my $messagelines = 8;
my (@messages,%helperTag);
push @messages,'' foreach (1..$messagelines);


# Create the windows
my $window = Gtk2::Window->new('toplevel');
my $box = Gtk2::VBox->new;
my $label = Gtk2::Label->new (join("\n", @messages));
my $buttonQuit = Gtk2::Button->new('Quit');
my $buttonStart = Gtk2::Button->new('Start');

$window->add ($box);
$box->add ($label);
$box->add($buttonQuit);
$box->add($buttonStart);

# Just pops the top line off the message queue and adds the arguments
# to the last line.

sub add_message_line
{
    foreach (@_)
    {
        shift @messages;
        push @messages, $_;
        $label->set_text(join("\n", @messages));
    }
}

# Process the exit of the child. If you were doing something useful,
# you might keep things like information about what data needs
# to be reloaded when a child process exits.

sub sig_child 
{
    my $pid = wait;
    if ($pid >= 0)
    {
        Gtk2::Helper->remove_watch($helperTag{$pid});
        delete $helperTag{$pid};
        add_message_line("Finished $pid");  
    }
}

$SIG{CHLD} = \&sig_child;

sub start_process
{
    my $pid;

    my ($reader, $writer);
    $reader = FileHandle->new;
    $writer = FileHandle->new;
    socketpair($reader, $writer,  AF_UNIX, SOCK_STREAM, PF_UNSPEC);

    $pid = fork();

    if ($pid)
    {
        # We're still in the parent, set up to watch the streams:

        shutdown($writer, 0);
        $helperTag{$pid} = Gtk2::Helper->add_watch($reader->fileno(), 'in',
                                                   sub {
                                                       my $line = <$reader>;
                                                       chop $line;
                                                       shift @messages;
                                                       push @messages, $line;
                                                       $label->set_text(join("\n", @messages));
                                                       return 1;
                                                   }, 1);
        add_message_line("Started process $pid");
    }
    else
    {
        # We're in the child. Do whatever processes we need to. We *must*
        # exit this process with POSIX::_exit(...), because exit() would
        # "clean up" open file handles, including our display connection,
        # and merely returning from this subroutine in a separate process
        # would *really* confuse things.

        shutdown($reader, 1);
        $pid = getpid();
        my ($i);
        for ($i = 0; $i < $messagelines * 2; $i++)
        {
            sleep(1);
            $writer->write("$pid Line $i\n");
            $writer->flush;
        }
        POSIX::_exit(0);
    }
}


# We should clean up after ourselves so that we don't
# leave dead processes flying around.
sub on_quit_clicked
{
    # 15 = SIGTERM
    kill 15, $_ foreach (keys %helperTag);
    Gtk2->main_quit;
}


# We should also link this to the destroy message on the main window,
# this is just quick and dirty
$buttonQuit->signal_connect(clicked => \&on_quit_clicked);
$buttonStart->signal_connect(clicked => \&start_process);
$window->show_all;
Gtk2->main;