Applications multi threading avec Perl/Tk

Voici le code qui permet de réaliser ce que l'on souhaite. C'est à dire afficher l'heure instantanément et avoir 3 boutons nous permettant de changer l'affichage de l'heure et de lister un répertoire.

#!/usr/bin/perl
#==========================================================================
# Auteur : djibril
# But    : Script Perl/Tk pour afficher l'heure, lister un répertoire
#==========================================================================
 
use warnings;
use strict;
 
use Tk;
 
# Creation du widget principal 
my $WidgetPrincipal = new MainWindow(
  -title      => "Tk, Thread ou ProgressBar",
  -background => "white",
);
$WidgetPrincipal->minsize( 800, 200 );
 
my $Message = "rien";
my $Heure = "L'heure";
my $FormatHeure = 0;
 
# Label qui affichera l'heure
$WidgetPrincipal->Label(
  -textvariable => \$Heure,
  -background => "white",
)->pack( qw / -fill both -expand 1/ );
 
 
# Frame pour les boutons
my $FrameBouton = $WidgetPrincipal->Frame(
  -background => "white",  
)->pack();
$FrameBouton->Button(
  -text => "Fermer",
  -command => sub { exit; },
)->grid( -row => 0, -column => 0, -padx => 10, -pady => 10, -sticky => "nsew" );
$FrameBouton->Button(
  -text => "Changer format de l'heure",
  -command => sub { 
    if ( $FormatHeure == 0 ) {
          $FormatHeure = 1;
    }    
    else {
      $FormatHeure = 0;
    }
  },
)->grid( -row => 0, -column => 1, -padx => 10, -pady => 10, -sticky => "nsew" );
$FrameBouton->Button(
  -text => "Lister des fichiers",
  -command => sub { 
    # Selectionner un répertoire
    my $Directory = $WidgetPrincipal->chooseDirectory(
    -title      => "Selection d'un repertoire",
    -mustexist  => 1,
    );    
 
    if ( $Directory) {
      $Message = "Listings des fichiers en cours";
      ListerFichiers($Directory);
      $Message = "Listings des fichiers fini";
    }
  },
)->grid( -row => 0, -column => 2, -padx => 10, -pady => 10, -sticky => "nsew" );
 
# Label qui affichera l'etat 
$WidgetPrincipal->Label(
  -textvariable => \$Message,
  -background => "#FFE0D0",
  -relief     => "groove",
)->pack( qw / -side bottom -fill x -expand 0/ );
 
# Pocedure pour afficher l'heure
$WidgetPrincipal->repeat( 1000, \&AfficherHeure );
 
 
MainLoop();
 
 
sub AfficherHeure {
    # heure
    my ( $Second, $Minute,  $Hour,    $Day, $Month,
         $Year,   $DayWeek, $DayYear, $HourWinterOrSummer
    ) = localtime(time);
  $Month = $Month + 1;
  $Year = $Year + 1900;
    foreach ( $Second, $Minute,  $Hour,    $Day, $Month,
         $Year,   $DayWeek, $DayYear, $HourWinterOrSummer ) {
      s/^(\d)$/0$1/;
    }
 
    if ( $FormatHeure == 0 ) {
      $Heure = "($Day-$Month-$Year) $Hour"."::".$Minute."::".$Second;
    }
    else {
      $Heure = "$Hour"."::".$Minute."::"."$Second ($Day-$Month-$Year)";
    }
}
 
#======================================================
# Nombre d'arguments : 1
# Argument(s)        : un répertoire ($repertoire)
# Retourne           : Tableau de fichier (@fichiers)
#======================================================
sub ListerFichiers {
  my ( $repertoire ) = @_;
  my @fichiers;
 
  # Ouverture d'un répertoire
  opendir (my $FhRep, $repertoire) 
    or warn "impossible d'ouvrir le répertoire $repertoire\n" and return;
 
  # Liste fichiers et répertoire sauf (. et ..)
  my @Contenu = grep { !/^\.\.?$/ } readdir($FhRep);
 
  # Fermeture du répertoire
  closedir ($FhRep);
 
  # On récupère tous les fichiers
  foreach my $nom ( @Contenu ) {
    # Fichiers
    if ( -f "$repertoire/$nom") {
      push ( @fichiers, "$repertoire/$nom" );  
      print "$repertoire/$nom\n";
    }
    # Repertoires
    elsif ( -d "$repertoire/$nom") {
      # recursivité
      push ( @fichiers, ListerFichiers("$repertoire/$nom") );
    }
  }
 
  return @fichiers;
}

Si vous exécutez ce script, vous aurez ceci :



