Applications multi threading avec Perl/Tk

Date de publication : 26/02/2009 , Date de mise à jour : 04/03/2009

Par djibril (home)
 

Cet article vous explique comment empêcher une application Perl/Tk de rester figée en utilisant une barre de progression, en créant des threads. 1 commentaire · Donner une note à l'article (5)

               Version PDF (Miroir)   Version hors-ligne (Miroir)

I. Introduction
II. Problématique
II-1. Première solution
II-2. Widget figé
II-3. Barre de progression
II-4. Dissocier la tâche de mon widget (threads)
III. Empêcher la fenêtre de se figer
IV. Création d'une barre de progression
V. Perl/Tk et les threads
V-1. Qu'est ce qu'un thread
V-2. Exemple basique d'utilisation
V-3. Perl Tk et les threads
3-a. Avantages et inconvénients
3-b. Erreurs courantes
V-4. Mise en place des threads dans notre exemple
VI. Téléchargement des scripts
VII. Conclusion
VIII. Liens utiles
IX. Remerciements


I. Introduction

La création de scripts Perl Tk a généralement pour but d'éviter à son utilisateur d'avoir à travailler sous une console noire qui peut faire peur!
Le but est donc de permettre d'interagir avec une application Perl via une interface graphique.

On est très souvent confronté à des questions existentielles ! Supposons que notre application Perl/Tk ait pour rôle d'effectuer de longs calculs, de lister des répertoires, de lancer d'autres scripts qu'on ne peut pas modifier et en même temps d'afficher l'heure. Voici les différentes questions que l'on se pose au cours du développement :

  • Pourquoi ma fenêtre reste figée quand je clique sur le bouton ?
  • Pourquoi la fenêtre ne répond plus et qu'il y a une grosse tâche blanche ?
  • Comment dissocier mon calcul de ma fenêtre ?
  • Pourquoi l'heure ne bouge plus ?
  • Comment suivre la progression d'une tâche ?
  • ...
Cet article va essayer de répondre à ces questions. Nous supposerons que vous avez déjà les bases de Perl et bien évidemment de Perl Tk. Si ce n'est pas le cas, les cours de Perl et de Perl/Tk, sans oublier les FAQs sont à votre disposition dans la rubrique Perl.


II. Problématique

Afin de vous expliquer au mieux les problèmes rencontrés et comment les résoudre facilement, nous allons réaliser un script qui aura pour but de :

  1. Afficher l'heure instantanément
  2. Afficher 3 boutons
    un pour fermer l'application
    un pour changer l'affichage de l'heure
    le dernier pour lister les répertoires

II-1. Première solution

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.
ScriptBasique
#!/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").


II-2. Widget figé

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.


II-3. Barre de progression

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 (en Tk::ProgressBar).


II-4. Dissocier la tâche de mon widget (threads)

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 en threads).


III. Empêcher la fenêtre de se figer

Avoir une fenêtre Tk figée est un effet normal. Il indique que votre application est en train de fonctionner. Pendant que votre script tourne, vous ne pouvez normalement rien faire car vous n'avez plus la main. Il faut attendre que la tâche en cours se termine. Cet effet est assez désagréable car l'utilisateur du script ou de l'application n'y est pas habitué et peut avoir l'impression qu'il y a un bug. De plus, dans notre exemple, on affiche l'heure. On peut donc trouver cela bizarre que les secondes ne soient pas affichées régulièrement.

Pour palier à ce problème, Perl Tk a prévu une méthode (update) qui permet de rafraîchir la page. L'idée est donc de faire appel à cette méthode régulièrement, ce qui empêchera le widget d'être figé.

Pour revenir à notre exemple, la procédure qui est susceptible de prendre du temps pendant son exécution est "ListerFichiers". On va donc la modifier et rajouter un update de la fenêtre à chaque fois qu'un fichier est trouvé.

