Perl TK

lavm01 Messages postés 69 Date d'inscription   Statut Membre Dernière intervention   -  
 dysmas -
Bonjour,
J'ai un petit programme perl tk à faire et je ne sais pas comment. Je ne sais pas si quelqu'un a un exemple à me soumettre. Voici ce que je dois faire.

1. Lire le contenu d'un répertoire (peu importe lequel)
2. Récupérer les noms de fichiers qui sont dans le répertoire
3. Ensuite mettre les noms dans un menu déroulant ou une boîte de liste.
4. À partir de la liste déroulante ou boîte de liste, je dois choisir un des noms de fichiers, le faire apparaître dans une petite zone à côté (ceci m'indiquera que c'est le bon nom de fichier que j'ai choisi)
5. Ensuite faire un clic sur un bouton afin que le fichier que j'ai choisi puisse se décompresser (si c'est des .zip) ou faire une action (ex: exécuter un fichier .bat ou .exe)

Espérons que vous avez bien compris ce que je veux, je vous serais grandement reconnaissant si quelqu'un pouvait m'aider.

Merci de me répondre.
A voir également:

7 réponses

Réponse 1 / 7
lami20j Messages postés 21331 Date d'inscription   Statut Modérateur, Contributeur sécurité Dernière intervention   3 570
 
Re,

j'ai apporté une petit modification au script de message N° 4

Dans le script précedent je faisais la sélection dans la liste ensuite j'utilisais un bouton pour afficher dans un Label le nom de fichier (ce que je trouve assez lourde, mais maintenant après la lecture de quelques pages de la doc j'ai trouvé mieux - j'avoue que je ne me suis jamais interessé au module Tk, je n'ai pas eu besoin).

