Suppression d'ancien fichier en PERL

Suppression d'ancien fichier en PERL - Perl - Programmation

Marsh Posté le 14-11-2009 à 20:26:05    

Bonjour,
 
Cette commande shell:
find $TMP_DIR -mtime +7 -exec rm -f {} \;
 
Permet de supprimer tous les fichiers dont la date de créa/modif est supérieur à 7 jours.
 
Je voudrais simplement savoir si une personne peut me dire quel est son équivalence/traduction en langage PERL.
 
Merci d'avance,
++

Message cité 1 fois
Message édité par Sethenssen le 15-11-2009 à 20:38:16
Reply

Marsh Posté le 14-11-2009 à 20:26:05   

Reply

Marsh Posté le 14-11-2009 à 22:12:32    

Salut,
 
Pour réaliser la même chose que cette commande en perl, deux choix :
 
Lister les fichiers d'un répertoire, faire un stat pour récupérer leurs propriétés (dont la date de création modif), comparer leur date avec la date courante, puis unlinker le fichier s'il correspond aux critères.
 
Plus simplement tu peux aussi utiliser un module dédié genre File::Find ou File::Find::Rule.

Reply

Marsh Posté le 15-11-2009 à 11:17:13    

Sethenssen a écrit :

Bonjour,
 
Cette commande shell:
find $TMP_DIR -mtime +7 -exec rm -f {} \;
 
Permet de supprimer tous les fichiers dont la date de créa/modif est supérieur à 7 jours.
 
Je voudrais simplement savoir si une personne peut me dire quel est son équivalence/traduction en langage PERL.
 
Merci d'avance,
++


Le truc rapide quand on veut faire executer une commande shell et en récupérer le résultat:
my $cmd = "find $TMP_DIR -mtime +7";  (ou bien, my $cmd = "find $TMP_DIR -mtime +7 -print"; si la précédente ne suffit pas)
my @files = qx{$cmd};  
unlink @files;
 
ca peut probablement se faire en une ligne ainsi:
unlink qx{"find $TMP_DIR -mtime +7"};  
mais c'est a tester.
 
Le seul désavantage, c'est qu'on execute un shell externe au lieu de tout faire depuis perl, et que ça va impacter légèrement sur les performances.
 
Le plus propre, c'est d'utiliser le module File::Find, et l'utilitaire find2perl ( http://search.cpan.org/~dapm/perl- [...] nd2perl.PL ) qui transforme une commande find en une procédure perl appellée comme premier argument du find de File::Find
 
