#!/usr/bin/perl 
# remd: suprime (par defaut, option -f) les fichiers dégressivement depuis un    * 
# répértoire par comparaison a un modele. exemple:                               * 
#    ^trav   - tous les fichier commencant par trav                              * 
#    \.log$  - tous les fichiers finissant par .log                              * 
# ou le contenu d'un fichier avec l'option -c (contenu).expl: vide -c ./nsmail/* * 
# qui videra le contenu des fichier voulu dans /home/login/nsmail/Corbeille      * 
# Ce script supporte aussi les options -s (sureté: pour confirm avant effacement)* 
# ainsi que l'argument nom_de_repertoire.                                        * 
# usage: vd [-cfs] [nom_du_repertoire_a_traiter]                                 * 
# Ce script tourne convenablement  . ver 1.04 for System Unix/like  conçu par    * 
# conçu par Alain Adelmar  |   aadelmar@free.fr   |   Ven 10/07/2003  16:09:00   * 
#          Ce script fonctionne correctement dans les grandes lignes             * 
# Il peut être raccourci de la moitié au niveau de la procedure   first_use      * 
#---------------------------------//--$--//--------------------------------------¤ 
# system ('clear');    # a degager quand bon 
$i=0; 
$x = 'x=' x 30; # pour faire joli 
$pq = "\n$x\n"; # just for test 
$k = '-' x 10; 
$argv = 0; 
$args = $argc = "inexistant"; 
$quitte = "au_oui_vas_y"; 

if (@ARGV) { 
  
if ($ARGV[0] !~ /^-/) { 
    
$resp_dir = $ARGV[0]; 
    
$argv++; 
    
&first_use; 
  
} 
  
else { 
    
$argv++; 
    
$resp_dir = $ARGV[1]; 
    
(&first_use and $args = "s") if ($ARGV[0] =~ /^-\w?s/); 
    
(&vide_le) if ($ARGV[0] =~ /^-\w?c/); 
  
} 
} 
else { 
  
print "Usage: vd [-cfs] [nom_de_repertoire_a_traiter]\n-c --contenu vide le contenu de
fichier\n-f           efface les fichiers suivant un modéle (par defaut)\n-s              vous demandera
confirmation avant d'effacer quoi que ce soit (recommander\n\n"
; 
  
&first_use; 
} 

