[Resolu][perl tk] caractère spéciaux dans une listbox (genre àéè...)

caractère spéciaux dans une listbox (genre àéè...) [Resolu][perl tk] - Perl - Programmation

Marsh Posté le 16-03-2011 à 01:07:41    

Bonsoir à tous (et à toutes ?)  :jap:  
 
 
J'ai un souci d'affichage avec une listbox; j'ai mis un bout de mon programme en italique ci-dessous, à faire tourner pour tester de votre coté...
 
 
Pour voir le problème, il faut sélectionner un dossier qui contient des fichiers dont le nom comprend des caractères spéciaux, genre "çé_là_kè_losse.txt", puis cliquer sur afficher. Normalement, on voit apparaitre dans la listbox les fichiers du dossier choisi, avec la commande $lb->insert('end', $fic);. Pour comparer, j'ai aussi rajouté une sortie console print "$fic\n";.  
Et c'est là que je ne comprend pas: dans la console, pas de souci, ca passe, mais pas dans la listbox  [:lol wut]  
 
 
Et pour plus de fun, j'ai rajouté ça :
$test = "àçéèêïù";
$lb->insert('end', $test);

Et ca passe bien cette fois...  
[:implosion du tibia]
 
En image :
http://dl.dropbox.com/u/1691185/exemple.png
 
En un mot comme en cent : [:halp]
 
 
###### LE CODE ######

 
use Tk;
$mainw = new MainWindow(
  -title      => "Selection d'un dossier",
);
$mainw->minsize(300,300);
 
$dirpath = "Pas de choix pour l'instant";
sub selectionDir{
  $Directory = $mainw->chooseDirectory(
    -mustexist  => 1,
  );
  if (defined $Directory) {
    $dirpath = $Directory;
  }
}
 
sub afficher{
  print "dossier choisi: $dirpath\n";
  unless ($dirpath eq "Pas de choix pour l'instant" ){
    undef @listfic;
    @listfic =();
    $dirpath =~ s/\//\\/g;
    $commande="dir \"$dirpath\"/B/ON";
    open (DIR, "$commande |" ) || die "caramba encore rate $!";
    $lb->delete(0, 'end');
    while (<DIR> ){
      chomp;
      push(@listfic, "$_" );
    }
    sort @listfic;
    for $fic (@listfic){
      $lb->insert('end', $fic);
      print "$fic\n";
    }
    $test = "àçéèêïù";
    $lb->insert('end', $test);
  }
}
 
$bouton = $mainw->Button(
  -text    => "Selection d'un dossier",
  -command => [\&selectionDir],
);
$bouton->pack();
 
$bouton2 = $mainw->Button(
  -text    => 'Afficher le choix',
  -command => [\&afficher],
)->pack();
 
 
$lb = $mainw->Scrolled(
  "Listbox",
  -scrollbars => "se",
  -selectmode => 'multiple',
)->pack(
  -expand => 1,
  -fill => both,
  -side => left,
);
 
MainLoop();
 


Message édité par lomobob le 16-03-2011 à 17:54:14
Reply

Marsh Posté le 16-03-2011 à 01:07:41   

Reply

Marsh Posté le 16-03-2011 à 09:33:49    

Citation :

while (<DIR> ){  
      chomp;  
      push(@listfic, "$_" );  
    }

C'est la que tu récupères les noms avec le mauvais encoding (ie différent de celui avec lequel tu codes ton fichier Perl).
Donc soit tu ré-encodes dans le bon encoding avant mettre dans la liste, soit tu utilise une procédure pure perl pour récupérer les noms des fichiers dans un répertoire, comme:
 
$dirpath =~ s/\//\\/g;  
opendir(DIR, $dirpath) || die "caramba encore rate $!";  
$lb->delete(0, 'end');  
@listfic= readdir(DIR);  
closedir(DIR);
sort @listfic;  
etc
 
EDIT: ah oui, je vois, tu veux les noms courts DOS. Je vais regarder cela.  
 
Ceci devrait coller, si ton encoding DOS n'est pas le bon, remplaces le par le nom d'encoding approprié
use Encode;
.....................
    while (<DIR> ){  
      chomp;  
      push(@listfic, decode("cp850", $_) );  
    }  
Ça marche sur ma bécane.
A+,


Message édité par gilou le 16-03-2011 à 10:10:36