Vous remarquerez que l'heure s'affiche toutes les secondes. Si vous cliquez sur le bouton "changer format…", l'affichage de l'heure sera modifié. Si vous cliquez sur "Lister fichier", vous devrez sélectionner un répertoire; tous ces fichiers seront listés.

Le script est ScriptBasique (téléchargeable dans la section "Téléchargement des scripts").

Si vous listez un répertoire qui contient beaucoup de sous-répertoires et fichiers, vous remarquerez que la fenêtre Tk reste figée tout le temps du listing. De plus, l'heure ne bouge plus. Nous verrons comment palier à ce problème.

Si l'on souhaite connaître la progression du listing des fichiers, comment peut-on le faire ? Faut-il afficher les noms des fichiers dans la fenêtre Tk au fur et à mesure ? Comment faire une belle barre de progression ? Pour cela, nous utiliserons un module Tk qui est prêt à l'emploi et simple d'utilisation (Tk::ProgressBarTk::ProgressBar).

Si la méthode de listing provient d'un module externe, comment peut-on l'utiliser sans que la fenêtre ne reste figée ? C'est là qu'intervient la notion de threads (module threadsthreads).

Un thread en français signifie processus légerprocessus léger. C'est un composant du processus principal (votre script). Chaque thread se partage la mémoire virtuelle du processus mais possède sa propre pile d'appel (structure de données). Celui qui utilise des threads a donc l'impression que ces derniers travaillent en parallèle.

Il est important de ne pas confondre processus légers et multitâche dont le principe est plutôt d'utiliser des processus différents.

Pour plus d'information sur la notion de processus léger, voir la section liens utiles.

Pour la suite de cet article, vous devez installer les modules threads et threads::shared. Ces modules font normalement déjà partis du CORE de Perl, mais la version présente n'est pas à jour et il se peut que certaines méthodes utilisées dans cet article ne fonctionnent pas. Je vous recommande donc de les installer.

Voici un script Perl (non Tk) qui vous permet de créer plusieurs threads. Il a pour but de créer 10 threads qui afficheront 2 lignes.

#!/usr/bin/perl
#==========================================================================
# Auteur : djibril
# But    : Exemple de threads
#==========================================================================
use warnings;
use strict;
 
use threads;
 
my @StocageThreads;
# Création de 10 threads.
for ( 0 .. 9 ) {
  $StocageThreads[$_] = threads->create( \&fun, $_ );
}
 
print "Threads crees, passons a autre chose!\n";
sleep 2;
print "Allons recuperer nos valeurs de retours...\n";
 
for ( 0 .. 9 ) {
 print "thread num $_  est termine et nous retourne la valeur : " 
   . $StocageThreads[$_]->join() . "\n";
}
 
sub fun {
  my $number = shift;
  print "Bonjour, je suis le thread num : $number\n";
  print "Mon id est : " . threads->tid() . "\n";
  sleep 2;
  print "le thread num $number meurs\n";
 
  return threads->tid();
}

Bonjour, je suis le thread num : 0
Mon id est : 1
Bonjour, je suis le thread num : 1
Mon id est : 2
Bonjour, je suis le thread num : 2
Mon id est : 3
Bonjour, je suis le thread num : 3
Mon id est : 4
Bonjour, je suis le thread num : 4
Mon id est : 5
Bonjour, je suis le thread num : 5
Mon id est : 6
Bonjour, je suis le thread num : 6
Mon id est : 7
Bonjour, je suis le thread num : 7
Mon id est : 8
Threads crees, passons a autre chose!
Bonjour, je suis le thread num : 8
Mon id est : 9
Bonjour, je suis le thread num : 9
Mon id est : 10
le thread num 0 meurs
le thread num 1 meurs
le thread num 2 meurs
le thread num 3 meurs
le thread num 4 meurs
le thread num 5 meurs
le thread num 6 meurs
le thread num 7 meurs
Allons recuperer nos valeurs de retours...
thread num 0  est termine et nous retourne la valeur : 1
thread num 1  est termine et nous retourne la valeur : 2
le thread num 8 meurs
le thread num 9 meurs
thread num 2  est termine et nous retourne la valeur : 3
thread num 3  est termine et nous retourne la valeur : 4
thread num 4  est termine et nous retourne la valeur : 5
thread num 5  est termine et nous retourne la valeur : 6
thread num 6  est termine et nous retourne la valeur : 7
thread num 7  est termine et nous retourne la valeur : 8
thread num 8  est termine et nous retourne la valeur : 9
thread num 9  est termine et nous retourne la valeur : 10