Voici donc notre nouvelle procédure "ListerFichiers".
ScriptBasique2.pl
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
      $WidgetPrincipal->update;    # <=== modification
      
    }
    # Repertoires
    elsif ( -d "$repertoire/$nom") {
      # recursivité
      push ( @fichiers, ListerFichiers("$repertoire/$nom") );
    }
  }
  
  return @fichiers;
}
Les principales modifications sont les suivantes :
update
$WidgetPrincipal->update;
La page sera mise à jour régulièrement, à chaque fichier trouvé.
affichage du fichier
$Message = "$repertoire/$nom";
On a créée un label avec texte variable ($Message)
label texte variable
# Label qui affichera l'etat 
$WidgetPrincipal->Label(
  -textvariable => \$Message,
  -background => "#FFE0D0",
  -relief     => "groove",
)->pack( qw / -side bottom -fill x -expand 0/ );
A chaque fois que la variable $Message est modifiée, l'affichage change dans le widget.
Garder à l'esprit qu'il existe différentes façons de s'y prendre pour afficher notre information. On aurait pu choisir de créer un widget Texte scrollé et d'y afficher le résultat du listing au fur et à mesure avec la méthode "insert", c'est votre imagination qui rentre en compte !

Maintenant, notre script tourne bien, la fenêtre n'est plus figée et c'est plus agréable. Si je souhaite avoir une barre de progression, que faire ?

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


IV. Création d'une barre de progression

Créer une barre de progression est très utile pour avoir une visualisation rapide de l'état d'avancement d'une tâche, d'un calcul ou autre. Elle est facile à mettre en place, surtout si nous avons la main sur le calcul à effectuer.

Nous utilisons le module en Tk::ProgressBar et je vous conseille de lire sa documentation. Voici un exemple de code :
Tk::ProgressBar
my $progress = $Widget->ProgressBar(
    -width  => 20,                # Largeur de la barre de progression
    -length => 300,               # Longueur
    -from   => 0,                 # La valeur initiale est 0
    -to     => 100,               # La valeur de fin est 100
    -colors => [ 0, "#0090F0" ],  # La couleur de remplissage de la barre de progression
    -gap    => 0,                 # espace en pixel entre chaque block de couleur. 0 donne l'impression d'une continuité.
    -troughcolor => "#A5A5A5",    # Couleur de fond de la barre de progression
)->pack( qw / -side bottom -fill x -expand 0/ ); # gestionnaire classique de placement
Il existe d'autres options que vous pouvez consulter dans la documentation CPAN. Il existe une seule méthode qui permet de faire progresser la barre. C'est la méthode "value" qu'on doit associer à "update"
Tk::ProgressBar - méthode value
# Positionne la barre à 10
$progress->value(10);
$progress->update;
Pour revenir à notre exemple, l'important est d'être capable de définir une valeur de départ et de fin pour notre barre de progression, puis de trouver comment la faire progresser logiquement.

Valeur -from : il sera judicieux de la mettre tout simplement à 0.
Valeur -to : ? Nous souhaitons lister un répertoire, notre logique sera donc la suivante : calcul de la taille du répertoire à lister et attribution de cette valeur à "-to". Par la suite, au fur et à mesure du parcours de notre répertoire, on peut calculer la taille du fichier trouvé et incrémenter une variable afin de faire progresser notre barre de progression.

Pour calculer la taille d'un répertoire, nous utilisons le module en Filesys::DiskUsage, pour un fichier, l'option -s de Perl. Voici notre script
ScriptProgressBar
#!/usr/bin/perl
#==========================================================================
# Auteur : djibril
# But    : Script Perl/Tk pour afficher l'heure, lister un répertoire
#==========================================================================

use warnings;
use strict;

use Tk;
use Tk::ProgressBar;
use Filesys::DiskUsage qw/du/;


# 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 => \&ListerFichierTk,
)->grid( -row => 0, -column => 2, -padx => 10, -pady => 10, -sticky => "nsew" );

# Label qui affichera l'etat 
my $Label = $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 );

# Variable à modifier nous permettant de faire évoluer la barre
my $TailleCourante = 0;
my $progress = $WidgetPrincipal->ProgressBar(
    -width  => 20,                # Largeur de la barre de progression
    -length => 300,               # Longueur
    -from   => 0,                 # La valeur initiale est 0
    -to     => 100,               # La valeur de fin est 100
    -colors => [ 0, "#0090F0" ],  # La couleur de remplissage de la barre de progression
    -gap    => 0,                 # espace en pixel entre chaque block de couleur. 0 donne l'impression d'une continuité.
    -troughcolor => "#A5A5A5",    # Couleur de fond de la barre de progression
)->pack( qw / -side bottom -fill x -expand 0/ ); # gestionnaire classique de placement

MainLoop();


