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
91
92
93
94
95
96
97
98
99
100
| use Tkx;
#======================================================
# Création de la fenetre
my $mw = Tkx::widget->new(".");
$mw->g_wm_minsize(500, 400); # Taille minimum de la fenetre
#======================================================
# On lui ajoute une listeBox
# que l'on positionne sur la deuxième ligne/première case du grid, à savoir la 0 1
($lb = $mw->new_tk__listbox(-height => 5))->g_grid(-column => 0, -row => 1, -sticky => "nwes");
#======================================================
# A la listeBox, on ajoute la propriéte de pouvoir etre scrollée
# la position choisie est la deuxième colonne ( c'est a dire a droite de la listeBox
($s = $mw->new_ttk__scrollbar(-command => [$lb, "yview"],
-orient => "vertical"))->g_grid(-column =>1, -row => 1, -sticky => "ns");
$lb->configure(-yscrollcommand => [$s, "set"]);
#======================================================
# Lorsque qu'on modifie la taille de la fenetre, on veut que la scrollbar de la listeBox
# soit modifiée
($mw->new_ttk__sizegrip)->g_grid(-column => 1, -row => 2, -sticky => "se");
$mw->g_grid_columnconfigure(0, -weight => 1); $mw->g_grid_rowconfigure(1, -weight => 1);
#======================================================
# Choix du répertoire et filtre
$dirname = Tkx::tk___chooseDirectory();
#======================================================
# Création d'un label qui contient le nom du répertoire à explorer
($mw->new_ttk__label(-text => "$dirname",
-anchor => "w"))->g_grid(-column => 0, -row => 0, -sticky => "we");
# Tkx::update();
# On écrase le label du bas pour y insérer le suivi
($mw->new_ttk__label(-text => "En cours...",
-anchor => "w"))->g_grid(-column => 0, -row => 2, -sticky => "we");
# Pour rafraîchir l'affichage ( en particulier pour les affichages des labels )
Tkx::update();
# Progress bar
$pgb = $mw->new_ttk__progressbar(-orient => 'horizontal', -length => 200,
-mode => 'determinate');
$pgb->g_grid(-column => 0, -row => 3, -sticky => "we");
$pgb->start();# appel de la méthode start
Tkx::update();# il faut rafraichir
my $Repertoire = $dirname;
my @LesFichiers = ListersFichiers($Repertoire);
# On filtre la liste des fichiers
my $extension = "txt";
my @ListeFiltre;
#======================================================
foreach $nomfichier (@LesFichiers) {
$ext = substr($nomfichier,length($nomfichier)-3,3);
# Comptage des fichiers du type choisi
if ( $ext eq $extension ) {
push ( @ListeFiltre, "$nomfichier" );
}
}
#======================================================
# On ajoute chaque element dans la liste Box
my $c2 = 0;
foreach $nomfichiertri (@ListeFiltre) {
$lb->insert("end", "$nomfichiertri");
}
#======================================================
($mw->new_ttk__label(-text => "Fini.",
-anchor => "w"))->g_grid(-column => 0, -row => 2, -sticky => "we");
$pgb->stop();
Tkx::MainLoop();
exit;
#======================================================
#======================================================
# Procédure qui permet de parcourir tous les sous répertoires
# d'un répertoire donné
# Nombre d'arguments : 1
# Argument(s) : un répertoire ($repertoire)
# Retourne : Tableau de fichier (@fichiers)
#======================================================
sub ListersFichiers {
my ( $repertoire ) = @_;
my @fichiers;
# Ouverture d'un répertoire
opendir (my $FhRep, $repertoire)
or die "impossible d'ouvrir le répertoire $repertoire\n";
# Liste fichiers et répertoires sauf (. et ..)
my @Contenu = grep { !/^\.\.?$/ } readdir($FhRep);
# Fermeture du répertoire
closedir ($FhRep);
# On récupère tous les fichiers
foreach my $nom ( @Contenu ) {
Tkx::update(); # pour rafraichir la progressbar
# Fichiers
if ( -f "$repertoire/$nom") {
push ( @fichiers, "$repertoire/$nom" );
}
# Repertoires
elsif ( -d "$repertoire/$nom") {
# recursivité pour parcourir les sous-répertoires
push ( @fichiers, ListersFichiers("$repertoire/$nom") );
}
}
return @fichiers;
} |