Vous remarquez qu'on a créé 10 threads qui se sont exécutés en même temps. C'est la raison pour laquelle les messages sont affichés dans un ordre aléatoire.
Le code ci-dessous nous permet de créer un thread et de le stocker (l'objet) dans un tableau.

$StocageThreads[$_] = threads->create( \&fun, $_ );

La méthode tid nous retourne le numéro id du thread. La méthode join permet d'attendre que le thread se termine, de le nettoyer et de retourner les valeurs de la procédure lancée dans le thread (notamment &fun dans notre exemple). Si vous ne souhaitez pas récupérer la/les valeur(s) de retour de join, utilisez la méthode detach qui prend moins de ressources et détache votre script du thread. Celui sera nettoyé proprement par Perl une fois qu'il sera terminé.

Lisez les documentations de la section liens utiles, il est très important de maîtriser un minimum les threads pour la suite de cet article.

Il est également impératif de comprendre comment partager des données entre le script Perl et ses threads, c'est important pour la suite. Nous utilisons le module threads::shared.

Voici un exemple provenant du site enstimac, suivi de ces explications (lien dans la section liens utiles).

use threads;
use threads::shared;
 
my $toto : shared = 1;
my $tata = 1;
threads->new(sub { $toto++; $tata++ })->join;
 
print "$toto\n"; # affiche 2 car $toto est partagé
print "$tata\n"; # affiche 1 car $tata n'est pas partagé

Dans le cas d'un tableau partagé, tous les éléments du tableau sont partagés, et pour une table de hachage partagée, toutes les clés et les valeurs sont partagées. Cela place des restrictions sur ce qui peut être affecté à des éléments de tableaux et de tables de hachage partagés : seules des valeurs simples ou des références à des variables partagées sont autorisées - de façon à ce qu'une variable privée ne puisse accidentellement devenir partagée. Une affectation incorrecte entraîne la mort du thread (die). Par exemple :

use threads;
use threads::shared;
 
my $var = 1;
my $svar : shared = 2;
my %hash : shared;
 
... créer quelques threads ...
 
$hash{a} = 1;      # pour tous les threads, exists($hash{a}) et $hash{a} == 1
$hash{a} = $var;   # ok - copie par valeur : même effet que précédemment
$hash{a} = $svar;  # ok - copie par valeur : même effet que précédemment
$hash{a} = \$svar; # ok - référence à une variable partagée
$hash{a} = \$var;  # entraîne la terminaison (I<die>)
delete $hash{a};   # ok - pour tous les threads, !exists($hash{a})

Le but de cet article n'est pas de vous faire un cours sur Perl et les threads, mais de vous exposer une méthode pour utiliser les threads avec Perl Tk. Lisez donc les documentations CPAN et cours enstimac pour une meilleure compréhension. Pour la suite de cet article, je considère que vous avez de bonnes notions sur les modules utilisés. De toute façon, les codes seront expliqués afin que vous puissiez les adapter à vos besoins.

Le script est ExempleThreads (téléchargeable dans la section "Téléchargement des scripts").

3-a. Avantages et inconvénients▲

3-b. Erreurs courantes▲

#!/usr/bin/perl
#==========================================================================
# Auteur : djibril
# But    : Script Perl/Tk pour afficher l'heure, lister un répertoire
#          ATTENTION : A ne pas faire
#==========================================================================
 
use warnings;
use strict;
 
use Tk;
use threads;
 
# Creation du widget principal 
my $WidgetPrincipal = new MainWindow(
  -title      => "Tk, Thread ou ProgressBar",
  -background => "white",
);
$WidgetPrincipal->minsize( 800, 200 );
 
 
my $Message = "rien";
my $Heure = "L'heure";
my $FormatHeure = 0;
 
# Label qui affichera l'heure
$WidgetPrincipal->Label(
  -textvariable => \$Heure,
  -background => "white",
)->pack( qw / -fill both -expand 1/ );
 
 
# Frame pour les boutons
my $FrameBouton = $WidgetPrincipal->Frame(
  -background => "white",  
)->pack();
$FrameBouton->Button(
  -text => "Fermer",
  -command => sub { exit; },
)->grid( -row => 0, -column => 0, -padx => 10, -pady => 10, -sticky => "nsew" );
$FrameBouton->Button(
  -text => "Changer format de l'heure",
  -command => sub { 
    if ( $FormatHeure == 0 ) {
          $FormatHeure = 1;
    }    
    else {
      $FormatHeure = 0;
    }
  },
)->grid( -row => 0, -column => 1, -padx => 10, -pady => 10, -sticky => "nsew" );
$FrameBouton->Button(
  -text => "Lister des fichiers",
  -command => sub { 
    # Selectionner un répertoire
    my $Directory = $WidgetPrincipal->chooseDirectory(
    -title      => "Selection d'un repertoire",
    -mustexist  => 1,
    );    
 
    if ( $Directory) {
      # Creation du thread
      $Message = "Creation du thread et Listings des fichiers en cours";
      $WidgetPrincipal->update;
      my $Thread = threads->create( \&ListerFichiers, $Directory );
      $Thread->detach();
      #$Thread->join();
      $Message = "Listings des fichiers fini";
      $WidgetPrincipal->update;
    }
  },
)->grid( -row => 0, -column => 2, -padx => 10, -pady => 10, -sticky => "nsew" );
 
# Label qui affichera l'etat 
$WidgetPrincipal->Label(
  -textvariable => \$Message,
  -background => "#FFE0D0",
  -relief     => "groove",
)->pack( qw / -side bottom -fill x -expand 0/ );
 
# Pocedure pour afficher l'heure
$WidgetPrincipal->repeat( 1000, \&AfficherHeure );
 
 
MainLoop();
 
 
sub AfficherHeure {
    # heure
    my ( $Second, $Minute,  $Hour,    $Day, $Month,
         $Year,   $DayWeek, $DayYear, $HourWinterOrSummer
    ) = localtime(time);
  $Month = $Month + 1;
  $Year = $Year + 1900;
    foreach ( $Second, $Minute,  $Hour,    $Day, $Month,
         $Year,   $DayWeek, $DayYear, $HourWinterOrSummer ) {
      s/^(\d)$/0$1/;
    }
 
    if ( $FormatHeure == 0 ) {
      $Heure = "($Day-$Month-$Year) $Hour"."::".$Minute."::".$Second;
    }
    else {
      $Heure = "$Hour"."::".$Minute."::"."$Second ($Day-$Month-$Year)";
    }
}
 
#======================================================
# Nombre d'arguments : 1
# Argument(s)        : un répertoire ($repertoire)
# Retourne           : Tableau de fichier (@fichiers)
#======================================================
sub ListerFichiers {
  my ( $repertoire ) = @_;
  my @fichiers;
 
  # Ouverture d'un répertoire
  opendir (my $FhRep, $repertoire) 
    or warn "impossible d'ouvrir le répertoire $repertoire\n" and return;
 
  # Liste fichiers et répertoire sauf (. et ..)
  my @Contenu = grep { !/^\.\.?$/ } readdir($FhRep);
 
  # Fermeture du répertoire
  closedir ($FhRep);
 
  # On récupère tous les fichiers
  foreach my $nom ( @Contenu ) {
    # Fichiers
    if ( -f "$repertoire/$nom") {
      push ( @fichiers, "$repertoire/$nom" );  
      $Message = "$repertoire/$nom";  # <=== modification
      print "$repertoire/$nom\n";
 
    }
    # Repertoires
    elsif ( -d "$repertoire/$nom") {
      # recursivité
      push ( @fichiers, ListerFichiers("$repertoire/$nom") );
    }
  }
 
  return @fichiers;
}

my $Thread = threads->create( \&ListerFichiers, $Directory );
$Thread->detach();

J'espère que vous n'êtes pas fatigué !! Après tous ces paragraphes et exemples de codes, nous allons enfin voir comment créer proprement des threads en Perl/Tk !

Vous devez vous mettre en tête ceci :

1. On doit créer nos threads en début de script avant même d'écrire du code Tk.
2. On ne doit pas faire appel à du code Perl Tk dans les procédures que l'on souhaite utiliser dans nos threads.

Je vais vous exposer le concept de notre script.

Nous allons créer un thread qui tournera en tâche de fond. Son but sera de dormir si on ne lui demande rien ou de travailler si on le met à contribution. Pour lui dire de travailler, on lui enverra un signal qu'il interceptera. Ce signal mentionne la procédure à appeler et on récupére le résultat de notre procédure.

Pour commencer, faisons appel aux modules dont on aura besoin.

#!/usr/bin/perl
#==========================================================================
# Auteur : djibril
# But    : Script Perl/Tk pour afficher l'heure, lister un répertoire
#          en utilisant des threads de façon propre
#==========================================================================
 
use warnings;
use strict;
 
use Tk;                         # Pour créer notre GUI
use threads;                    # Pour créer nos threads
use threads::shared;            # Pour partager nos données entre threads
use Time::HiRes qw( sleep );    # Pour faire des sleeps < à une seconde

Créons un hash dans lequel on mentionne les fonctions à appeler dans notre thread. Ce hash a en clé le nom de la fonction et en valeur la référence à la procédure.

# Contient les fonctions à appeler dans le thread si besoin
my %LesFonctionsALancerDansThread = ( "ListerFichiers" => \&ListerFichiers, );

Ce hash est visible dans notre thread car il a été déclaré avant même la création du thread.

Déclarons maintenant les variables qui seront partagées entre le thread et le thread principal (le script) :

#===================================
# Threads et variables partagées
#==================================
my $TuerThread : shared;          # Permet de tuer le thread proprement
my $NomFonction : shared;         # Contient le nom de la fonction à appeler
my $ThreadTravail : shared;       # Contient la valeur permettant au thread de lancer une procédure
my @ArgumentsThread : shared;     # Contient les arguements à passer à une éventuelle procédure
my @ResultatFonction : shared;    # Contient le résultat des fonctions lancées dans le thread
 
$ThreadTravail = 0;               # 0 : thread ne fait rien, 1 : il bosse
$TuerThread    = 0;               # 0 : thread en vie, 1 : thread se termine

Nous avons choisi de partager 5 variables.

$TuerThread contient la valeur 0 ou 1. C'est ainsi que l'on demande au thread de mourir ou non.
$NomFonction contient le nom de la fonction que l'on souhaite appeler dans notre thread (grâce aux hash %LesFonctionsALancerDansThread).
$ThreadTravail contient la valeur 0 ou 1. C'est ainsi que l'on demande au thread de lancer une procédure ou de dormir.
@ArgumentsThread contient les arguments que l'on souhaite passer aux procédures lancées dans le thread.
@ResultatFonction contient les résultats de la procédure lancée dans le thread.

Ne vous inquiétez pas si cela reste ambigu pour l'instant, tout sera clarifié avec la suite du code!

Créons maintenant notre thread.

# Création du thread
my $Thread = threads->create( \&NotreThreadUnique );

Il reste la procédure NotreThreadUnique à concevoir !

#================================================
# NotreThreadUnique
#================================================
sub NotreThreadUnique {
 
  # Tourne en rond
  while (1) {
 
    # demande au thread de travailler
    if ( $ThreadTravail == 1 ) {
 
      # Lance la procédure
      $LesFonctionsALancerDansThread{$NomFonction}->(@ArgumentsThread);
 
      # demande au thread de dormir
      $ThreadTravail = 0;
    }
 
    # Terminer le thread
    last if ( $TuerThread == 1 );
 
    sleep 0.5;
  }
  return;
}

Explication :

Dans notre procédure, nous avons fait une boucle while infinie qui permet au thread de ne jamais mourir sauf si on le lui demande. Dans un premier temps, le thread vérifie si la variable $ThreadTravail est à 1. Si c'est le cas, cela signifie qu'on a demandé au thread de lancer une procédure (on verra plus tard comment on s'y prend). Dans le cas contraire, on vérifie si le thread doit mourir ou dormir pendant une demie seconde.

Maintenant que nos variables sont déclarées et partagées, et notre thread créé, passons au Perl Tk.

#===================================
# Debut du code principal Perl Tk
#==================================
# Creation du widget principal
my $WidgetPrincipal = new MainWindow(
  -title      => "Perl/Tk et les threads",
  -background => "white",
);
$WidgetPrincipal->minsize( 800, 200 );
 
my $Message     = "rien";       # Texte qui changera dans le label
my $Heure       = "L'heure";    # Heure à afficher
my $FormatHeure = 0;            # Format de l'heure
 
# Label qui affichera l'heure
my $LabelHeure = $WidgetPrincipal->Label(
  -textvariable => \$Heure,
  -background   => "white",
)->pack(qw / -fill both -expand 1/);
 
# Frame pour les boutons
my $FrameBouton = $WidgetPrincipal->Frame( -background => "white", )->pack();
 
my $BoutonFermer = $FrameBouton->Button(
  -text    => "Fermer",
  -command => [ \&Fermer, $Thread ],
  )->grid(
  -row    => 0,
  -column => 0,
  -padx   => 10,
  -pady   => 10,
  -sticky => "nsew"
  );
 
my $BoutonChangerFormatHeure = $FrameBouton->Button(
  -text    => "Changer format de l'heure",
  -command => sub {
    if ( $FormatHeure == 0 ) {
      $FormatHeure = 1;
    }
    else {
      $FormatHeure = 0;
    }
  },
  )->grid(
  -row    => 0,
  -column => 1,
  -padx   => 10,
  -pady   => 10,
  -sticky => "nsew"
  );
 
my $BoutonListerFichier = $FrameBouton->Button(
  -text    => "Lister des fichiers",
  -command => \&ListerFichiersTk,
  )->grid(
  -row    => 0,
  -column => 2,
  -padx   => 10,
  -pady   => 10,
  -sticky => "nsew"
  );
 
# Label qui affichera l'etat
my $LabelMessage = $WidgetPrincipal->Label(
  -textvariable => \$Message,
  -background   => "#FFE0D0",
  -relief       => "groove",
)->pack(qw / -side bottom -fill x -expand 0/);
 
# Pocedure pour afficher l'heure
$WidgetPrincipal->repeat( 1000, \&AfficherHeure );
 
MainLoop();

Nous créons notre fenêtre Tk avec une taille minimum (minsize), puis nous déclarons 3 variables.
$Message et $Heure servent aux labels et sont modifiées régulièrement. $FormatHeure nous permet de définir le type de format de l'heure à afficher. Nous créons ensuite notre label pour l'heure et un cadre pour accueillir les 3 boutons. Pour terminer, nous créons un dernier label qui est en bas de la fenêtre. Nous lançons la procédure "AfficherHeure" toutes les secondes via la méthode Perl Tk repeat.

Le bouton "Fermer" permet de détruire le script proprement. Il appelle la procédure "Fermer" qui demande au thread de se terminer, puis détruit le script.

sub Fermer {
  # Demande au thread de se terminer
  $TuerThread = 1;
  # On attends que le thread se termine proprement
  $Thread->detach();
 
  exit;
 
  return;
}

Le bouton "Changer format de l'heure" permet juste de positionner la variable $FormatHeure à 1 ou à 0. Comme la procédure "AfficherHeure" est lancée toutes les secondes, en fonction de $FormatHeure, l'affichage sera différent.

sub AfficherHeure {
 
  # récupérons la date et l'heure
  my ( $Second, $Minute, $Hour, $Day, $Month, $Year, $DayWeek, $DayYear, $HourWinterOrSummer )
    = localtime(time);
 
  $Month = $Month + 1;
  $Year = $Year + 1900;
 
  foreach ( $Second, $Minute, $Hour, $Day, $Month ) {
    s/^(\d)$/0$1/;
  }
 
  # format 1
  if ( $FormatHeure == 0 ) {
    $Heure = "($Day-$Month-$Year) $Hour" . "::" . $Minute . "::" . $Second;
  }
  # format 2
  else {
    $Heure = "$Hour" . "::" . $Minute . "::" . "$Second ($Day-$Month-$Year)";
  }
 
  return;
}

Le bouton ListerFichier permet de lancer la procédure "ListerFichiersTk". Elle nous permet de lister un répertoire choisi par l'utilisateur dans le thread.

sub ListerFichiersTk {
 
  # Selectionner un répertoire
  my $Directory = $WidgetPrincipal->chooseDirectory(
    -title     => "Selection d'un repertoire",
    -mustexist => 1,
  );
 
  if ($Directory) {
 
    $Message     = "Listings des fichiers en cours";
    # On va demander au thread de bosser
    $NomFonction = "ListerFichiers";  # On lui indique la procédure à appeler
    @ArgumentsThread = ($Directory);  # On lui donne les arguments
    $ThreadTravail   = 1;             # On lui demande de bosser
  }
  return;
}

Dans la procédure ci-dessus, on demande d'abord à l'utilisateur de choisir un répertoire. S'il en choisit un, on fait appel à notre thread pour travailler. On indique alors dans notre variable partagée le nom de la procédure à appeler.

$NomFonction = "ListerFichiers";

On fait de même avec les bons arguments :

@ArgumentsThread = ($Directory);

@ArgumentsThread contient un seul élément, mais il aurait pu en contenir plusieurs si notre procédure "ListerFichiers" en attendait plus. Une fois qu'il a fini de lister les fichiers, il se re-endort.

Le script complet est PerlTkThreadPropreFinal1 (téléchargeable dans la section "Téléchargement des scripts").

A ce stade, voici quelques remarques :

• Lorsque l'on clique sur le bouton "lister fichiers", la fenêtre n'est plus figée.
• L'heure s'affiche normalement et régulièrement.
• Le thread ne bug plus et ne s'arrête pas de façon brusque.
• A la fermeture du script, on fait appel à la méthode detach sans souci. On aurait pu également appeler la méthode join.

• Pour le moment, on ne sait pas comment récupérer le résultat de la procédure lancée dans le thread.
• Dans le script principal, on ne sait pas concrètement quand le thread est terminé.
• L'utilisateur peut cliquer sur le bouton "lister fichiers" alors que le répertoire est encore en cours de listing.

On a quand même déjà beaucoup d'avantages par rapport aux inconvénients, non ? Nous allons maintenant voir comment on peut améliorer notre script.

Il est important que vous soyez bien familier avec les notions de références en Perl pour cette partie de l'article.

Pour récupérer les résultats des procédures lancées dans notre thread, on a prévu une variable partagée.

my @ResultatFonction : shared;    # Contient le résultat des fonctions lancées dans le thread

Nous allons l'utiliser dans notre procédure "NotreThreadUnique" en modifiant la ligne de code suivante :

      # Lance la procédure
      $LesFonctionsALancerDansThread{$NomFonction}->(@ArgumentsThread);

en celle-ci

      # Lance la procédure et récupère le résultat
      my @Resultat = $LesFonctionsALancerDansThread{$NomFonction}->(@ArgumentsThread);

On peut ainsi dans un premier temps récupérer le résultat retourné par la procédure lancée. Vous allez sûrement vous demander pourquoi on n'a pas tout simplement écrit :

      # Lance la procédure et récupère le résultat
      my @ResultatFonction = $LesFonctionsALancerDansThread{$NomFonction}->(@ArgumentsThread);

Si vous mettez directement le résultat dans @ResultatFonction, le code sera bon tant que votre procédure ne retourne que des scalaires, un tableau de scalaires partagés ou des références de tableaux (ou hash) partagées. Ceci est bien expliqué dans la documentation du module threads::shared.
Si ce n'est pas le cas, vous obtiendrez un message d'erreurs du type Thread 1 terminated abnormally: Invalid value for shared scalar at ... et le thread s'arrêtera. Rien de mieux qu'un exemple!

Supposons que notre procédure "ListerFichiers" ne retourne pas @fichiers comme c'est le cas pour l'instant, mais plutôt une référence de @fichiers.

sub ListerFichiers {
  my ($repertoire) = @_;
  my @fichiers;
 
...
 
  return \@fichiers;
}

Si on écrit

      # Lance la procédure et récupère le résultat
      my @ResultatFonction = $LesFonctionsALancerDansThread{$NomFonction}->(@ArgumentsThread);

@ResultatFonction contient une référence à un tableau qui n'est pas partagé. Cela va génére l'erreur Thread 1 terminated abnormally: Invalid value for shared scalar at .... Il faut donc utiliser la méthode shared_clone qui prend en argument une référence de tableau ou hash et copie tous les éléments non partagés.

NB : La méthode shared_clone retourne une réference de hash ou de tableau.

my $RefHash = shared_clone( \@ARRAY); # => retourne une référence de tableau
my $RefARRAY = shared_clone( \%HASH); # => retourne une référence de hash

Dans tous les cas, on utilise la méthode shared_clone. Comme elle nous retourne une référence, on va dans plutôt partager une variable s'appelant $RefResultatFonction à la place de @ResultatFonction.

#================================================
...
my $RefResultatFonction : shared; # Contient le résultat des fonctions lancées dans le thread
...
...
 
# NotreThreadUnique
#================================================
sub NotreThreadUnique {
 
  # Tourne en rond
  while (1) {
 
    # demande au thread de travailler
    if ( $ThreadTravail == 1 ) {
 
      # Lance la procédure et récupère le résultat
      my @Resultat = $LesFonctionsALancerDansThread{$NomFonction}->(@ArgumentsThread);
      $RefResultatFonction = shared_clone( \@Resultat);
 
      # demande au thread de dormir
      $ThreadTravail = 0;
    }
 
    # Terminer le thread
    last if ( $TuerThread == 1 );
 
    sleep 0.5;
  }
  return;
}

Notre variable contient maintenant à chaque fois le résultat de notre procédure.
Nous déterminons le moment où la procédure lancée par thread est terminée et affichons le résultat. On empêche également un autre click sur le bouton "Lister fichiers" tant que le listing est en cours. Modifions notre procédure "ListerFichiersTk" :

sub ListerFichiersTk {
 
  # Selectionner un répertoire
  my $Directory = $WidgetPrincipal->chooseDirectory(
    -title     => "Selection d'un repertoire",
    -mustexist => 1,
  );
 
  if ($Directory) {
 
    $Message     = "Listings des fichiers en cours";
    # On va demander au thread de bosser
    $NomFonction = "ListerFichiers";  # On lui indique la procédure à appeler
    @ArgumentsThread = ( $Directory );  # On lui donne les arguments
    $ThreadTravail   = 1;             # On lui demande de bosser
 
    #  ===> Modification (Rajout) <=============
    # On desactive le bouton ListerFichiers
    $BoutonListerFichier->configure(-state => "disabled");
 
    # Tant que le thread travail, on attends 
    while ( $ThreadTravail == 1 ) {
      sleep 0.2;
      $WidgetPrincipal->update;
    }
 
    $Message = "Listings des fichiers fini";
    # On réactive le bouton ListerFichiers
    $BoutonListerFichier->configure(-state => "normal");
 
    # On affiche le resulat
    my $NbrFichier = scalar( @{$RefResultatFonction} );
    print "Nombre de fichiers : $NbrFichier\n"; 
    foreach my $Fichier ( @{$RefResultatFonction} ) {
      print "- $Fichier\n";
    }
 
  }
  return;
}

Explication :

Une fois que le thread se met à travailler, on désactive le bouton "Lister fichiers". On effectue ensuite une boucle while qui vérifie toutes les 200 millisecondes s'il a terminé ou non . On update le widget, sinon ce dernier sera figé. On teste si $ThreadTravail est égal à 1 ou non. A chaque fois que le thread a fini de travailler, il se re-endort, $ThreadTravail = 0 ) !

...
      # Lance la procédure et récupère le résultat
      my @Resultat = $LesFonctionsALancerDansThread{$NomFonction}->(@ArgumentsThread);
      $RefResultatFonction = shared_clone( \@Resultat);
 
      # demande au thread de dormir
      $ThreadTravail = 0;                  #<======= Dort mon ami thread
...

Une fois que le thread est endormi, on peut réactiver le bouton et lire le résultat.

# On affiche le resulat
my $NbrFichier = scalar( @{$RefResultatFonction} );
print "Nombre de fichiers : $NbrFichier\n"; 
foreach my $Fichier ( @{$RefResultatFonction} ) {
  print "- $Fichier\n";
}

Dans notre cas, $RefResultatFonction est une référence de tableau, on en tient compte pour extraire les résultats.

Le script est PerlTkThreadPropreFinal (téléchargeable dans la section "Téléchargement des scripts").

On a enfin terminé! Notre script fonctionne maintenant correctement :

• La fenêtre n'est plus figée et l'heure s'affiche de manière régulière.
• L'utilisateur ne peut pas cliquer sur le bouton lorsque le listing est en cours.
• On récupère proprement les résultats de notre listing de fichiers.
• Le thread ne s'arrête plus brusquement.
• A la fermeture de la fenêtre Perl Tk, le thread est proprement détruit.

Voilà, vous savez maintenant comment utiliser les threads avec Perl Tk! Vous pouvez vous inspirer de ces scripts : PerlTkThreadPropreFinal pour l'utilisation des threads et ScriptProgressBar pour l'utilisation des barres de progression. Adaptez les à vos besoins! Si vous voulez utiliser un seul thread pour pouvoir lancer diverses procédures, il vous suffit de modifier le hash %LesFonctionsALancerDansThread.

my %LesFonctionsALancerDansThread = ( 
  "ListerFichiers"     => \&ListerFichiers, 
  "ZiperUnRepertoire"  => \&ZiperUnRepertoire,
  "CalculTresLong"     => \&CalculTresLong,
  "CalculTresTresLong" => \&CalculTresTresLong,
  ...
);

Dans notre exemple, on a attend que le thread se re-endorme pour poursuivre le script principal, mais ce n'est pas une obligation. Tout dépend de ce que vous voulez faire. Il faut juste faire attention "à ne pas se mélanger les pinceaux" et ne pas écraser les données par erreur. Il est possible de faire des choses plus complexes, tout est fonction de votre imagination et votre cahier des charges. On a également décidé d'utiliser un thread, mais vous auriez pu en utiliser plusieurs, c'est toujours le même principe. A vous de bien définir ce que vous souhaitez, à penser à protéger les variables partagées si nécessaire via la méthode lock (du module threads::shared).

Pour conclure, voici quelques inconvénients à l'utilisation des threads avec Perl Tk (et oui, il y en a quand même)!

- Vous avez pu remarquer qu'on est obligé de les créer en début de script. Si on choisit d'en créer un seul, il nous sera impossible d'en créer d'autres par la suite.
- Si pour différentes raisons, la procédure lancée par votre thread produit un die, votre thread sera détruit. Si vous n'en aviez qu'un, votre script ne pourra donc plus fonctionner correctement.
- Il peut être important de tester que nos threads sont toujours en vie.
- Pour finir, vous avez pu constater que l'utilisation des threads en Perl Tk n'est pas très évidente, il faut se creuser les méninges !!!


Quoi qu'il en soit, un bon algorithme est nécessaire pour utiliser au mieux les threads et construire une application Perl Tk puissante .