si je fais (sur mon pc, sous windows, d'ou le C:\Perl\bin\perl.exe -w)  
find2perl $TMP_DIR -mtime +7 -exec rm -f {} \;
ça me génère le script perl correspondant:
 

Code :
  1. #! C:\Perl\bin\perl.exe -w
  2.    eval 'exec C:\Perl\bin\perl.exe -S $0 ${1+"$@"}'
  3.        if 0; #$running_under_some_shell
  4.  
  5. use strict;
  6. use File::Find ();
  7.  
  8. # Set the variable $File::Find::dont_use_nlink if you're using AFS,
  9. # since AFS cheats.
  10.  
  11. # for the convenience of &wanted calls, including -eval statements:
  12. use vars qw/*name *dir *prune/;
  13. *name   = *File::Find::name;
  14. *dir    = *File::Find::dir;
  15. *prune  = *File::Find::prune;
  16.  
  17. sub wanted;
  18. sub doexec ($@);
  19.  
  20.  
  21. use Cwd ();
  22. my $cwd = Cwd::cwd();
  23.  
  24.  
  25. # Traverse desired filesystems
  26. File::Find::find({wanted => \&wanted}, '$TMP_DIR');
  27.  
  28.  
  29. sub wanted {
  30.    my ($dev,$ino,$mode,$nlink,$uid,$gid);
  31.  
  32.    (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&
  33.    (int(-M _) > 7) &&
  34.    doexec(0, 'rm','-f','{}','\;');
  35. }
  36.  
  37.  
  38. sub doexec ($@) {
  39.    my $ok = shift;
  40.    my @command = @_; # copy so we don't try to s/// aliases to constants
  41.    for my $word (@command)
  42.        { $word =~ s#{}#$name#g }
  43.    if ($ok) {
  44.        my $old = select(STDOUT);
  45.        $| = 1;
  46.        print "@command";
  47.        select($old);
  48.        return 0 unless <STDIN> =~ /^y/;
  49.    }
  50.    chdir $cwd; #sigh
  51.    system @command;
  52.    chdir $File::Find::dir;
  53.    return !$?;
  54. }


 
Bon après, on peut adapter, afin d'intégrer ça a son propre code.
Typiquement, je virerais l'exec avant le use strict, et les alias avec des globales *name, *dir et *prune à priori.
 
En plus, le code de find2perl est assez ancien, je ne suis pas sur qu'il marche encore bien (File::Find::find n'accepte pas '$TMP_DIR' avec ma version, il faut le mettre dans un array ($TMP_DIR)).
 
Bon en élaguant, on voit que grosso modo, le script peut se réduire à:
 

Code :
  1. #!/usr/bin/perl -w
  2. use strict;
  3. use warnings;
  4.  
  5. use File::Find;
  6.  
  7. # Traverse desired filesystems
  8. my $TMP_DIR = 'C:\Downloads';  #a remplacer par la valeur voulue dans son script
  9. File::Find::find(\&wanted, ($TMP_DIR));
  10.  
  11. sub wanted {
  12.    unlink $_ if (-f && (int(-M _) > 7));
  13. }


 
Ce qui veut dire que si on veut intégrer ça dans un script, il suffit d'ajouter
use File::Find;
en tête de script avec les autres use, et ($TMP_DIR étant alors défini)
File::Find::find(\&deleteOldFiles, ($TMP_DIR));
La ou on veut que l' action soit effectuée dans son script,  
ainsi que la subroutine
sub deleteOldFiles {
    unlink $_ if (-f && (int(-M _) > 7));
}
la ou on ajoute les subroutines (en fin de script, après le corps principal du script chez moi, mais ça pourrait être aussi en tête de script, avant le corps principal du script, c'est une question de style)
Bref :

Code :
  1. .....................
  2. use File::Find;
  3. .....................
  4. File::Find::find(\&deleteOldFiles, ($TMP_DIR));
  5. .....................
  6. sub deleteOldFiles {
  7.    unlink $_ if (-f && (int(-M _) > 7));
  8. }
  9. .....................


Note pédagogique:
if (-f && (int(-M _) > 7));  
c'est un idiome perl pour noter
if (-f $_ && (int(-M $_) > 7));  
le premier $_ est omis car c'est la valeur par défaut,  
et le _ devant le -M indique qu'on reprend le même argument que pour l'opérateur précédent de test de fichier (le -f ici).
 
Ca marche aussi probablement (j'ai pas testé) en virant le $_ devant le unlink, car c'est la valeur par défaut, mais c'est à réserver à ceux qui aiment vivre dangereusement.
 
Bon, une dernière réduction, utilisant les subroutines anonymes:

Code :
  1. .....................
  2. use File::Find;
  3. .....................
  4. File::Find::find({wanted => sub {unlink $_ if (-f && (int(-M _) > 7))}}, ($TMP_DIR));
  5. .....................


A+,


Message édité par gilou le 15-11-2009 à 12:38:02

---------------
There's more than what can be linked! --    Iyashikei Anime Forever!    --  AngularJS c'est un framework d'engulé!  --
Reply

Marsh Posté le 15-11-2009 à 20:20:07    

Excellent !
Merci beaucoup Gilou ça marche impec.
 
Ô Capitaine, mon capitaine  :jap:

Reply

Marsh Posté le 15-11-2009 à 21:29:57    

Notes que je lui ai fait supprimer que les fichiers [le test if (-f ], pas les répertoires. Si tu as besoin de supprimer les répertoires, le mieux a mon avis est de faire d'abord la suppression des fichiers, puis de faire celle des répertoires, lorsqu'ils sont devenus vide et ont plus de 7 jours (ou tout autre critère te convenant)
A+,


---------------
There's more than what can be linked! --    Iyashikei Anime Forever!    --  AngularJS c'est un framework d'engulé!  --
Reply

Marsh Posté le 22-09-2010 à 12:13:08    

Bonjour
 
 Merci Gilou
 Correspond à ce que je recherchais.  

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed