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
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
| #! /usr/bin/perl
# A FAIRE : lorsque l'on remonte l'arbre, le filtre .pl ne fonctionne pas.
use warnings;
use strict;
use Tk;
# CREATION DE LA FENETRE
my $mw = MainWindow->new;
$mw -> title("InterPerl");
$mw-> geometry("800x600+60+30");
# INITIALISATION DES VARIABLES
my (@rep,@sous_rep,@fic,@total_fichier);
my ($ent,$lst_f,$lst_r,$elem, $dossier,$nr,$resume,$retour,$rep);
# INDICATION DU REPERTOIRE A TRAITER
if ($ent) {$rep = $ent;}
else {$rep = '.';}
opendir R_DIR,$rep or die "E/S : $!\n";
# CHOIX DU REPERTOIRE
sub dirDialog {
my $w = shift;
my $ent = shift;
my $dir;
$dir = $w->chooseDirectory;
if (defined $dir and $dir ne '') {
$ent->delete(0, 'end');
$ent->insert(0, $dir);
$ent->xview('end');
}
}
# sub SELECTION DANS LA LISTE DE DROITE - SCRIPT
sub list_select{
$elem=$resume= '';
my @select = $lst_f->curselection();
$elem = $lst_f->get($select[0]);
open IN, "<$elem" or die "$!";
while (my $line=<IN>){
if ($line =~ /^##/) { $resume .= $line; }
}
if ($resume =~ /##/){
$resume =~ s/## //g;
$retour = $resume;
}
else {$retour = $elem;}
}
# sub LECTURE DU DOSSIER
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=();
}
# DEFINITION DES CADRE-BOX
$ent = $mw->Entry(-width => 20);
$ent->place( -x => 0, -y => 25, -width => 200, -height => 20,);
my $but = $mw->Button( -text => "Browse", -command => sub { dirDialog($mw, $ent)});
$but->place( -x => 205, -y => 25, -width => 95, -height => 20,);
$lst_r = $mw->Scrolled(
"Listbox",
-scrollbars=>'e',
-background => 'white',
)->place(
-x => 0, -y => 45, -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);
# AFFICHE LE NOMBRE DE DOSSIER sub REP LIST
$mw->Label( -textvariable => \$dossier,
-foreground => 'purple',)->place( -x => 350, -y => 0,);
# AFFICHE LE NOM OU LE BUT DU SCRIPT sub LIST SELECT
$mw->Label( -textvariable => \$retour,
-justify => 'left',
-foreground => '#CC0063')->place( -x => 280, -y => 370,);
# TRAITEMENT REPERTOIRE ?
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;
}
elsif ( -f "$rep/$fic" && $fic=~/\.pl/) {
push @fic,$fic;
}
}
unshift @rep,".";
# TRI DU CADRE-BOX ?
# 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; |
actualisation en fonction d'action
Répondre avec citation
.
c'est clair ou au moins un peu plus. ?
Partager