#==========================
# Nos procédures
#==========================
sub ListerFichierTk {
    
    # Selectionner un répertoire
    my $Directory = $WidgetPrincipal->chooseDirectory(
    -title      => "Selection d'un repertoire",
    -mustexist  => 1,
    );    
    
    if ( $Directory) {     
      # initialisation à 0
      $progress->value( 0 );  
      
      # On calcul la taille du répertoire et initialise -to
      $Message = "Calcul de la taille du repertoire $Directory en cours";
      $WidgetPrincipal->update;
      my $TailleRepertoire = du($Directory);
      $progress->configure( -to => $TailleRepertoire );
      
      # Listing des fichiers
      $Message = "Listings des fichiers en cours";
      ListerFichiers($Directory);
      $Message = "Listings des fichiers fini";
    }
return;
}

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" );  
      $TailleCourante += -s "$repertoire/$nom";
      $progress->value( $TailleCourante );
      $WidgetPrincipal->update;
      print "$repertoire/$nom\n";
    }
    # Repertoires
    elsif ( -d "$repertoire/$nom") {
      # recursivité
      push ( @fichiers, ListerFichiers("$repertoire/$nom") );
    }
  }
  
  return @fichiers;
}
Ce script vous permet de lister un répertoire et affiche une barre de progression qui évolue pendant le listing des fichiers sur la console.

Explication du script :

On fait appel au module Filesys::DiskUsage que vous devez installer sur votre ordinateur. Ensuite, on crée notre widget Tk. On a modifié la création du bouton "Lister des fichiers"
Bouton Lister des fichiers
$FrameBouton->Button(
  -text => "Lister des fichiers",
  -command => \&ListerFichierTk,
)->grid( -row => 0, -column => 2, -padx => 10, -pady => 10, -sticky => "nsew" );
Lorsque l'on clique sur le bouton, il fait appel à la procédure "ListerFichiersTk", nous y reviendrons plus tard. Par la suite, juste avant Mainloop, nous créons notre barre de progression.
Création de la barre de progression
# Variable à modifier nous permettant de faire évoluer la barre
my $TailleCourante = 0;
my $progress = $WidgetPrincipal->ProgressBar(
    -width  => 20,                # Largeur de la barre de progression
    -length => 300,               # Longueur
    -from   => 0,                 # La valeur initiale est 0
    -to     => 100,               # La valeur de fin est 100
    -colors => [ 0, "#0090F0" ],  # La couleur de remplissage de la barre de progression
    -gap    => 0,                 # espace en pixel entre chaque block de couleur. 0 donne l'impression d'une continuité.
    -troughcolor => "#A5A5A5",    # Couleur de fond de la barre de progression
)->pack( qw / -side bottom -fill x -expand 0/ ); # gestionnaire classique de placement
la variable -from est mise à 0 ($TailleCourante = 0) et -to à 100. la variable -to sera modifiée par la suite car à ce niveau du script, nous ne savons pas quelle valeur lui attribuer. Elle sera modifiée grâce à la méthode Tk "configure".

Revenons maintenant sur la procédure appelée lors d'un clic sur le bouton "ListerFichiersTk"
ListerFichierTk
sub ListerFichierTk {
    
    # Selectionner un répertoire
    my $Directory = $WidgetPrincipal->chooseDirectory(
    -title      => "Selection d'un repertoire",
    -mustexist  => 1,
    );    
    
    if ( $Directory) {     
      # initialisation à 0
      $progress->value( 0 );  
      
      # On calcul la taille du répertoire et initialise -to
      $Message = "Calcul de la taille du repertoire $Directory en cours";
      $WidgetPrincipal->update;
      my $TailleRepertoire = du($Directory);
      $progress->configure( -to => $TailleRepertoire );
      
      # Listing des fichiers
      $Message = "Listings des fichiers en cours";
      ListerFichiers($Directory);
      $Message = "Listings des fichiers fini";
    }
return;
}
On demande à l'utilisateur de choisir un répertoire et nous mettons la barre à 0. On rafraîchit ensuite la page afin de mettre à jour le message et on calcule la taille du répertoire. On récupère celle-ci et on l'applique à -to. Notre barre est donc opérationnelle, on peut donc lister les fichiers.

Dans la procédure "ListerFichiers", vous pouvez remarquer 3 lignes de code 
$TailleCourante += -s "$repertoire/$nom";
$progress->value( $TailleCourante );
$WidgetPrincipal->update;
La première permet de calculer la taille du fichier, la deuxième fait avancer la barre de progression et la dernière rafraîchit la fenêtre.

