Perl/Tk et les Threads

Multithreading dans les applications Perl/Tk : comment ne pas geler l'interface graphique quand une tâche dure longtemps.

2 commentaires

Article lu fois.

Les deux auteur et traducteur

Alexander Becker

Traducteur : djibril

L'article

Publié le 15 septembre 2014

Version PDF Version hors-ligne

ePub, Azw et Mobi

Liens sociaux

I. Attention à l'utilisation des threads avec Perl/Tk ▲

Tk n'est pas « thread-safe ». Dites-vous que vous ne pouvez pas contrôler les threads à partir de différents composants fils Tk. Mais ce n'est pas grave, tant que tout est marqué dans un seul thread. Les autres threads (travailleurs) ne pourront pas bloquer l'interface graphique.
Les threads travailleurs seront créés avant l'appel aux instructions Tk.
Tk utilise le thread principal, puis le contenu des variables qui ont été partagées entre les threads (variable partagée). Ces variables partagées sont utilisées dans les threads travailleurs et pour la communication (par exemple, pour le transfert de valeurs ou le contrôle de fils).
Pour le transfert continu de valeurs, une file d'attente pourra être utilisée. Ceci a l'avantage de vous permettre de passer au thread Tk, plus que le contenu de la simple scalaire (par exemple plusieurs lignes).
Les widgets Tk ne font jamais appel à des threads de travail ! Au lieu de cela, les variables partagées sont utilisées. Pour les lire, cela nécessite une minuterie (Tk::after ou Tk::repeat). Les options -textvariable - ne sont visibles que dans le thread Tk.

L'exemple suivant montre un programme Tk dans lequel tout le temps est géré dans un deuxième thread. Cela a généré des données qui sont présentées dans ce thread.

Sélectionnez

#!/usr/bin/perl -w
# source: http://www.perlmonks.org/?node_id=585533
# 2014-08-26
# Always use 'strict' and 'warnings'
use strict;
use warnings;

# Libraries
use threads;
use threads::shared;
use Thread::Queue;
use Tk;
use Tk::ROText;

# Globals
my $rotext                   = 0;                       # The Read-only text widget
my $n_lines_waiting : shared = 0;                       # Message passing between threads
my $p_queue                  = Thread::Queue->new();    # Construct message 'Queue'
####################
### Main program ###
####################
# Startup worker thread
my $gui_thr = threads->create( \&worker_thread );

# Only *now* is it safe to construct the GUI, from the parent thread
gui();
###################
### Subroutines ###
###################
# This subroutine is ONLY called from the parent thread
sub gui {
    my $mw  = MainWindow->new();
    my $top = $mw->Frame()->pack( -expand => 1, -fill => 'both' );
    my $bt  = $top->Button( -bg => 'skyblue', -text => "Exit" );
    $bt->configure( -command => sub { $mw->destroy() } );
    $rotext = $top->ROText( -bg => 'white' );
    $rotext->pack();
    $bt->pack();
    $mw->repeat( 1000 => \&main_loop );
    MainLoop;
}

sub main_loop {
    if ($n_lines_waiting) {
        fetch_worker_data();
    }
}

sub fetch_worker_data {
    for ( my $i = 0 ; $i < $n_lines_waiting ; $i++ ) {
        my $line = $p_queue->dequeue();
        $rotext->insert( "end", "$line\n" );
    }
    $rotext->insert( "end", "--- End of $n_lines_waiting line(s) ---\n" );
    $rotext->see("end");
    my $mw = $rotext->toplevel();
    $mw->update();
    $n_lines_waiting = 0;
}

# This subroutine is ONLY called in the worker thread
sub worker_thread {
    while (1) {
        sleep 3;
        worker_simulate_data();
    }
}

sub worker_simulate_data {
    my $nlines = int( rand(10) );
    ( $nlines > 0 ) or return;
    my $timestamp = localtime(time);
    for ( my $i = 0 ; $i < $nlines ; $i++ ) {
        my $idx  = $i + 1;
        my $line = "[$timestamp] Random line of text #$idx";
        $p_queue->enqueue($line);
    }
    $n_lines_waiting = $nlines;
}

II. Perl/Tk + Moose + Threads▲

L'exemple mentionné ci-dessus peut également être utilisé avec Moose :

Sélectionnez

#!perl
# based on: http://www.perlmonks.org/?node_id=585533
# 2014-08-26
package My::Test;
use Moose;

# Libraries
use threads;
use threads::shared;
use Thread::Queue;
use Tk;
use Tk::ROText;

# Globals
has 'rotext' => ( is => 'rw', isa => 'Tk::ROText' );
has 'n_lines_waiting' => (
    is      => 'rw',
    isa     => 'ScalarRef[Int]',
    default => sub {

        # Message passing between threads
        my $n_lines_waiting : shared = 0;
        return \$n_lines_waiting;
    }
);
has 'p_queue' => ( is => 'ro', isa => 'Thread::Queue', default => sub { return Thread::Queue->new(); } );
####################
### Main program ###
####################
sub run {
    my $self = shift;

    # Startup worker thread
    my $gui_thr = threads->create( sub { $self->worker_thread(); } );

    # Only *now* is it safe to construct the GUI, from the parent thread
    $self->gui();
}    # /run
###################
### Subroutines ###
###################
# This subroutine is ONLY called from the parent thread
sub gui {
    my $self = shift;
    my $mw   = MainWindow->new();
    my $top  = $mw->Frame()->pack( -expand => 1, -fill => 'both' );
    my $bt   = $top->Button( -bg => 'skyblue', -text => "Exit" );
    $bt->configure( -command => sub { $mw->destroy() } );
    $self->rotext( $top->ROText( -bg => 'white' ) );
    $self->rotext->pack();
    $bt->pack();
    $mw->repeat( 1000 => sub { $self->main_loop(); } );
    $mw->MainLoop;
}

