I. Introduction▲
Un script Perl/Tk peut afficher des messages dans la console, générer des messages d'erreurs suite à un appel system ou à un code erroné. Dans tous les cas, il peut être intéressant de pouvoir intercepter ces messages dans un widget. Ce tutoriel vous propose différentes façons de procéder afin d'intercepter et d'afficher tous les messages dans un widget de façon progressive.
II. Gestion des sorties d'erreurs fatales en Perl/Tk▲
Si vous ne souhaitez pas que les messages d'erreurs Tk
apparaissent sur votre console, vous pouvez les
faire apparaître dans une fenêtre Perl Tk via la procédure
Tk::Error.
En déclarant une procédure de ce nom, toutes les erreurs produisant
un die sont interceptées et la fenêtre Tk n'est pas détruite.
C'est très utile pour avertir l'utilisateur via un popup ou un
widget. On peut même envisager de stocker ces messages dans un fichier.
#!/usr/bin/perl
use warnings;
use strict;
use Tk; # Appel du module Tk
my $fenetre = new MainWindow(
-title => 'Gestion die',
-background => "white",
);
$fenetre->minsize( 300, 100 );
# Affichage d'un bouton pour fermer la fenêtre
$fenetre->Button(
-text => "Exemple1",
-command => sub {
$fenetre->TOTO; # => On introduit délibérément une erreur car la méthode TOTO n'existe pas
},
)->pack();
$fenetre->Button(
-text => "Exemple2",
-command => sub {
die("Die dans le bouton 2");
},
)->pack();
MainLoop(); # Obligatoire
#================================================
# But : Afficher les messages d'erreurs dans une fenêtre
# Arguments : rien
# Retour : Rien
#================================================
sub Tk::Error {
my ( $Widget, $Error, @Locations ) = @_;
# $Error => erreur
# @Locations => Localisation de l'erreur
# $Widget => widget parent
# Error widget
my $MwError = $Widget->Toplevel( -background => "white" );
$MwError->title('Erreurs');
$MwError->minsize( 300, 300 );
$MwError->grab();
my $MessageError = $MwError->Scrolled( 'Text',
-scrollbars => 'oe',
-wrap => 'word',
);
$MessageError->delete( "1.0", "end" );
$MessageError->insert( "end", "Erreur : $Error\n\n" );
$MessageError->insert( "end", "Location : @Locations\n\n" );
$MessageError->insert( "end", "Widget : $Widget\n" );
$MessageError->pack( -fill => "both", -expand => 1, );
return;
}Explication :
Dans ce code, nous avons créé deux boutons. Le premier fait appel à une méthode TOTO
qui n'existe pas. Le deuxième génère un die. A chaque clic sur ces boutons, une fenêtre
s'ouvre en affichant le message d'erreur. Pour réaliser cela, nous devons utiliser une procédure
interne à Tk qui se nomme Tk::Error. Elle récupère automatiquement trois arguments : $Widget, $Error et
@Locations. Nous utilisons ces informations pour créer notre propre widget d'erreur.
Nous aurions pu ne pas utiliser la procédure Tk::Error, mais utiliser le module Tk::ErrorDialog. Un simple
require Tk::ErrorDialog;
aurait suffit, mais dans ce cas, un popup assez moche serait apparu avec le message
d'erreur. Je vous conseille donc l'utilisation de Tk::Error.
N.B. Sachez que cette méthode n'intercepte pas les messages d'avertissement de type
warning mais uniquement ceux qui génèrent un die. Pour en savoir plus, consulter la documentation du
moduleTk::Error.
III. Interceptions des sorties STDOUT et STDERR en Perl/Tk▲
Il existe différentes façons d'intercepter les sorties STDOUT et STDERR.
- utilisation du module Tk::Text (ou RO::Text) et STDOUT ;
- utilisation du module Tk::TextUndo et STDOUT, STDERR ;
- redirection de la sortie standard STDOUT ou STDERR dans un fichier et affichage progressif.
III-1. Utilisation du module Tk::Text (ou RO::Text) et STDOUT▲
Une ligne de code suffit pour rediriger la sortie standard STDOUT vers un widget Text.
tie *STDOUT, ref $LeWidgetText, $LeWidgetText;On déclare au préalable un widget Text de manière classique.
#!/usr/bin/perl
use warnings;
use strict;
use Tk;
my $mw = MainWindow->new;
my $text = $mw->Text()->pack( qw/ -expand 1 -fill both/ );
tie *STDOUT, ref $text, $text;
print "Hello Text World!\n";
printf "pi ~= %1.5f\n", 1.2521;
warn "message de warning\n";
MainLoop;Les affichages se font directement dans le widget au fur et à mesure que le script effectue des "print".
- Tk::Text et RO::Text via la méthode Scrolled
Si vous utilisez ces modules avec la méthode Scrolled, il faut utiliser la fonction Subwidget pour pouvoir rediriger les sorties STDOUT.
#!/usr/bin/perl
use warnings;
use strict;
use Tk;
my $mw = MainWindow->new;
my $ScrolledText = $mw->Scrolled( 'Text',
-scrollbars => 'osow',
)->pack;
tie *STDOUT, $ScrolledText, $ScrolledText->Subwidget('scrolled');
for (1..50) {
print "Hello Text World!\n";
}
MainLoop;- Inconvénient de cette méthode à ce jour
- La sortie STDERR ne peut pas être gérée avec tie et les widgets Tk::Text et Tk::ROText, les messages de warnings (équivalant d'un die sans exit) ne sont donc pas pris en compte. Si vous souhaitez les afficher, il faut modifier la variable spéciale Perl $SIG{__WARN__}.
#!/usr/bin/perl
use warnings;
use strict;
use Tk;
# Les warnings sont redirigés vers STDOUT
$SIG{__WARN__} = sub {
my @loc = caller(1);
print STDOUT @_;
return 1;
};
my $mw = MainWindow->new;
my $text = $mw->Text()->pack( qw/ -expand 1 -fill both/ );
tie *STDOUT, ref $text, $text;
print "Hello Text World!\n";
printf "pi ~= %1.5f\n", 1.2521;
warn "message de warning\n";
MainLoop;
- Si nous utilisons syswrite au lieu de print et printf,
on aura un message d'erreur "Tk::Error: Can't locate auto/Tk/Text/WRITE.al in @INC ".
Seules les fonctions Perl print et printf fonctionnent.
J'ai soumis un patch de correction aux mainteneurs du module Tk du CPAN. La modification a été effectuée dans la version
Tk 804.029. Pour les versions inférieures à 804.029, syswrite ne fonctionne pas.
- Solution alternative pour les versions de Tk inférieures à 804.029
Il est possible d'utiliser le module
Tie::HandleTie::Handle,
pour réparer le bogue (je tiens d'ailleurs à remercier
Philou67430Philou67430
pour cette idée).
Le principe consiste à créer une classe permettant d'écrire dans l'objet Tk
et d'associer cette classe au filehandle. On réécrira les fonctions
print, printf et syswrite. C'est d'ailleurs cette méthode qui est
utilisée dans le module Tk::Text, sauf que syswrite n'était pas réécrit. Voici un exemple de code :
package TieTkIO;
use warnings;
use strict;
use Carp;
require Tie::Handle;
our @ISA = qw(Tie::Handle);
# Constructeur
sub TIEHANDLE {
my ($class, $Widget ) = @_;
my $self = {
Widget => $Widget,
Ok => 0,
};
# On vérifie que le widget est bien de type Text ou scrolled text
my $WidgetTest;
my $WidgetName = $Widget->class;
$self->{WidgetName} = $WidgetName;
$self->{WidgetChildren} = join(',',$Widget->children);
unless ( grep { /$WidgetName/} qw/text rotext/ ) {
if ( $WidgetName eq 'Frame' ) {
# Widgets children
if ( grep { /Tk::(Text|ROText)/} @{$Widget->children} ) {
$self->{Ok} = 1;
}
}
}
return bless $self, $class;
}
# syswrite
sub WRITE {
my ($self, $scalar, $length, $offset) = @_;
# On simule les options de syswrite
unless ( defined $length ) { $length = length $scalar; }
unless ( defined $offset ) { $offset = 0; }
# Mauvais widget
if ( $self->{Ok} == 0 ) {
croak("Unable to use 'insert' method with widget : ".
"$self->{Widget}, $self->{WidgetChildren}\n");
}
# Tout est OK ! Redirections des sorties standard vers le widget via la méthode insert.
else {
$self->{Widget}->insert("end", substr($scalar,$offset,$length) );
$self->{Widget}->see('end') if( ($self->{Widget}->yview)[1] == 1.0 );
}
return;
}
# print
sub PRINT {
my ($self, @data) = @_;
$self->WRITE(@data);
return;
}
# printf et sprintf
sub PRINTF {
my ($self, @data) = @_;
$self->WRITE(sprintf @data);
return;
}
sub CLOSE {
return;
}
1;Notre code principal.
#!/usr/bin/perl
use warnings;
use strict;
use Tk;
use TieTkIO; # <=============== modification
my $mw = MainWindow->new;
my $ScrolledText = $mw->Scrolled( 'Text',
-scrollbars => 'osow',
)->pack;
tie *STDOUT, 'TieTkIO', $ScrolledText; # <=============== modification
for (1..50) {
print "Hello Text World!\n";
syswrite STDOUT, ("test syswrite\n"); # <=============== modification
}
MainLoop;Voilà et là tout fonctionne bien ! Ceci est une solution pour ceux qui ont besoin d'utiliser la fonction syswrite et utilisent une version de Tk inférieure à 804.029. Si vous souhaitez utiliser une autre méthode, regardez les sections suivantes.
III-2. Utilisation du module Tk::TextUndo (STDOUT ou STDERR)▲
Ce module est très pratique si l'on souhaite afficher le contenu d'un fichier dans un widget Text. Il contient trois méthodes :
- Load : pour charger un fichier entier dans le widget $text->Load($filename); ;
- Save : pour sauvegarder le contenu du widget dans un fichier $text->Save($otherfilename); ;
- FileName : pour notifier le prochain fichier qui sera chargé si load n'est pas appelé avec un argument $text->FileName($otherfilename);.
La sortie STDOUT ou STDERR peut maintenant être redirigée dans un fichier, et affichée ensuite dans le widget. Le seul inconvénient est au cas où l'on souhaite un affichage progressif car ce module affiche tout le contenu du fichier en une seule fois.
#!/usr/bin/perl
use warnings;
use strict;
use Tk;
use Tk::TextUndo;
my $fichier_erreur = 'fichier_erreur.log';
open STDOUT, '>>', $fichier_erreur or die "Impossible d'écrire dans le fichier $fichier_erreur\n";
open STDERR, '>>', $fichier_erreur or die "Impossible d'écrire dans le fichier $fichier_erreur\n";
my $mw = MainWindow->new;
my $text = $mw->TextUndo()->pack(qw/ -expand 1 -fill both/);
# update de la fenetre
$mw->update;
print "Hello Text World!\n";
printf "pi ~= %1.5f\n", 1.2521;
warn "message de warning\n";
close STDOUT;
close STDERR;
# Chargement du fichier
$text->Load($fichier_erreur);
MainLoop;Les sorties STDOUT et STDERR ont été redirigées vers un fichier fichier_erreur.log qui est par la suite lu et affiché dans le widget Text.
III-3. Affichage progressif des sorties standard dans un widget▲
Cette section explique comment rediriger les sorties STDOUT et STDERR dans un fichier et le lire régulièrement.
C'est une façon de simuler un affichage progressif. A chaque fois que nous relirons le fichier,
on reprendra à l'endroit où nous nous étions arrêtés.
Commençons par créer notre fenêtre TK
#!/usr/bin/perl
use warnings;
use strict;
use Tk;
my $fenetre = new MainWindow(
-title => 'Redirection progressive',
-background => 'white',
);
my $Scrolled = $fenetre->Scrolled(
"Text",
-height => 10,
-wrap => 'none',
-relief => 'solid',
-background => 'white',
-scrollbars => 'oe',
)->pack( qw/ -side bottom -pady 15 -padx 15 -fill both -expand 1 / );
# Affichage d'un bouton pour fermer la fenêtre
$fenetre->Button(
-text => 'Faire un die',
-command => sub { die rand(100),"\n\n"; },
)->pack( qw/ -side left -pady 15 -padx 15 /);
$fenetre->Button(
-text => "Dire Bonjour\navec print",
-command => sub { print "Bonjour print\n\n"; },
)->pack( qw/ -side left -pady 15 -padx 15 /);
$fenetre->Button(
-text => "Dire Bonjour\navec printf",
-command => sub { printf "%s Bonjour\n\n", "printf"; },
)->pack( qw/ -side left -pady 15 -padx 15 /);
$fenetre->Button(
-text => "Dire Bonjour\navec syswrite",
-command => sub { syswrite STDOUT, ("Bonjour syswrite\n\n"); },
)->pack( qw/ -side left -pady 15 -padx 15 /);
MainLoop();
Rien de bien compliqué !! Lorsque l'utilisateur clique sur les boutons, tout s'affiche dans la console.
Créons une fonction qui aura pour but de rediriger toutes les sorties dans un fichier temporaire. Ce fichier sera lu régulièrement.
#=========================================================================
# Procédure rediriger le STDOUT STDERR
#=========================================================================
sub rediriger_flux {
my ( $scrolled ) = @_;
# Création du fichier temporaire
require File::Temp;
my ( $fh_STDOUT_STDERR, $fichier_STDOUT_STDERR ) = File::Temp::tempfile( UNLINK => 1 );
close $fh_STDOUT_STDERR;
open STDOUT, '>>', $fichier_STDOUT_STDERR;
open STDERR, '>>', $fichier_STDOUT_STDERR;
# Lancement d'une fonction qui surveille le STDOUT toutes les 0.5 secondes
my $taille_octet_lue = 0;
#=========================================================================
# Procédure pour lire un fichier à partir d'un certain nombre d'octets
# Et on affiche le contenu dans un widget
#=========================================================================
my $sub_lecture_fichier_par_octets = sub {
my ( $fichier, $ref_text_widget, $ref_taille_octets_fichier_lu ) = @_;
my $buffer; # Data du fichier à lire
my $buffer_size = 1000; # Lecture par 1000 octets
open my $fh, '<', $fichier or die "Impossible de lire le fichier $fichier\n";
# On commence la lecture du fichier depuis le début à partir d'un certain
# nombre d'octets
seek( $fh, ${$ref_taille_octets_fichier_lu}, 0 );
while ( read( $fh, $buffer, $buffer_size ) != 0 ) {
$ref_text_widget->insert( 'end', $buffer );
$ref_text_widget->see( 'end' );
}
close $fh;
# Taille fichier
${$ref_taille_octets_fichier_lu} = ( stat($fichier) )[7];
return;
};
$scrolled->repeat( 500, [ $sub_lecture_fichier_par_octets, $fichier_STDOUT_STDERR, $scrolled, \$taille_octet_lue ] );
return;
}
Cette fonction sera appelée une fois et on lui passera en argument la référence de notre widget text.
Ensuite, elle va rediriger tous les messages STDOUT et STDERR dans un fichier temporaire.
Ce fichier temporaire est lu toutes les demi-secondes et le contenu est affiché dans le widget.
On lit notre fichier 1000 octets par 1000 octets. Nous utilisons ici
les fonctions seek et read de Perl pour lire
notre fichier. Voici une explication
de ces deux fonctions pour ceux qui ne les connaissent pas.
seek est une fonction Perl qui nous permet de lire un fichier en
sautant un nombre voulu de caractères et en se positionnant où l'on
souhaite dans le fichier. Elle prend trois arguments :
- le premier est le descripteur de notre fichier ;
- le deuxième correspond au nombre de caractères que l'on souhaite sauter ;
- le dernier est une valeur (0, 1 ou 2 ) qui permet à Perl de se positionner dans le fichier à un endroit précis. 0 pour début de fichier, 2 à la fin du fichier, 1 à la prochaine ligne qui doit être lue.
read est une fonction Perl qui permet de lire une chaîne de caractères d'une longueur précise. Elle attend trois ou quatre arguments et retourne le nombre de caractères lus :
- le premier est le descripteur de notre fichier ;
- le deuxième correspond à la variable scalaire dans laquelle elle stockera les données lues ;
- le troisième correspond à la taille de la chaîne qu'elle doit lire (1000 octets pour notre exemple) ;
- le dernier (optionnel) permet de faire un décalage et placer les données lues ailleurs qu'en début de la chaîne.
Vous avez maintenant compris que je lis le fichier 1000 octets par 1000 octets et que je l'affiche dans le widget. Je calcule ensuite la taille du fichier pour mieux me positionner dans le fichier à la prochaine lecture de ce dernier.
#!/usr/bin/perl
use warnings;
use strict;
use Tk;
my $fenetre = new MainWindow(
-title => 'Redirection progressive',
-background => 'white',
);
my $Scrolled = $fenetre->Scrolled(
'Text',
-height => 10,
-wrap => 'none',
-relief => 'solid',
-background => 'white',
-scrollbars => 'oe',
)->pack( qw/ -side bottom -pady 15 -padx 15 -fill both -expand 1 / );
# Affichage d'un bouton pour fermer la fenêtre
$fenetre->Button(
-text => 'Faire un die',
-command => sub { die rand(100),"\n\n"; },
)->pack( qw/ -side left -pady 15 -padx 15 /);
$fenetre->Button(
-text => "Dire Bonjour\navec print",
-command => sub { print "Bonjour print\n\n"; },
)->pack( qw/ -side left -pady 15 -padx 15 /);
$fenetre->Button(
-text => "Dire Bonjour\navec printf",
-command => sub { printf "%s Bonjour\n\n", 'printf'; },
)->pack( qw/ -side left -pady 15 -padx 15 /);
$fenetre->Button(
-text => "Dire Bonjour\navec syswrite",
-command => sub { syswrite STDOUT, ("Bonjour syswrite\n\n"); },
)->pack( qw/ -side left -pady 15 -padx 15 /);
# Redirection STDOUT et STDERR
rediriger_flux($Scrolled);
MainLoop();
#=========================================================================
# Procédure rediriger le STDOUT STDERR
#=========================================================================
sub rediriger_flux {
my ( $scrolled ) = @_;
# Création du fichier temporaire
require File::Temp;
my ( $fh_STDOUT_STDERR, $fichier_STDOUT_STDERR ) = File::Temp::tempfile( UNLINK => 1 );
close $fh_STDOUT_STDERR;
open STDOUT, '>>', $fichier_STDOUT_STDERR;
open STDERR, '>>', $fichier_STDOUT_STDERR;
# Lancement d'une fonction qui surveille le STDOUT toutes les 0.5 secondes
my $taille_octet_lue = 0;
#=========================================================================
# Procédure pour lire un fichier à partir d'un certain nombre d'octets
# Et on affiche le contenu dans un widget
#=========================================================================
my $sub_lecture_fichier_par_octets = sub {
my ( $fichier, $ref_text_widget, $ref_taille_octets_fichier_lu ) = @_;
my $buffer; # Data du fichier à lire
my $buffer_size = 1000; # Lecture par 1000 octets
open my $fh, '<', $fichier or die "Impossible de lire le fichier $fichier\n";
# On commence la lecture du fichier depuis le début à partir d'un certain
# nombre d'octets
seek( $fh, ${$ref_taille_octets_fichier_lu}, 0 );
while ( read( $fh, $buffer, $buffer_size ) != 0 ) {
$ref_text_widget->insert( 'end', $buffer );
$ref_text_widget->see( 'end' );
}
close $fh;
# Taille fichier
${$ref_taille_octets_fichier_lu} = ( stat($fichier) )[7];
return;
};
$scrolled->repeat( 500, [ $sub_lecture_fichier_par_octets, $fichier_STDOUT_STDERR, $scrolled, \$taille_octet_lue ] );
return;
}Vous pouvez à présent adapter ce script à vos besoins. Il vous suffit juste de récupérer la fonction RedirectionFlux et la mettre dans votre script. Puis de l'appeler une seule fois en lui donnant en argument votre widget Text.
IV. Liens utiles▲
V. Conclusion▲
Vous avez maintenant plusieurs solutions pour rediriger vos sorties standard (STDOUT) et sorties d'erreurs (STDERR) en Perl/Tk dans un widget Text !
Si vous avez des remarques ou des solutions à proposer, n'hésitez pas. 14 commentaires 
VI. Remerciements▲
Je remercie stoyak et ClaudeLELOUPprofil ClaudeLELOUP pour la relecture de ce tutoriel.