A ce niveau de l'article, on est maintenant capable de créer une barre de progression dans un script Perl Tk. L'important est de se poser les bonnes questions pour initialiser l'option -to et de réfléchir à la façon de la faire progresser. Il est donc possible de faire beaucoup de choses et de déployer une application en Perl Tk fonctionnelle et robuste. Une fois de plus, c'est l'imagination du développeur qui prime!!

On peut maintenant faire une dernière remarque par rapport à notre exercice. Si on cherche à lister un très gros répertoire, par exemple le C:/ pour les windowsiens ou le répertoire /home pour les linuxiens, on s'aperçoit que le calcul de la taille du répertoire est très long. Pendant ce temps, la fenêtre est figée (et oui, on n'est pas gâté )! On entre donc dans le cas typique où l'on ne peut pas intervenir dans la méthode "du" du module pour y faire des "update". La seule façon pour ne pas avoir une page figée est de faire des threads, ouf on y arrive !!

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


V. Perl/Tk et les threads


V-1. Qu'est ce qu'un thread

Un thread en français signifie processus 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.


V-2. Exemple basique d'utilisation

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.
ExempleThreads
#!/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();
}
Résultats
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).
Partage de données - Code du site enstimac
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 :
Code du site enstimac
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").


V-3. Perl Tk et les threads


3-a. Avantages et inconvénients

Avantages
  1. L'utilisateur peut continuer à interagir avec l'interface Perl Tk pendant qu'une tâche s'effectue.
  2. La fenêtre Perl Tk n'est plus figée car la tâche s'effectue dans un autre processus.
  3. Il est possible de partager des données entre le script et les threads.
Inconvénients
  1. La version actuelle de Perl/Tk (Tk-804.028) n'est pas "thread safe" d'après les auteurs.
  2. L'utilisation des threads avec Perl Tk n'est pas simple.
  3. Le partage des données entres processus légers et/ou script principal n'est pas toujours évident.
  4. Il est recommandé de créer ses threads avant tout code TK et ne pas faire apparaître de code TK dans les threads.
  5. On ne peut donc pas créer des threads à la volée comme bon nous semble via un click bouton.
Parmi les inconvénients de Perl Tk et des threads, ayez surtout conscience des pièges même des threads, ex :

  • Les threads peuvent modifier l'état du processus complet, affectant ainsi les autres threads
  • chdir dans un thread modifie le répertoire courant des autres threads et du script principal (excepté sous Windows)
  • Lisez la documentation BUGS AND LIMITATIONS de la documentation CPAN du module threads et threads::shared
Il est important de ne pas être surpris d'un mauvais comportement de votre script à cause d'une mauvaise maîtrise des modules threads::* !


3-b. Erreurs courantes

Pour vous montrer l'erreur classique que l'on est amenée à faire la première fois que l'on souhaite utiliser les threads avec TK, on reprend notre exercice sur le listing des fichiers. On n'utilisera pas de barre de progression avec nos threads.
ThreadErreurClassique
#!/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;
}
Ce script ressemble au script ScriptBasique2. Il n'y a pas de barre de progression et on fait appel au module threads. Dans le code du bouton "Lister des fichiers", on crée notre thread et on le détache pour qu'il soit supprimé proprement par Perl à la fin de son exécution. 
my $Thread = threads->create( \&ListerFichiers, $Directory );
$Thread->detach();
Quand on exécute ce script, on remarque ceci :

