Le but de ce TP est d'étudier la manipulation des fichiers en Perl.
L'élève curieux pourra également se reporter au TP analogue proposé en 2007 par Antoine Miné.
Aide
On rappelle qu'un script script Perl est un fichier texte d'extension .pl, tel toto.pl, qui commence par une ligne précisant l'interpréteur:
et qui est rendu exécutable par la commande chmod +x toto.pl. Dans cet exemple, on a forcé l'option -W qui active tous les avertissements paranoïaques de Perl (voir perlrun(1)).
Liens utiles:
- le cours
-
la documentation de Perl, en
particulier:
- la syntaxe (voir aussi perlsyn(1))
- les opérateurs (voir aussi perlop(1))
- les fonctions prédéfinies (voir aussi perlfunc(1))
- les expressions régulières (voir aussi perlre(1))
Exercice 1 - ls -l en Perl
-
Écrire un script Perl qui affiche le contenu détaillé d'un répertoire passé en argument (i.e. simulant la fonction ls -l) en utilisant la fonction stat.
-
Modifier votre script pour qu'il affiche les listes de fichiers comme un unique fichier (i.e. les trois fichiers fichier1.txt, fichier2.txt et fichier3.txt devront apparaître comme fichier[1-3].txt).
(On demande uniquement la liste des fichiers pas les informations supplémentaires - i.e. fonction ls simple).
#!/usr/bin/perl -W use File::stat; sub affiche_info($$) { ($nom_rep, $nom_fichier) = @_; $info = stat("$nom_rep/$nom_fichier") or warn "Erreur $nom_fichier: $!\n" and return; $mode = $info->mode; $perms = sprintf("%04o", $mode & 07777); $util = $info->uid; $taille = $info->size; $groupe = $info->gid; $acces = localtime($info->atime); $nom = $nom_fichier; print "$perms\t$util\t$groupe\t$taille\t$acces\t$nom\t\n"; } # ------------------------------------------------- $nom_rep = scalar(@ARGV) >= 1 ? $ARGV[0]: "."; # le repertoire est passe en argument ou # le repertoire courant si il n'y en a pas opendir(DIR, $nom_rep) or die "Erreur $nom_rep: \n$!"; print "Droits\tUtil.\tGroupe\tTaille\tDate d'acces\t\t\tNom\n"; print "-"x100; print "\n"; while (defined($nom_fichier = readdir(DIR))) { next if $nom_fichier =~ /^\..*/; affiche_info($nom_rep, $nom_fichier); } closedir(DIR); exit;
#!/usr/bin/perl -W sub formate(@) { my (@nombres) = @_; my @inters = (); my $bas = undef; my $precedent = undef; my $inter = undef; foreach my $n (sort {$a <=> $b} @nombres) { if (!defined($precedent) or $n != ($precedent + 1)) { push(@inters, $inter) if defined($inter); $bas = $n; $inter = "$n"; } else { $inter = "[$bas-$n]"; } $precedent = $n; } push(@inters, $inter) if defined($inter); return @inters; } sub affiche(%) { my (%groupes) = @_; foreach my $cle (sort keys %groupes) { my $groupe = $groupes{$cle}; my $debut = $groupe->{debut}; my $fin = $groupe->{fin}; my $nombres_ref = $groupe->{nombres}; if ($groupe->{vide}) { print "$debut$fin\n"; } if (defined($nombres_ref)) { my @inters = formate(@$nombres_ref); foreach my $inter (@inters) { print "$debut$inter$fin\n"; } } } } ################################################# ################################################# my $nom_rep = scalar(@ARGV) >= 1 ? $ARGV[0]: "."; # le repertoire est passe en argument ou # le repertoire courant si il n'y en a pas my @liste_fichiers = (); opendir(DIR, $nom_rep) or die "Erreur $nom_rep: $!\n"; while (defined(my $nom_fichier = readdir(DIR))) { next if $nom_fichier =~ /^\.\.?$/; push(@liste_fichiers, $nom_fichier); } closedir(DIR); # ecrit tous les noms de fichiers de $nom_rep dans # le tableau liste_fichiers my %groupes = (); # une table de hachage avec pour cles les # noms de fichiers sans les nombres foreach my $nom (@liste_fichiers) { my ($debut, $fin, $nombre); if ($nom =~ /^(.*\D)(\d+)(\D*)$/) { $debut = $1; $nombre = $2; $fin = $3; } else { $debut = $nom; $fin = ""; } # parse le $nom en debut,nombre,fin # fichier1.txt -> debut="fichier", nombre="1", fin=".txt" my $key = "$debut $fin"; my $groupe = $groupes{$key}; unless ($groupe) { my @nombres = (); $groupe = { debut => $debut, fin => $fin, nombres => \@nombres, vide => 0, }; $groupes{$key} = $groupe; } if (defined($nombre)) { my $nombres_ref = $groupe->{nombres}; push(@$nombres_ref, $nombre); } else { $groupe->{vide}++; } } affiche(%groupes); exit;
Exercice 2 - Renommer les fichiers
Écrire un script Perl qui renomme les fichiers d'un répertoire de manière à éviter les collisions dans un système de fichiers qui ne distingue pas les majuscules et les minuscules (comme HFS+ sur OS X).
sub formate($) { my ($nom_fichier) = @_; my ($nom, $rep, $ext) = fileparse($nom_fichier, '\..*?'); $rep = "" if $rep eq "./"; return ($nom, $rep, $ext); } sub propose_nouveau_nom($) { my ($nom_fichier) = @_; my ($nom, $rep, $ext) = formate($nom_fichier); my $nom_minus = lc($nom); my $ext_minus = lc($ext); my $cpt = "000"; do { ++$cpt; $nom_prop = "$rep$nom_minus" . "_$cpt" . $ext_minus; } while (-e $nom_prop); return $nom_prop; } sub renomme_fichier($) { my ($nom_orig) = @_; my $nom_nouv = propose_nouveau_nom($nom_orig); die "Erreur \"$nom_nouv\" existe deja\n" if -e $nom_nouv; print "Pret à renommer \"$nom_orig\" en \"$nom_nouv\"\n"; rename($nom_orig, $nom_nouv) or die "Erreur \"$nom_orig\" -> \"$nom_nouv\": $!\n"; } ################################################ ################################################ my $nom_rep = scalar(@ARGV) >= 1 ? $ARGV[0]: "."; opendir(DIR, $nom_rep) or die "Erreur $nom_rep: $!"; # le repertoire est passe en argument ou # le repertoire courant si il n'y en a pas my %coll; while (defined(my $nom_fichier = readdir(DIR))) { my ($nom, $rep, $ext) = formate($nom_fichier); my $nom_minus = lc($nom); my $ext_minus = lc($ext); push(@{$coll{"$rep$nom_minus$ext_minus"}}, $nom_fichier); } foreach my $key (keys %coll) { my @nom_fichiers = @{$coll{$key}}; next unless scalar(@nom_fichiers) > 1; foreach my $nom_fichier (@nom_fichiers) { renomme_fichier($nom_fichier); } } exit;
Exercice 3 - Effacement de gros fichiers
Écrire un script Perl qui recherche à partir d'un répertoire donné en argument les gros fichiers auxquels nul n'a accédé récemment. Un fichier de configuration contiendra, pour certaines extensions de nom de fichier, des règles spécifiques : ne pas tenir compte de la date de dernier accès, ne pas tenir compte de la taille du fichier, afin d'affiner la recherche des fichiers qu'il faut comprimer. Voici un exemple de fichier de configuration.
# # regles pour la liste %ext : # 1: affiche si le fichier est gros # 2: affiche si le fichier est vieux # 3: n'affiche jamais # %ext = ( ".tar" => 1 , ".dvi" => 2 , ".aux" => 2 , ".log" => 2 , ".ps" => 2 , ".tif" => 3 , ".tgz" => 3 , ".gz" => 3 , ".zip" => 3 , ".lzh" => 3 , );
#! /usr/bin/perl # Valeurs par defaut $bavard = 0; $grande_taille = 1048576; $jadis = time() - 604800; # Table des extensions de fichiers avec traitement special %ext = (); # Table des inodes visites %visited_inode = ( "dummy_inode" => 0 ); # # Recherche recursive sur le chemin passe en argument # # avec les regles suivantes : # ne pas explorer .. # ajouter chaque inode visite dans la table %visited_inode # et ne pas visiter chaque inode 2 fois # s'arreter si le chemin n'existe pas # continuer si il y a un lien symbolique # sub listerec { my( $path ) = @_; # read the argument my ($inode,$size, $atime) = (stat($path))[1,7,8]; unless( defined $inode ) { die "$0: $path n'existe pas\n" unless -l $path; return; } return if exists $visited_inode{$inode}; $visited_inode{$inode} = $path; if( -d $path ) { print "$path\n" if $bavard; opendir( ROOT , $path ) || die "$0: cannot open directory $path: $!\n"; my @dir = sort( readdir( ROOT )); closedir( ROOT ); foreach $file (@dir) { listerec( "$path/$file" ) unless $file eq ".."; } } else { $extension = $path; $extension =~ s/.*\./\./; if (defined ($control = $ext{$extension})) { return if $control == 1 and $size < $grande_taille; return if $control == 2 and $atime > $jadis; return if $control == 3; } return if $size < $grande_taille or $atime > $jadis; $prtsize = $size."B"; if( $size > 10240 ) { $prtsize = int( $size/1024 )."KB"; if( $size > 10485760 ) { $prtsize = int( $size/1048576 )."MB"; if( $size > 10737418240 ) { $prtsize = int( $size/1073741824 )."GB"; } } } $prttime = localtime( $atime ); print "${prtsize}\t$prttime\t$path\n"; } } ################################################## ################################################## # execute le fichier .grosfichiersconfig file comme # un script perl si il existe $_ = $ENV{"HOME"}."/.grosfichierconfig"; do $_ if -r $_; # Les options while( $ARGV[0] =~ /-/ ) { ($bavard = 1 , shift) if $ARGV[0] eq "-b"; $grande_taille = substr( shift , 2 ) if $ARGV[0] =~ /-t\d+/; $jadis = time() - substr( shift , 2 ) if $ARGV[0] =~ /-d\d+/; } die "Usage: $0 [-b] [-t] [-d ] [ [ fixe la taille en octers (par defaut 1Mo) -d fixe la duree sans acces au fichier (par defaut 1 semaine) " unless( @ARGV ); while( @ARGV ) { listerec( shift ); } exit 0;
Exercice 4 - Nettoyage
LaTeX, créé par Leslie Lamport, est un système logiciel de composition de documents. À partir d'un fichier source fichier.tex, un fichier fichier.dvi est créé en exécutant latex fichier.tex.
Si dans un répertoire donné un fichier .dvi est antérieur au fichier .tex correspondant, il est vraissemblable que le premier ne pourra pas être reconstruit à partir du second.
Écrire un script Perl qui supprime (dans un répertoire passé en argument) les fichiers .dvi, .log et .aux uniquement si le fichier .dvi est antérieur au fichier .tex correspondant.
#!/usr/bin/perl # solution de Jacques Beigbeider require "stat.pl"; open(LS,"ls *.pdf *.dvi *.log *.ps *.aux *.box 2> /dev/null|") || die "Unable to ls!\n"; @rm = (); $cmd = "ls -l"; while ($filename =) { chop $filename; $file = $filename; if ($file eq "texput.log" || $file eq "missfont.log") { push(@rm,$file); system("ls -l ".$file); next; } if ($filename =~ /\.aux$/ ) {$filename =~ s/\.aux$/.tex/; } elsif ($filename =~ /\.log$/ ) {$filename =~ s/\.log$/.tex/; } elsif ($filename =~ /\.ps$/ ) {$filename =~ s/\.ps$/.tex/; } elsif ($filename =~ /\.dvi$/ ) {$filename =~ s/\.dvi$/.tex/; } elsif ($filename =~ /\.pdf$/ ) {$filename =~ s/\.pdf$/.tex/; } elsif ($filename =~ /\.box$/ ) {$filename =~ s/\.box$//; } (@f = stat($file)) || next; (@g = stat($filename)) || next; if (@f[$ST_MTIME] > @g[$ST_MTIME]) { $cmd .= " $file"; push(@rm,$file); } } if (scalar(@rm) == 0) { print "Nothing to do!\n"; exit 1; } system($cmd); print "Ok to remove all of this ? "; $answer = ; if ($answer =~ /^[yYoO]/) { unlink @rm; print "Removed...\n"; exit 0; } exit 2;