Discussion :

[djibril]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

tie *STDOUT, ref $TonWidgetText, $TonWidgetText;

ou

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

tie *STDOUT, ref $text, $text;

Voici un exemple du CPAN

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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;
}

[djibril]

Un article est à présent disponible dans la rubrique Perl à ce sujet.
Suite de la conversation ici.