Utilisation de la méthode detach

  1. La fenêtre Tk n'est pas figée.
  2. L'heure est actualisée régulièrement.
  3. Le script s'arrête brusquement à la fin de l'exécution du thread (du listing d'un répertoire) avec un message de ce type
    "Free to wrong pool 2ccee28 not 235e40 at C:/Perl/site/lib/Tk/Widget.pm line 98 during global destruction.".
Utilisation de la méthode join à la place de detach

  1. La fenêtre Tk reste figée tant que le thread n'est pas terminé (ce qui est bien dommage) !
  2. Si on ajoute un update dans la procédure "ListerFichiers", on a un message d'erreur de ce type
    Attempt to free non-existent shared string '_TK_RESULT_', Perl interpreter: 0x2ccc244 at ...
  3. Une fois le thread terminé, le script s'arrête anormalement avec les mêmes messages d'erreurs cités ci-dessus

Pourquoi ces arrêts brusques du script ?

En fait, nous violons les règles actuelles de Perl/Tk car il n'est pas "thread safe".
On ne doit absolument pas mettre de code Perl Tk dans une procédure lancée dans un thread. Or, c'est le cas ici, puisque l'on fait un update dans "ListerFichiers".

Ne me demandez pas pourquoi et quelles sont ces règles !! Le README du module nous dit ceci : Tk804.027 builds and loads into a threaded perl but is NOT yet thread safe.

Les auteurs et personnes en charge de la maintenance de Perl/Tk ont prévu de le rendre "thread-safe" dans leur en ToDo dans un futur proche !! En attendant ces nouveautés, on va utiliser un autre procédé qui est recommandé et plus sûr.

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


V-4. Mise en place des threads dans notre exemple

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.
Chargement des modules
#!/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.
Hash contenant nos fonctions
# 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) :
déclaration des variables partagées
#===================================
# 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
# Création du thread
my $Thread = threads->create( \&NotreThreadUnique );
Il reste la procédure NotreThreadUnique à concevoir !
procedure NotreThreadUnique
#================================================
# 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.
Code 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.
Procédure Fermer
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.
AfficherHeure
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.
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
  }
  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 :

Avantages
  • 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.
Inconvénients
  • 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 :
Dans procédure NotreThreadUnique
      # Lance la procédure
      $LesFonctionsALancerDansThread{$NomFonction}->(@ArgumentsThread);
en celle-ci
Dans procédure NotreThreadUnique
      # 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 :
Dans procédure NotreThreadUnique
      # 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
Dans procédure NotreThreadUnique
      # 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.
Dans procédure NotreThreadUnique
#================================================
...
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" :
ListerFichiersTk modifiée
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 ) !
Procédure NotreThreadUnique
...
      # 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.
Exemple
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 .


VI. Téléchargement des scripts

 
Vous pouvez télécharger tous les scripts de cet article fr ici.


VII. Conclusion

Dans cet article, nous avons abordé 2 notions très utiles en Perl Tk : les barres de progression et les threads. Elle permettent comme vous avez pu le constater, de ne pas figer les widgets, de montrer l'évolution d'un calcul ou d'une tâche à un utilisateur, de faire plusieurs choses en même temps si on le souhaite.

Voici quelques conseils dans le choix d'utiliser une barre de progression, les threads, ou même les deux en Perl Tk :
- optez en priorité pour le choix d'une barre de progression si possible. Cela vous permet de gérer facilement vos procédures, votre script en Perl Tk en bénéficiant des méthodes Perl/Tk disponibles (update, repeat, Busy, Unbusy, ...).
- en dernier recours, si vous n'avez vraiment pas le choix car vous utilisez un module externe pour effectuer de longs calculs, alors pensez aux threads. Gardez à l'esprit qu'en cas de "die" dans un thread, ce dernier meurt. De plus, il faut bien réfléchir au nombre de threads à créer en début de script, à la façon dont on souhaite protéger les données partagées, etc.

Maintenant que vous êtes bien armé, à vous de jouer !!

N'hésitez pas à faire des appréciations, suggestions, remarques ou corrections au sujet de cet article ici .


VIII. Liens utiles

 
Quelques références sur Perl Tk, les threads et barre de progression :
  1. en Tk::ProgressBar (CPAN)
  2. en threads (CPAN)
  3. en threads::shared (CPAN)
  4. fr Tutoriel sur les threads en Perl
  5. en http://www.perltk.org/
  6. en Filesys::DiskUsage

IX. Remerciements

Je remercie stoyak et l'équipe Perl de dvp.com pour la relecture.



               Version PDF (Miroir)   Version hors-ligne (Miroir)

Valid XHTML 1.1!Valid CSS!

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 oeuvre intellectuelle protégée par les droits d'auteurs. Copyright © 2009 djibril. Aucune reproduction, même partielle, ne peut être faite de ce site et de l'ensemble de son contenu : textes, documents, images, etc sans l'autorisation expresse de l'auteur. Sinon vous encourez selon la loi jusqu'à 3 ans de prison et jusqu'à 300 000 E de dommages et intérêts. Cette page est déposée à la SACD.

Vos questions techniques : forum d'entraide Perl - Publiez vos articles, tutoriels et cours
et rejoignez-nous dans l'équipe de rédaction du club d'entraide des développeurs francophones
Nous contacter - Hébergement - Participez - Copyright © 2000-2010 www.developpez.com - Legal informations.