La modification consiste dans la fait que maintenant quand tu fait clic sur un élément de la liste le nom de fichier sera afficher dans le Label (donc j'ai garder sur la page que le bouton Quitter).

Il nous reste la situation 5. 
#! /usr/bin/perl
#
use warnings;use strict;
use Tk;
#
my $rep = '/mnt/home/lami20j';
opendir R_DIR,$rep
        or die "E/S : $!\n";

my @rep;
my ($lst,$elem);

sub list_select{
        my @select = $lst->curselection();
        $elem = $lst->get($select[0]);
}

my $mw = MainWindow->new;

$mw -> title("Lister un répertoire");

$mw->Label(  -text => "\Ufichiers dans \E: $rep",
             -relief=> 'ridge',)->pack();

$lst = $mw->Scrolled("Listbox",-scrollbars=>'e',
                               -background => 'white',)->pack(
                                                              -anchor => 'center',
                                                              -ipadx  => '100',
                                                              -ipady  => '100',
                                                             );
$lst->bind("<Button-1>",\&list_select);

$mw->Label( -textvariable => \$elem,
            -foreground => 'blue')->pack();


while (my $fic = readdir(R_DIR)){
  next if $fic =~ /^\./; # saute les fichiers qui commencent avec .
  next if -d "$rep/$fic";# saute les répertoires
  push @rep,$fic;
}

# trier sans tenir compte de la casse
# un sort simple comme dans le 1er message
# c'est un tri asciibetique (les chiffres,les majuscule ensuite les minuscules)
# la fonction tri permet le tri alphabetique
#
sub tri { lc($a) cmp lc($b) };

$lst->insert('end',sort tri @rep);

$mw->Label(  -text => "Il y a ${ \(@rep+0) } fichiers.",)->pack();

$mw->Button( -text => 'Quitter',
             -command => sub {exit},)->pack();
MainLoop;
lami20j
1
Réponse 2 / 7
lavm01 Messages postés 69 Date d'inscription   Statut Membre Dernière intervention  
 
Merci, ça fonctionne, mais comment fait-on pour ne pas mettre les . et .. ainsi que les autres répertoires qui peuvent se trouver dans le répertoire courant (celui sur lequel on fait la recherche) dans la boîte de liste.

Merci !
0
Réponse 3 / 7
lami20j Messages postés 21331 Date d'inscription   Statut Modérateur, Contributeur sécurité Dernière intervention   3 570
 
Salut,

Voilà un lien http://lionel.romain.free.fr/
et un exemple banal qui couvre les 3 premiers situations
il faut avoir le module Tk installé.

tu peux vérifier avec la commande perl -e 'use TK'

1. - si tu as un message d'erreur de genre 
lami20j@debian:~/bin/my_deb_perl$ perl -e 'use TK'
Can't locate TK.pm in @INC (@INC contains: /etc/perl /usr/local/lib/perl/5.8.4 /usr/local/share/perl/5.8.4 /usr/lib/perl5 /usr/share/perl5 /usr/lib/perl/5.8 /usr/share/perl/5.8 /usr/local/lib/site_perl .) at -e line 1.
BEGIN failed--compilation aborted at -e line 1.
alors le module n'est pas installé

2. - pas de message alors c'est bon

Le script affiche dans une liste le contenu d'un répertoire. Comme je t'ai dit c'est un exemple banal. 

#!/usr/bin/perl
#
use warnings;use strict;
use Tk;

opendir R_DIR,"/mnt/home/lami20j/bin/my_deb_perl"
        or die "E/S : $!\n";

my @rep;
my $mw = MainWindow->new;
$mw -> title("Lister un répertoire");
my $lst = $mw->Scrolled("Listbox",
                        -scrollbars=>'e')->pack(
                                                -anchor => 'center',
                                                -ipadx  => '40'
                                               );
while (my $fic = readdir(R_DIR)){
        next if $fic =~ /^\./;
        push @rep,$fic;
}
$lst->insert('end',sort @rep);


MainLoop;
lami20j
-1
Réponse 4 / 7
lami20j Messages postés 21331 Date d'inscription   Statut Modérateur, Contributeur sécurité Dernière intervention   3 570
 
Salut,

Si je comprends bien tu veux afficher uniquement les fichiers.
Essaie cet exemple.
J'ai ajouté un Label qui affiche quel répertoire et un label qui affiche le nombre de fichiers. 
#! /usr/bin/perl
#
use warnings;use strict;
use Tk;

my $rep = '/mnt/home/lami20j';
opendir R_DIR,$rep
        or die "E/S : $!\n";

my @rep;
my $mw = MainWindow->new;
$mw -> title("Lister un répertoire");
$mw->Label(  -text => "\Ufichiers dans \E: $rep")->pack();
my $lst = $mw->Scrolled("Listbox",-scrollbars=>'e')->pack(
                                                -anchor => 'center',
                                                -ipadx  => '100',
                                                -ipady  => '100',
                                               );
while (my $fic = readdir(R_DIR)){
        next if $fic =~ /^\./; # saute les fichiers qui commencent avec .
        next if -d "$rep/$fic";# saute les répertoires
        push @rep,$fic;
}

# trier sans tenir compte de la casse
# un sort simple comme dans le 1er message
# c'est un tri asciibetique (les chiffres,les majuscule ensuite les minuscules)
# la fonction tri permet le tri alphabetique

sub tri { lc($a) cmp lc($b) };

$lst->insert('end',sort tri @rep);

$mw->Label(  -text => "Il y a ${ \(@rep+0) } fichiers.")->pack();
$mw->Button( -text => 'Quitter',
             -command => sub {exit},
           )->pack();


MainLoop;
lami20j

P.S. j'ai écrit dans mon 1er message perl -e 'use TK'
correct c'était perl -e 'use Tk'
-1

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 7
lami20j Messages postés 21331 Date d'inscription   Statut Modérateur, Contributeur sécurité Dernière intervention   3 570
 
Salut,

ici tu as aussi la situation 4 
#! /usr/bin/perl
#
use warnings;use strict;
use Tk;
#
my $rep = '/mnt/home/lami20j';
opendir R_DIR,$rep
        or die "E/S : $!\n";

my @rep;
my ($lst,$elem);

sub list_select{
        my @select = $lst->curselection();
        $elem = $lst->get($select[0]);
}

my $mw = MainWindow->new;
$mw -> title("Lister un répertoire");
$mw->Label(  -text => "\Ufichiers dans \E: $rep",
             -relief=> 'ridge',)->pack();
$lst = $mw->Scrolled("Listbox",-scrollbars=>'e',
                               -background => 'white',)->pack(
                                                              -anchor => 'center',
                                                              -ipadx  => '100',
                                                              -ipady  => '100',
                                                              );
$mw->Label( -textvariable => \$elem,
            -foreground => 'blue')->pack();


while (my $fic = readdir(R_DIR)){
  next if $fic =~ /^\./; # saute les fichiers qui commencent avec .
  next if -d "$rep/$fic";# saute les répertoires
  push @rep,$fic;
}

# trier sans tenir compte de la casse
# un sort simple comme dans le 1er message
# c'est un tri asciibetique (les chiffres,les majuscule ensuite les minuscules)
# la fonction tri permet le tri alphabetique
#
sub tri { lc($a) cmp lc($b) };

$lst->insert('end',sort tri @rep);

$mw->Label(  -text => "Il y a ${ \(@rep+0) } fichiers.",)->pack();

$mw->Button( -text => 'Affiche le fichier selectionné',
             -command => \&list_select,)->pack(-side => 'left',);

$mw->Button( -text => 'Quitter',
             -command => sub {exit},)->pack(-side => 'right',);
MainLoop;
lami20j
-1
Réponse 6 / 7
lavm01 Messages postés 69 Date d'inscription   Statut Membre Dernière intervention  
 
Merci c'est exactement ce que je voulais. Merci encore. C'est très gentil de ta part.
-1
lami20j Messages postés 21331 Date d'inscription   Statut Modérateur, Contributeur sécurité Dernière intervention   3 570
 
Re,

je me suis amusé un peu et j'ai fait 2 zones de liste.
j'utilise comme dossier parrent /mnt/home/lami20j
donc il faut le changer manuelement dans le script.

Dans la zone de gauche j'ai les sous-répertoires de /mnt/home/lami20j
Si je fait un clic sur un répertoire ( le point c'est le répertoire parrent) j'aurai les fichiers affichés dans la liste de gauche.

Dans les Label j'affiche le nombre des répertoires de répertoire parrent, le nombre des fichiers de répertoire correspondant et le sous-répertoire dans lequel se trouve les fichiers et aussi le fichier selectionné.

A modifier le répertoire parrent (ce qui est en gras). 
#! /usr/bin/perl
#
#use warnings;use strict;
use Tk;
#
my $mw = MainWindow->new;
my $rep = '/mnt/home/lami20j';
opendir R_DIR,$rep
        or die "E/S : $!\n";

my (@rep,@sous_rep,@fic);
my ($lst_f,$lst_r,$elem, $dossier,$nr);

sub list_select{
	my @select = $lst_f->curselection();
	$elem = $lst_f->get($select[0]);
}
sub rep_list{
	my @select = $lst_r->curselection();
	$dossier = $lst_r->get($select[0]);
	opendir R_LIRE, "$rep/$dossier"
		or die "E/S : $!\n";
	while (my $k =  readdir(R_LIRE)){
		next if $k =~ /^\./;
		next if -d "$rep/$dossier/$k";
		push @sous_rep,$k;
	}
	if ($dossier !~ /^\./){
		$dossier = $rep . '/' . $dossier;
	}
	else { $dossier = $rep;}
	$lst_f->delete(0,'end');
	$lst_f->insert('end',sort tri @sous_rep);
	$nr ="Il y a ${\ (@sous_rep + 0) } fichiers dans $dossier";
	@sous_rep=();
}
	

$mw -> title("Lister un répertoire");
$mw->geometry("800x400+60+30");
$mw->maxsize(800,600);

$lst_r = $mw->Scrolled("Listbox",-scrollbars=>'e',
			       -background => 'white',)->place( -x => 0,
			       					-y => 30,
			       					-width => 300,
								-height => 300,);
$lst_f = $mw->Scrolled("Listbox",-scrollbars=>'e',
			       -background => 'white',)->place( -x => 350,
			       					-y => 30,
			       					-width => 400,
								-height => 300,);
$lst_f->bind("<Button-1>",\&list_select);
$lst_r->bind("<Button-1>",\&rep_list);
	
$mw->Label(  -textvariable => \$dossier,
	     -foreground => 'purple',)->place( -x => 350, -y => 0,);
$mw->Label( -textvariable => \$elem,
            -foreground => 'blue')->place( -x => 280, -y => 370,);


while (my $fic = readdir(R_DIR)){
  next if $fic =~ /^\./; # saute les fichiers qui commencent avec .
#  next if -d "$rep/$fic";# saute les répertoires
  if ( -d "$rep/$fic"){
    push @rep,$fic;
  }
  else {
    push @fic,$fic;
  }
}
unshift @rep,".";

# trier sans tenir compte de la casse
# un sort simple comme dans le 1er message
# c'est un tri asciibetique (les chiffres,les majuscule ensuite les minuscules)
# la fonction tri permet le tri alphabetique
#
sub tri { lc($a) cmp lc($b) };

$lst_f->insert('end',sort tri @fic);
$lst_r->insert('end',sort tri @rep);

$mw->Label(  -textvariable => \$nr,
	     -foreground => 'brown',)->place( -x => 180 , -y => 350,);
$mw->Label(  -text => "$rep contient ${\(@rep-1)} répertoires.",)->place( -x => 0, -y => 0,);

$mw->Button( -text => 'Quitter',
	     -command => sub {$mw->destroy()},)->place( -x => 650, -y => 370,);
MainLoop;
lami20j

P.S. C'était pour s'amuser et faire la connaissance avec Tk
-1
Réponse 7 / 7
lavm01 Messages postés 69 Date d'inscription   Statut Membre Dernière intervention  
 
Merci très utile.
alp
-1
dysmas
 
Merci pour ce script, exactement ce que je cherchais.
Il ne resterait plus qu'à pouvoir changer de répertoire et on aurait un système complet de sélection de fichier. Je ferai cela un jour ou l'autre, je pense, sauf si vous l'avez déjà fait avant...
0

Discussions similaires

Disney HD n'est plus disponible
omaya.arf54 -
sodedo -

42 réponses
Disney.hd
Jimin -
dersf -

1 réponse
Disney HD
Emphiste -
MPMP10 -

1 réponse
Site maillotsdefootboll.tk qui c'est si c'est pas une arnaque
Benf -
Mb -

4 réponses
Problème d'emplacement Tk()
Pr.Witherfire -
Diablo76 -

6 réponses