Ce programme perl prend les fichiers compressés dans d'autres formats (.tar.gz, .tgz. .tar.Z, et .Z pour cette itération) et les recompresse pour un meilleur résultat. Le source perl dispose de tous les types de documentation nécessaires sur ce qu'il fait et comment il fait ce qu'il fait. Cette dernière version prend les fichiers sur la ligne de commande. Sans argument en ligne de commande, il tente de recomprimer tous les fichiers du répertoire courant.
#!/usr/bin/perl -w ####################################################### # # # Ce programme prend les fichiers compressés et # # gzip-és dans le répertoire courant et les tranforme # # en fichiers bzip2. Il supporte proprement # # l'extension .tgz, produisant un fichier .tar.bz2. # # # ####################################################### $counter = 0; $saved_bytes = 0; $totals_file = '/tmp/machine_bzip2_total'; $machine_bzip2_total = 0; @raw = (defined @ARGV)?@ARGV:<*>; foreach(@raw) { next if /^bzip/; next unless /\.(tgz|gz|Z)$/; push @files, $_; } $total = scalar(@files); foreach (@files) { if (/tgz$/) { ($new=$_) =~ s/tgz$/tar.bz2/; } else { ($new=$_) =~ s/\.g?z$/.bz2/i; } $orig_size = (stat $_)[7]; ++$counter; print "Recompacte $_ ($counter/$total)...\n"; if ((system "gzip -cd $_ |bzip2>$new") == 0) { $new_size = (stat $new)[7]; $factor = int(100*$new_size/$orig_size+.5); $saved_bytes += $orig_size-$new_size; print "$new is about $factor% of the size of $_. :",($factor<100)?')':'(',"\n"; unlink $_; } else { print "Arrgghh! Quelque chose est arrivé à $_: $!\n"; } } print "Vous avez " , ($saved_bytes>=0)?"sauvé ":"perdu " , abs($saved_bytes) , " octets d'espace disque :" , ($saved_bytes>=0)?")":"(" , "\n" ; unless (-e '/tmp/machine_bzip2_total') { system ('echo "0">/tmp/machine_bzip2_total'); system ('chmod', '0666', '/tmp/machine_bzip2_total'); } chomp($machine_bzip2_total = `cat $totals_file`); open TOTAL, ">$totals_file" or die "Ne peut ouvrir le total sur tout le système: $!"; $machine_bzip2_total += $saved_bytes; print TOTAL $machine_bzip2_total; close TOTAL; print "Ceci nous donne un total de ",`cat $totals_file`," octets sauvés sur tout le système.\n";