sub first_use { 

  
while ($quitte !~ /^q|n/) { 
    
if ($argv == 0) { 
      
print "nom du dossier ou vous voulez faire le menage\n"; 
      
chomp($resp_dir = <STDIN>); 
    
} 
    
&vide_le if (-f $resp_dir); 
    
unless (-d $resp_dir) { 
      
print "affiner votre séléction, ce repertoire n'existe pas\n"; 
      
#--------------------interesant pour sortir le path que l'on veux d'une reponse 
      
@rootdir = split(/\//, $resp_dir); 
      
#------------- 
      
print $pq; 
      
print @rootdir; 
      
print $pq; 
      
#-------------- 
      
for $i(0..($#rootdir -1)) { 
 
push @nrep, $rootdir[$i]; 
      
} 
      
$rep = join('/', @nrep); 
      
print "on est bon jusqu\'a $rep\n"; 
      
#-----------------------------------------------------------a réutiliser pour orienter l'user 
      
opendir DIR, "$rep" or die "Ouverture du repertoire $rep impossible $!"; 
      
@lsdir = readdir(DIR); 
      
closedir DIR or die "Fermeture impossible $!"; 
      
print "Vous étes actuellement dans $rep\nPeut être trouverez vous votre bonheur dans la liste
ci-dessous\n$x\n"
; 
      
foreach $f(@lsdir) { 
 
if (-d $f) { 
   
print "R $f\n"; 
 
} 
 
else { 
   
print "\t\t\tF $f\n"; 
 
} 
      
} 
      
#--------il faut pouvoir voir $rep 
      
print "\n$x\nEntrer un repertoire valide,\nou taper [go] pour opérer dans celui-ci\n"; 
      
chomp($resp_dir = <STDIN>); 
      
if ($resp_dir eq "go") { 
 
$resp_dir = $rep; 
      
} 
    
} 

    
if ($resp_dir !~ /\/$/) { 
      
$resp_dir .= "\/"; 
    
} 

    
opendir DIR, "$resp_dir" or die "Ouverture du repertoire $resp_dir impossible $!"; 
    
@lsdir = sort readdir (DIR); 
    
#closedir DIR || die "fermeture de $resp_dir impossible $!"; #je ferme plus bas 
    
foreach $file (@lsdir) { 
      
print "$file\n"; 
    
} 

    
print "\n$x\nPar quel modele voulez vous séléctionner le fichier à supprimer:\nexpl:\n\\.html\$ pour
tout les fichier qui finissent par .html\n^trav = tout les fichier commencant par trav\n * = tout les
fichier du repertoire\nR tout les fichiers et sous-repertoires\n"
; 
    
chomp($extini = <STDIN>); 
    
while (! &correcte($extini)) { 
      
print "\n$x\nveuillez entrer un modele correcte, expl:\nhtml\$\t\t pour les fichiers qui finissent
par html\n^foo \t\t pour tout les fichiers commencant par foo\n\nVous pouvez choisir des modeles plus
complexe expl:\n^\\w{2}\\d\\w{2}\t pour supprimer tous les fichiers qui commencent par 2
caractéres\n\t\t puis un chiffre puis 2 caractéres ou un motif plus simple expl:\n"
 . '\d.bak' . "\t\t
pour supprimer tous les fichiers ayant des chiffres comme nom de\n\t\t fichier et portant l'extantion
\.bak\n\nRappel: Si vous voulez définir un debut de motif (nom de fichier) placer un accent circonflexe
avant\nsi vous préférer définir la fin d'un motif (nom de fichier) placer le signe dollar aprés votre
modele\nexemple:\n=======\nhtml\$\t pour tout les fichier qui finissent par .html\n^trav \t pour tout
les fichier commencant par trav\n * \t pour tout les fichier du repertoire\nR \t pour tout les fichiers
et sous-repertoires\n"
; 
      
chomp($extini = <STDIN>); 
    
} 

    
# attention extention ne contient que 3 caract et non pas ".xxx" (4) 

  
LABELGOMME:foreach $f(@lsdir) { 
      
$file = "$resp_dir" . "$f"; 
      
# chomp $file; 
      
next if $f =~ /^\.{1,2}/; 
      
if ($extini eq "\*") { 
 
if (-e $file) { 
   
&confirm($f) if ($args eq "s"); 
   
print "$f a été effacer\n"; 
   
unlink $file or die "impossible de suprimer $f $!"; 
 
} 
 
else { 
   
$rep_a_traiter = "$file"; 
   
print "\n$k\n$f est un répértoire désirez vous y appliquer \"$extini\" aussi ?\n[oui,non]"; 
   
chomp ($suprime = <STDIN>); 
   
if ($suprime !~ /^n/i) { 
     
&montre; 
   
} 
 
} 
      
} 
      
elsif ($extini eq "R") { 
 
if (-d $file) { 
   
opendir SR, "$file" or die "Ouverture de $f impossible $!"; 
   
@lsd = readdir(SR); 
   
closedir SR || die "fermeture de $f impossible $!"; 
   
foreach $u(@lsd) { 
     
$srep = "$file" . "\/$u"; 
     
if (-d $u) { 
       
&confirm($u) if ($args eq "s"); 
       
system ("rm -r $srep"); 
     
} 
     
else { 
       
&confirm($u) if ($args eq "s"); 
       
unlink $srep or die "super crotte this $file is very not deleted $!"; 
     
} 
   
} 
 
} 
 
elsif (-e $file) { 
   
&confirm($file) if ($args eq "s"); 
   
print "$f a été effacer\n"; 
   
unlink $file or die "no puede esplosed this fucking file $!"; 
 
} 
      
} 
      
# comparaison avec motif 
      
elsif ($f =~ /$extini/) { 
 
if (-d $file) { 
   
$rep_a_traiter = "$file\/"; 
   
opendir DIRASUP, "$file" or die "ouverture de $rep_a_traiter impossible $!"; 
   
@lsdirp = sort readdir (DIRASUP); 
   
closedir DIRASUP || die "fermeture de $rep_a_traiter impossible $!"; 
   
print "\n$k\nrépértoire $file entre dans la descruption, il contient:\n\n"; 
   
foreach $e(@lsdirp) { 
     
$e = $rep_a_traiter . $e; 
     
print "\t$e\n"; 
     
push @ls_sup, $e; 
   
} 
   
print "\n$x\ndésirez vous y appliquer \"$extini\" aussi ?\n[oui,non,remove all]\n\t"; 
   
chomp ($suprime = <STDIN>); 
   
if ($suprime !~ /^n/i) { 
     
if ($suprime =~ /^r/i) { 
       
&confirm($file) if ($args eq "s"); 
       
print "$f a été effacer\n"; 
       
foreach $u(@ls_sup) { 
  
print "le fichier $u va etre effacer\n"; 
  
print "$u\n"; 
  
system ("rm -r $u"); 
       
} 
       
print "\nmaintenant le repertoire $file\n"; 
       
rmdir $file or die "supression de $rep_a_traiter impossible $!"; 
     
} 
     
else { 
       
print "\n Ok les fichiers:\n"; 
       
foreach $u(@ls_sup) { 
  
print "$u\n"; 
       
} 
       
print "seront ajoutés au autre pour être comparé au motif\n"; 
       
push @lsdir, @ls_sup; 
       
goto LABELGOMME; 
     
} 
   
} 
 
} 
 
#--- tout les fichiers simple qui matchent 
 
else { 
   
&confirm($f) if ($args eq "s"); 
   
print "$f a été effacer\n"; 
   
unlink $file or die "impossible de suprimer $file $!"; 
 
} 
      
} 
    
} 
    
closedir DIR or die "Fermeture impossible $!"; 
    
#system ('clear');   # non parcequ'il faut donner le temps a l'user de voir les transformations 
    
print "\n\n$x\nVoulez vous continuer, [Enter] continuer | [q] pour quitter\n"; 
    
chomp($quitte = <STDIN>); 
  
} 
} 

sub confirm($f) { 
  
my($f)=@_; 
  
print "\nok pour effacer $f ?"; 
  
chomp ($oui = <STDIN>); 
  
if ($oui =~ /^n/i) { 
    
next; 
  
} 
  
else { 
    
print "je vais donc supprimer $file \.\.\. \t"; 
  
} 
} 

sub correcte($ext) { 
  
my ($ext)= @_; 
  
if ($ext eq "") { 
    
return 0; 
  
} 
  
else { 
    
return 1; 
  
} 
} 

sub montre { 
  
opendir DIRASUP, "$rep_a_traiter" or die "ouverture de $f impossible $!"; 
  
@lsdirp = sort (readdir (DIRASUP)); 
  
closedir DIRASUP || die "fermeture de $f impossible $!"; 
  
print "dans $rep_a_traiter:\n"; 
  
foreach $el(@lsdirp) { 
    
if (-d $el) { 
      
print "le repertoire $el ... va être effacer\n"; 
    
} 
    
else { 
      
print "\t$el va être effacer\n"; 
    
} 
  
} 
  
&confirm($rep_a_traiter) if ($args eq "s"); 
  
print "$rep_a_traiter a été effacer\n"; 
  
(system ("rm -r $rep_a_traiter")) or die "supression de $rep_a_sup impossible $!"; 
} 

#----------------------------------------------vide -c 
sub vide_le { 
  
$f = $resp_dir; 
  
print "$resp_dir passer par vide_le\n"; 
  
unless (-f $f) { 
    
print "$f n'existe pas en tant que fichier, veuillez entrez un nom valide:\n"; 
    
chomp ($f = <STDIN>); 
  
} 
  
&confurm($f) if ($args eq "s"); 
  
open F, "< $f" or die "Ouverture de $f impossible $!"; 
  
@sav = <F>; 
  
close F or die "fermeture de $f impossible $!"; 

  
open F, "> $f" or die "Ouverture de $f impossible $!"; 
  
print F ""; 
  
close F or die "fermeture de $f impossible $!"; 
  
print "$x\nle fichier $f à été vider de son contenu, maintenant\n"; 
  
&menu; 
} 
  

sub choix { 
  
$menu =~ tr/A-Z/a-z/; 

  
if ($menu =~ /^q/) { 
    
die "$x\nTchao\n$x\n $!"; 
  
} 
  
elsif ($menu =~ /^r/) { 
    
print "$x\nLe contenu du fichier $f lui a ete restitué, maintenant\nvoulez vous:\n - Continuer avec un
autre: [Enter] (par defaut)\n - Quitter [q]\n\t"
; 
    
open F, ">$f" or die "Ouverture de $f impossible $!"; 
    
print F @sav; 
    
close F or die "fermeture de $f impossible $!"; 
    
chomp ($menu = <STDIN>); 
    
&choix; 
  
} 
  
else { 
    
&celui_la; 
  
} 
} 

sub menu { 
  
print "Voulez vous:\n - Continuer avec un autre: [Enter] (par defaut)\n - Quitter [q]\n - Récupérer $f
[R]\n\t"
; 
  
$menu = <STDIN>; 
  
chomp $menu; 
  
&choix; 
} 

sub confurm($f) { 
  
my($f)=@_; 
  
print "\nok pour effacer $f ?"; 
  
chomp ($oui = <STDIN>); 
  
if ($oui =~ /^n/i) { 
    
&menu; 
  
} 
  
else { 
    
print "je vais donc supprimer $f \.\.\. \t"; 
  
} 
} 

END;