sub main_loop {
    my $self = shift;
    print "n_lines_waiting in GUI thread is now: " . ${ $self->n_lines_waiting } . "\n";
    if ( ${ $self->n_lines_waiting } ) {
        $self->fetch_worker_data();
    }
}

sub fetch_worker_data {
    my $self   = shift;
    my $rotext = $self->rotext;
    for ( my $i = 0 ; $i < ${ $self->n_lines_waiting } ; $i++ ) {
        my $line = $self->p_queue->dequeue();
        $rotext->insert( "end", "$line\n" );
    }
    $rotext->insert( "end", "--- End of " . ${ $self->n_lines_waiting } . " line(s) ---\n" );
    $rotext->see("end");
    my $mw = $rotext->toplevel();
    $mw->update();
    ${ $self->n_lines_waiting } = 0;
}

# This subroutine is ONLY called in the worker thread
sub worker_thread {
    my $self = shift;
    while (1) {
        sleep 3;
        print "now worker_simulate_data()\n";
        $self->worker_simulate_data();
        print "n_lines_waiting in worker thread is now: " . ${ $self->n_lines_waiting } . "\n";
    }
}

sub worker_simulate_data {
    my $self   = shift;
    my $nlines = int( rand(10) );
    ( $nlines > 0 ) or return;
    my $timestamp = localtime(time);
    for ( my $i = 0 ; $i < $nlines ; $i++ ) {
        my $idx  = $i + 1;
        my $line = "[$timestamp] Random line of text #$idx";
        $self->p_queue->enqueue($line);
    }
    ${ $self->n_lines_waiting } = $nlines;
}
1;    # /My::Test
use strict;
use warnings;
my $app = My::Test->new;
$app->run;
exit(0);

III. Exécuter un thread par un clic bouton▲

Vous souhaitez peut-être juste commencer par une action avec un clic-bouton, qui peut vous informer qu'elle est prête à un clic d'un bouton. Ceci peut être réalisé par exemple par un travailleur qui n'effectue son travail que s'il reçoit le signal approprié avec une variable partagée. D'ailleurs, cette variable partagée dans le thread peut être déclarée lorsque la tâche est terminée.

Sélectionnez

#!perl
use strict;
use warnings;
use threads;
use threads::shared;
use Tk;
use Tk::After;
use Tk::ProgressBar;

# based on: http://gojooz.blogspot.de/2010/05/perl-tkx-thread-request-demo.html
# 2014-08-28
# Create shared variables
my $child_finished_flag : shared = 0;
my $child_request_flag : shared  = 0;

# Create child thread
my $ChildThread = threads->create( \&child_thread );
$ChildThread->detach();

# Create Tk mainwindow
my $mw = MainWindow->new();
my $frame2 = $mw->Frame( -borderwidth => 2 );
$frame2->pack( -anchor => 'nw', -padx => '10', -pady => '10' );

# create progressbar and button widgets
my $progressbar = $frame2->ProgressBar(
    -length => 200,
    -from   => 0,
    -to     => 10,
    -blocks => 10,
    -colors => [ 0, 'yellow', 9, 'green' ],
);
my $button = $frame2->Button(
    -text    => "Process Request",
    -state   => 'normal',
    -width   => '15',
    -command => sub {

        # only start once
        return if $child_request_flag;
        process_request();
    },
);
$button->grid(
    -row        => 1,
    -column     => 1,
    -columnspan => 2,
    -padx       => 10,
    -pady       => 5
);
$progressbar->grid(
    -row        => 2,
    -column     => 1,
    -columnspan => 2,
    -padx       => 10,
    -pady       => 5
);

# Initiate Tk Listener
$mw->MainLoop();

sub process_request {
    $progressbar->value(0);
    $child_request_flag = 1;
    &check_status_1;
}

sub check_status_1 {
    $mw->after(
        500,
        sub {
            if ( $child_finished_flag == 1 ) {
                $progressbar->value(100);

                # Reset flags
                $child_finished_flag = 0;
                $child_request_flag  = 0;
                print "child_request finished\n";
            }
            else {
                my $current_val = $progressbar->value();
                print "$current_val\n";
                $current_val = ( $current_val >= 9 ? 0 : ++$current_val );
                $progressbar->value($current_val);
                &check_status_2;
                print "child_request processing\n";
            }
        }
    );
}

sub check_status_2 {
    $mw->after(
        500,
        sub {
            &check_status_1;
        }
    );
}

sub child_thread {
    while (1) {
        sleep 2;
        if ( $child_request_flag == 1 ) {
            print "begin child_request\n";

            # long running task here
            for ( 1 .. 10 ) {
                print "long running task $_...\n";
                sleep(2);
            }
            $child_finished_flag = 1;
        }
        else {
            print "waiting for child_request\n";
        }
    }
}

IV. Sources▲

Basé sur perltk sur un thread… à PerlMonks, consulté le 26/08/2014.
Exemple de contrôle de fil via des variables partagées de Perl TKx demande de fil démo, accessible depuis le 28/08/2014.

Voici le tutoriel de référence qui est en allemand.

Vous avez aimé ce tutoriel ? Alors partagez-le en cliquant sur les boutons suivants :

Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright © 2014 Alexander Becker. Aucune reproduction, même partielle, ne peut être faite de ce site ni de l'ensemble de son contenu : textes, documents, images, etc. sans l'autorisation expresse de l'auteur. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.