Perl и GUI. Работа с потоками

Я затрону весьма наболевшую тему, Perl + GUI + потоки.
Наболевшую, потому что попытка заставить работать ваше приложение с потоками может закончиться неудачей. Программа «виснет», «сегфолитится», Вы обратитесь к документации, увидете там, что библиотека не thread-safe. Потраченное время было коту под хвост?

Хинт: создать потоки до вызова Tkx::MainLoop, так как MainLoop() запускает свой цикл событий и блокирует выполнение кода. Было бы все так просто! Переписали Вы код с этим условием, а она все равно виснет…

Что же делать? Выход есть.
Нужно использовать модель Boss/Workers (Начальник и Работники) и очереди сообщений (Queue).

Цель: написать приложение с GUI и использовать многопоточность.
Давайте, рассмотрим задачу «на пальцах», представим все в виде абстрактной модели.

Есть склад. Вы приходите к начальнику (boss),
— Привет, соберите мне вот этот списочек…
— Окей, сейчас раскидаю задание по частям, работники (workers) все сделают.

Кладовщики задания берут из стопки (причем берут по порядку их поступления).

Подобную очередь реализует пакет Thread::Queue.

Мы будем использовать несколько методов
— enqueue — положить задание
— dequeue, dequeue_nb — взять задание

Разница между dequeue и dequeue_nb в том, что последний неблокирующийся.

Другими словами, когда мы вызываем dequeue, мы ждем пока задание не появится, и только тогда его получаем. А во втором случае, если задания нет — то возвращается undef.

while( defined( my $item = $queue->dequeue() ) ) {
  # выполняем какие-либо действия.
}

Кладовщики собрали весь необходимый товар, теперь его заберет грузчик, и Вам принесет.
…

Теперь приступим к реализации (упрощенный вариант).

Task -> Tk -> Boss -> Worker -> Result

#!/usr/bin/perl
use strict;

use Tkx; # тулкит

use threads; # работа с потоками
use Thread::Queue; # реализует очередь

# создаем очереди
my $queue_tk   = Thread::Queue->new(); # получаем задания из Tk
my $queue_job  = Thread::Queue->new(); # отправляем работникам
my $queue_box  = Thread::Queue->new(); # результаты

# босс
sub thread_boss {
    my $self = threads->self();
    my $tid  = $self->tid();
    
    while( defined( my $item = $queue_tk->dequeue() ) ) {
        print STDERR "Boss($tid) has received the task from Tk: $item\n";
        
        # отправляем задание на обработку работнику
        $queue_job->enqueue( $item );
    }
    
    $queue_job->enqueue( undef );
}

# работник(и)
sub thread_worker {
    my $self = threads->self();
    my $tid  = $self->tid();
    
    while( defined( my $job = $queue_job->dequeue() ) ) {
        print STDERR "Worker($tid) has received task from Boss: $job\n";
        
        # выполняем какую-нибудь работу...
        print STDERR "Worker($tid) has finished the task\n";
        
        # скидываем все в од��у коробку ;)
        $queue_box->enqueue( "processed: $job" );
    }

    $queue_box->enqueue( undef );    
}
    
# создаем потоки
my $boss   = threads->new( \&thread_boss );
my $worker = threads->new( \&thread_worker );


# Создаем UI
my $main_window = Tkx::widget->new( '.' );
my $frame = $main_window->new_ttk__frame( -padding => q/10 10 10 10/ );
$frame->g_grid();

my $label = $frame->new_ttk__label( -text => 'waiting' );
$label->g_grid( -row => 0, -column => 0, -columnspan => 2 );

# поле для ввода
my $entry_data = 'enter data here';
my $entry = $frame->new_ttk__entry( -textvariable => \$entry_data );

my $button = $frame->new_ttk__button(
    -text => 'Send to Boss',
    -command => sub {
        $queue_tk->enqueue( $entry_data );
    },
);

$entry->g_grid( -row => 1, -column => 0 );
$button->g_grid( -row => 1, -column => 1 );

# обработчик события WM_DELETE_WINDOW
sub on_destroy {
    my $mw = shift;

    # отсылаем очереди undef, что завершит потоки
    $queue_tk->enqueue( undef );
    $queue_box->enqueue( 'finish' );

    # Destroy
    # или Tkx::destroy( '.' )
    $mw->g_destroy();
}

$main_window->g_wm_protocol( 'WM_DELETE_WINDOW', [\&on_destroy, $main_window] );

# обрабатываем результат
sub monitor {
    my $status_lbl = shift;
    my $result = $queue_box->dequeue_nb;    

    if( $result ne 'finish' ) {
        if( defined $result ) {
            $label->configure( -text => "job completed: ".scalar(localtime));
        }
            
        Tkx::after( 1000, [\&monitor, $label]);
    }
    
}

# запускаем мониторинг
Tkx::after( 100, [\&monitor, $label] );

# открепляем потоки
# иначе при завершении программы, у нас будут предупреждения
# Perl exited with active threads:
#        2 running and unjoined
#        0 finished and unjoined
#        0 running and detached
$boss->detach();
$worker->detach();

Tkx::MainLoop();

Если Вы планируете писать многопоточную программу для работы с сетью, базами данных, то я думаю что вместо стандартных потоков, гораздо правильней будет использовать POE (событийная машина, non-blocking sockets).

Пока это черновой вариант, будет дополняться.