Afficher la sortie STDOUT au fur et à mesure dans un widget Tk

Il est souvent prise de tête d'afficher la sortie standard STDOUT dans un widget
Perl/Tk (Page figée, résultat à la fin, etc.), surtout si l'on souhaite un affichage progressif.

Voici plusieurs solution pour palier au problème :
1) Module Tk::Text
C'est simple d'utilisation via une ligne de code.

Code:

tie *STDOUT, ref $TonWidgetText, $TonWidgetText;

ou

Code:

tie *STDOUT, ref $text, $text;

Voici un exemple du CPAN
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 #!/usr/local/bin/perl use warnings; use strict; use POSIX 'acos'; use Tk; use strict; my $mw = MainWindow->new; my $text = $mw->Text(qw/-width 40 -height 10/)->pack; tie *STDOUT, ref $text, $text; print "Hello Text World!\n"; printf "pi ~= %1.5f", acos(-1.0); MainLoop;
Malheureusement :
1- ça ne fonctionne que pour les print et printf
2- ça fait planter l'application si le script utilise des syswrite
3- Il est impossible d'associer cette ligne de code à un widget Scrolled de type Text.

2) Le module Tk::TextUndo

Très pratique si on souhaite afficher le contenu d'un fichier dans un widget Texte.
De ce faite, on pourrait mettre le contenu de STDOUT dans un fichier, puis l'afficher dans le widget.
ça fonctionne très bien et peut largement suffir.

Inconvénient : Si on souhaite un affichage progressif du STDOUT, c'est ingérable car
ce module affiche le contenu du fichier à un moment t.

3) Autre solution personnelle
Je redirige le contenu du STDOUT dans un fichier.
Je crée ensuite une procédure qui est lancée toutes les 250 millisecondes
(à configurer comme on le souhaite ). Cette procédure a pour rôle de lire le fichier
de sortie STDOUT, puis d'afficher son contenu au fur et à mesure.
Pour éviter que tout le contenu ne soit affiché à plusieurs reprise, je le
parcours à partir de d'un certain nombre d'octets parcourus auparavant.
avantage : printf, sprintf, syswrite, tout ce qui est sur STDOUT
sera dans le fichier et pourra être affiché.
Inconvénient : Il faudra updater le widget à l'intérieur de votre procédure qui
est censé durer un certain. Et ce quelque soit la méthode utilisée sinon votre
fenêtre restera figée et le résultat ne s'affichera qu'à la fin.

Voici un exemple qui illustre mes dires :
Ce script affiche une fenetre Tk contenant un bouton et un widget texte.
Si on clique sur le bouton, il liste les fichiers du repertoire program files et
ses sous répertoires. Ces fichiers sont printés normalement à l'ecran.
Donc, le STDOUT sera capté et affiché dans le widget text.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 #!/usr/bin/perl use warnings; use strict; use Tk; use utf8; my $FichierSTDOUT = "SortieSTDOUT.txt"; open( STDOUT, '>', $FichierSTDOUT ); my $mw = MainWindow->new; $mw->Label( -text => "Exécuter une longue tache\n", )->pack; my $ButtonLister = $mw->Button( -text => "Lister les fichiers du répertoire Program Files", )->pack; my $Scrolled = $mw->Scrolled( "Text", -height => 10, -wrap => "none", -relief => "solid", -background => "white", -scrollbars => "oe", )->pack( -fill => "both", -expand => 1 ); # On associe au bouton sa fonction $ButtonLister->configure( -command => sub { my $TailleOctetLu = 0; # Lancement de la procedure toutes les 250 millisecondes my $Id = $mw->repeat( 100, [\&LectureFichierParOctets, $FichierSTDOUT, $Scrolled, \$TailleOctetLu] ); ListerFichiersRecursif($ENV{PROGRAMFILES}, $mw); #Destruction des lancements $Id->cancel(); }, ); MainLoop; #========================================================================= # Procedure pour lire un fichier à partir d'un certain nombre d'octet # Et on affiche le contenu dans un widget #========================================================================= sub LectureFichierParOctets { my ( $Fichier, $RefTextWidget, $RefTailleOctetsFichierLu ) = @_; my $buffer; # Data du fichier à lire my $buffer_size = 1000; # Lecture par 1000 octets open(FIC, '<', $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 (FIC, ${$RefTailleOctetsFichierLu} , 0); while( read(FIC,$buffer,$buffer_size) != 0 ) { $RefTextWidget->insert("end", $buffer); } close(FIC); ${$RefTailleOctetsFichierLu} = (stat($Fichier))[7]; # Taille fichier return; } sub ListerFichiersRecursif { my ($repertoire, $Widget) = @_; opendir( REP, $repertoire ) or die "impossible d'ouvrir le repertoire $repertoire\n"; my @file_rep = grep { !/^\.\.?$/ } readdir(REP); closedir(REP); my @fichiers = (); foreach my $nom (@file_rep) { if ( -f "$repertoire/$nom" ) { push( @fichiers, "$repertoire/$nom" ); $Widget->update if ( $Widget and Exists $Widget ); # Update du widget print "$repertoire/$nom\n"; } elsif ( -d "$repertoire/$nom" ) { push( @fichiers, &ListerFichiersRecursif("$repertoire/$nom", $Widget) ); } } return @fichiers; }