---------------
There's more than what can be linked! --    Iyashikei Anime Forever!    --  AngularJS c'est un framework d'engulé!  --
Reply

Marsh Posté le 16-03-2011 à 10:32:22    

Version qui devrait marcher avec un DOS de toute nationalité:

Code :
  1. ###### LE CODE ######
  2.  
  3. use Encode;
  4. use Win32::Codepage::Simple qw(get_oemcp);
  5. use Tk;
  6.  
  7.  
  8. my $codepage = "cp".get_oemcp();
  9. $mainw = new MainWindow(
  10.  -title      => "Selection d'un dossier",
  11. );
  12. $mainw->minsize(300,300);
  13.  
  14. $dirpath = "Pas de choix pour l'instant";
  15. sub selectionDir{
  16.  $Directory = $mainw->chooseDirectory(
  17.    -mustexist  => 1,
  18.  );
  19.  if (defined $Directory) {
  20.    $dirpath = $Directory;
  21.  }
  22. }
  23.  
  24. sub afficher{
  25.  print "dossier choisi: $dirpath\n";
  26.  unless ($dirpath eq "Pas de choix pour l'instant" ){
  27.    undef @listfic;
  28.    @listfic =();
  29.    $dirpath =~ s/\//\\/g;
  30.    $commande="dir \"$dirpath\"/B/ON";
  31.    open (DIR, "$commande |" ) || die "caramba encore rate $!";
  32.    $lb->delete(0, 'end');
  33.    while (<DIR> ){
  34.      chomp;
  35.      push(@listfic, decode($codepage, $_) );  
  36.    }
  37.    sort @listfic;
  38.    for $fic (@listfic){
  39.      $lb->insert('end', $fic);
  40.      print encode($codepage,$fic), "\n";
  41.    }
  42.    $test = "àçéèêïù";
  43.    $lb->insert('end', $test);
  44.  }
  45. }
  46.  
  47. $bouton = $mainw->Button(
  48.  -text    => "Selection d'un dossier",
  49.  -command => [\&selectionDir],
  50. );
  51. $bouton->pack();
  52.  
  53. $bouton2 = $mainw->Button(
  54.  -text    => 'Afficher le choix',
  55.  -command => [\&afficher],
  56. )->pack();
  57.  
  58.  
  59. $lb = $mainw->Scrolled(
  60.  "Listbox",
  61.  -scrollbars => "se",
  62.  -selectmode => 'multiple',
  63. )->pack(
  64.  -expand => 1,
  65.  -fill => both,
  66.  -side => left,
  67. );
  68.  
  69. MainLoop();

 
A+,


---------------
There's more than what can be linked! --    Iyashikei Anime Forever!    --  AngularJS c'est un framework d'engulé!  --
Reply

Marsh Posté le 16-03-2011 à 17:22:14    

Merci ! :jap:  
 
La solution  

use Encode;  
push(@listfic, decode("cp850", $_) );

 
marche parfaitement !  
 
[:petoulachi:1]
 
Par contre, la deuxième avec le code intégral plante à la ligne 4 use Win32::Codepage::Simple qw(get_oemcp);
 
(ce qui impacte du coup la ligne 8 je suppose... my $codepage = "cp".get_oemcp();)
 
J'obtiens ce message d'erreur:
 
Can't locate Win32/Codepage/Simple.pm in @INC (@INC contains: C: /Perl64/site/lib
 C: /Perl64/lib .) at F:\perl\solution.pl line 4.
BEGIN failed--compilation aborted at F:\perl\solution.pl line 4.

 
Je soupçonne un problème d'OS chez moi (à savoir Windows7 64 bits et non pas 32...) d'en être à l'origine... ou un module manquant ??? [:urd]
 
Merci encore de t'être penché sur mon problème et de m'avoir aidé !  :hello:  

Reply

Marsh Posté le 16-03-2011 à 17:42:33    

lomobob a écrit :

Merci ! :jap:  
ou un module manquant ??? [:urd]
 
Merci encore de t'être penché sur mon problème et de m'avoir aidé !  :hello:  

Oui, les modules, en général, une installation de base, elle en a le minimum genre 600/12000 de tête.
Faut ajouter soi même les modules utiles pour ses programmes ensuite.
A+,


---------------
There's more than what can be linked! --    Iyashikei Anime Forever!    --  AngularJS c'est un framework d'engulé!  --
Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed