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