Le but de ce topic:
Poster des snippets de code perl utiles, écrits pour résoudre un problème simple ou complexe, et dont la solution ne se trouvait pas dans les 10 premières pages d'une requête google ad-hoc.
 
Ne postez pas de questions pour resoudre un probleme ici, mais creez un topic dédié a votre problème dans la catégorie perl.
Si vous lisez l'anglais, un excellent tutorial basique sur Perl ici: http://www.chankeypathak.com/2011/ [...] orial.html
Un excellent livre d'introduction au Perl moderne, en version gratuite et payante ici: http://onyxneon.com/books/modern_perl/
Un bouquin de haut niveau, pour les programmeurs maîtrisant bien Perl, en version gratuite et payante ici: http://hop.perl.plover.com/book/
 
A+,

Bon mon premier snippet est lié a un problème courant: modifier dynamiquement l'array des répertoires que lit perl pour trouver un module.
 
Le probleme concret:
Je développe un package, par exemple Harkonator.pm, avec des sous packages: Harkonator::XML, Harkonator::XSL etc
Je veux pouvoir écrire des modules de tests du package ou des sous packages, donc avec des lignes comme use Harkonator; ou use Harkonator::XML;
Mes modules de test sont situés quelque part dans la hierarchie des sous répertoires de Harkonator (et peuvent être deplacés).
 
Comme c'est en phase de dévellopement, Harkonator n'est pas dans un des paths de @INC (c:\perl\lib, etc chez moi), et je n'ai pas envie de modifier en dur @INC, au cas ou je deplace Harkonator.
Je veux donc modifier dynamiquement @INC pour que perl, en lançant un module de test, puisse trouver les modules de mon package Harkonator.
 
Il y a une méthode possible et documentée: lancer perl avec un flag -I, mais je voudrais que le module de test fasse lui même le boulot dans son code.
 
Il y a une méthode documentée, passer par un use lib "le bon path";
Comme je ne voulais pas coder "le bon path" en dur, j'ai commencé à le récupérer à partir de getcwd(), dans une variable $le_bon_path, mais je me suis alors aperçu d'un probleme: comme les lignes use sont executées avant tout code du module (même un bloc BEGIN), l'appel a use lib $le_bon_path; était executé avant que $le_bon_path soit initialisé a la bonne valeur.
Apres avoir fouillé la doc, j'ai trouvé que use FindBin qw($Bin); avec un use, donc executé dans l'ordre des use rencontrés dans le programme, me permettait de recuperer le path de mon script de test.
La solution que j'utilise donc au final est la suivante:
 

#!/usr/bin/perl -w
 
#Adjust library path
use FindBin qw($Bin);
use lib split(/Harkonator.*/,$Bin); 
#The module to test
use Harkonator::XML;
................

$Bin a le path jusqu'a mon module de test
split(/Harkonator.*/,$Bin) va créer une liste de scalaires a un seul élément, donc un scalaire en fait, qui va être la valeur de tout le path jusqu'a Harkonator (exclus).  
A+,

Un autre snippet tres pratique, que j'avais posté dans ce forum:
 
On a un fichier texte, avec un nombre de champs fixes séparés par un séparateur, par exemple un fichier csv.
On veut trier le fichier suivant certains champs.
On peut procéder ainsi:
 

@out = map $_->[0],
    sort {
            $a->[1] cmp $b->[1] or
            $a->[2] <=> $b->[2]
        }
    map [$_, split /;/], <$FILE>;

ou le ; dans le split /;/ peut être remplacé par le séparateur propre au fichier, et ou les tris a l'intérieur du sort {} sont a adapter en fonction des champs que vous voulez trier.
Dans l'exemple donné, on a un fichier dont le séparateur est ; qui a au moins deux champs, et on fait un tri alphabétique sur le premier champ et un sous tri, numérique sur le second champ.
 
Comment ca marche:
map [$_, split /;/], <$FILE>; ca applique [$_, split /;/] a chaque ligne du fichier ouvert en lecture.
Donc pour chaque ligne, on crée une référence à un tableau anonyme, dont le premier élément est la ligne (ca permet de la sauvegarder) et les éléments suivants sont les champs de la ligne (comme résultat de la fonction split).
Donc si la ligne avait n champs, le tableau anonyme a n+1 éléments.
le resultat du map est alors un tableau dont chaque ligne est une reference a un tableau anonyme comme décrit précédemment.
On va trier ce tableau de references a un tableau anonyme, en y appliquant l'operateur sort, et en définissant la fonction de tri.
Si on veut accéder au k-ieme champ des données initiales, on va le trouver en position de k+1-eme élément d'un tableau anonyme, ce qui va être accédé comme $a->[k] (ou a représente la reference au tableau anonyme), sachant que $a->[0] est lui la ligne initiale.
Pour trier suivant le k-ieme champ, on écrira donc dans la fonction sort:
$a->[k] cmp $b->[k] si le tri est alphabetique ou $a->[k] <=> $b->[k] s'il est numérique.
Si on veux effectuer un sous tri sur un autre champ, on peut l'enchainer avec un or après le premier tri, etc.
Voir la documentation de sort si on veut d'autres criteres que alphabetique ou numerique pour le tri d'un champ.
Apres le sort, on a donc un un tableau dont chaque ligne est une reference a un tableau anonyme, trié selon nos criteres. Il suffit donc de recuperer les lignes initiales dans un tableau pour les avoir triees, et comme les lignes initiales étaient sauvegardées dans le élément du tableau anonyme, c'est ce que l'on fait avec map $_->[0], appliqué au tableau trié: pour chaque élément (reference a un tableau anonyme) on recupere le premier élément du tableau anonyme, c'est a dire la ligne initiale.
 
A+,

Un snippet court.
Pour découper une chaine de caractères en sous chaines de longueur fixée, placées dans un array, on peut proceder ainsi:

@string_parts = $string =~ /(.{1,$maxSize})/go;

A+,

A ceux qui utilisent la version d'Active State, en particulier les perleux sous windows, il y a eu une nouvelle release en début de semaine: ActivePerl-5.10.1.1006
Je n'ai eu aucun problème a l'install, après installation, j'ai lancé ppm, mis a jour les packages qui ne l'étaient pas.
3 problemes mineurs a régler:
* l'upgrade de HTTP-Response-Encoding dépend de celui de Encode qui refuse de s'installer a cause d'un conflit avec un fichier Perl/html/site/lib/Encode.html installé par Win32-Encode. Après avoir été y regarder de plus près, le fichier Perl/html/site/lib/Encode.html était mal installé, il aurait du se trouver en Perl/html/site/lib/Real/Encode.html Je l'ai donc déplacé et fait ensuite un upgrade forcé de Encode en ligne: "prompt>ppm install Encode --force"  puis un upgrade de HTTP-Response-Encoding
* les deux upgrades de Win32-Process-Suspend et Win32-Process-Critical refusaient de s'installer a cause d'un conflit avec un fichier Perl/site/lib/Win32/Process/demo.pl installé par Win32-Process-Kill. Après avoir été y regarder de plus près, j'ai vu que chaque package voulait installer son propre package de demo sous le même nom, au même endroit. j'ai renommé demo.pl en demo-kill.pl, fait ensuite un upgrade forcé de Win32-Process-Suspend, renommé le demo.pl que cet upgrade a installé en demo-suspend.pl, fait ensuite un upgrade forcé de Win32-Process-Critical, renommé le demo.pl que cet upgrade a installé en demo-critical.pl, créé a tout hasard un fichier demo.pl contenant ce qu'il y a dans demo-kill.pl, demo-suspend.pl, demo-critical.pl, et basta!
 
A noter que l'install de la nouvelle release d'ActivePerl fait perdre les infos que l'on avait dans un ppm d'une installation précédente pour les packages et les repositeries (j'ai du les remettre dans ppm après installation), mais c'était clairement indiqué dans les releases notes.
 
A+,
 

Un truc que je viens de poster en réponse:
Comment rediriger un des handles standard?
Mon exemple porte sur STDERR, redirigé dans un fichier, mais se généralise facilement à STDIN et STDOUT:

#!/usr/bin/perl
 
    open(SAVED, ">&STDERR" );                                  # stockage du handle de STDERR pour restoration ulterieure
    open(STDERR, ">err.log" ) || die "Can't redirect STDERR";  # ouverture du fichier de log identifié maintenant comme STDERR
    select(STDERR); $| = 1;                                    # pas de bufferisation
    .................................
    # do some stuff
    .................................
    close(STDERR);                                              # fermeture du fichier de log identifié  comme STDERR
    open(STDERR, ">&SAVED" );                                   # restauration de STDERR

 
Noter que si on n'est pas concerné par STDIN, on peut aussi utiliser le module use IO::CaptureOutput.
 
A+,

Il y a déjà ce dont tu as besoin ici. Tu peux d'ailleurs participer à son évolution.

Merci pour ce spam, mais ma participation a ce forum me suffit, et j'ai déjà les mains pleines entre cette section, discussion, et les deux autres forums ou j'interviens souvent (forum babel et forum japon).
D'autre part, sur le topic que tu cites, il y a de nombreux snippets qui n'ont rien d'astucieux, mais qui sont de simples bouts de codes a la portée de tout novice, un exemple:

#!/usr/bin/perl 
use strict;
use Carp;
&date_h_j();
sub date_h_j{
    my @tab_date =localtime(time);
    my $jour = $tab_date[3];
    my $mois = ($tab_date[4]+1);
    my $annee =  ($tab_date[5]+1900);
    my $heure = $tab_date[2];
    my $minute = $tab_date[1];
    my $sec= $tab_date[0];
 
    print "$jour/$mois/$annee, $heure:$minute:$sec\n";
}

Il n'y a pas "d'astuce" ici, c'est une application simple des librairies de base. Le but de ce topic est de poster des bouts de code illustrant des techniques réutilisables et astucieuses.
Incidemment, j'aurais écrit:

sub date_h_j{
    my ($sec, $minute, $heure, $jour, $mois, $annee) = localtime(time);
    $mois++;
    $annee += 1900;
 
    print "$jour/$mois/$annee, $heure:$minute:$sec\n";
}

Autre exemple (qui me fera une astuce pour ce topic):
 $texte =~ s/^\s+//;
 $texte =~ s/\s+$//;
On peut écrire ceci ainsi:
 $texte =~ s/^\s+|\s+$//og;

A+,

Un petit snippet court (lu sur stackoverflow).
 
Comment sommer terme a terme deux arrays de même taille @array1 et @array2?

Explication:
$#array1 est l'indice maximal (commun) des deux tableaux
0 .. $#array1 est évalué comme l'array (0, 1, ..., $#array1)
map crée un nouvel array en appliquant $array1[$_] + $array2[$_], ou l'on remplace $_ par chaque élément de l'array auquel il s'applique, et qui est ici  (0, 1, ..., $#array1).
On a donc $sums[i] = $array1[$_] + $array2[$_]  ou $_ est remplacé par l'élément d'indice i élément de  (0, 1, ..., $#array1). Or cet élément d'indice i vaut i, par construction.
donc $sums[i] = $array1[i] + $array2[i],  qui est ce que l'on voulait obtenir.
 
A+,
 
 

pas mal ce one-liner
 
j'ai toujours eu un peu de mal avec les map

Si vous utilisez le perl maintenu par ActiveState (quasiment le standard sous Windows, sauf pour ceux utilisant Cygwin), il y a maintenant une version 5.12 disponible.
A+,

C'est pas vraiment une astuce, mais une clarification bonne a retenir:
Quelle est la différence entre un  

foreach (@array) {
...
}

et un

foreach my $i (@array) {
...
}

Voici la réponse:

foreach (@array) {
# ici, la variable de boucle est $_
# c'est une variable dont la portée est la boucle
# si $_ était définie avant la boucle, elle retrouve sa valeur après la boucle
}
 
foreach my $i (@array) {
# ici, la variable de boucle est $i
# $_ n'est pas modifiée localement, et si elle avait une valeur avant la boucle
# elle la conserve dans la boucle (au lieu d'avoir une valeur locale identique à celle de la variable de boucle)
}

 
A+,

c'est quasi évident ça quand même, non ?

Que le $_ ne soit pas affecté localement quand le $i l'est, c'est pas idiot, mais c'est pas évident. On pourrait avoir un mécanisme général sur $_, et une affectation $i = $_ à chaque tour de boucle, vu qu'il y a systématiquement création d'une variable locale à la boucle: si on fait:

my $i = "une valeur";
foreach $i (@array) {
...
}

Une fois la boucle exécutée, $i vaut "une valeur" et non la dernière valeur affectée à $i dans la boucle. On aurait pu croire que le non emploi du my faisait qu'on utilisait la variable déjà définie, or il n'en est rien, il y a création systématique d'une variable locale de portée la boucle (qu'on pourrait donc penser être $_).
A+,

Bon, chaqun à son niveau mais voila quelques trucs que j'utilise souvent et qui me viennent en tete :
 
####################
 
Je veux arrondir mais en gardant 2 décimales :
int(100*$val + 0.5) / 100
 
Même chose pour afficher un pourcentage :
print( (int(10000*$val/$tot + 0.5) / 100 )."%\n" );  # attention a la division par 0
 
####################
 
J'utilise des modules, mais mon script est capital à l'acces à mon serveur.
Si j'utilise use, il suffit qu'un module disparaisse du disque ou devienne corrompu et c'est fini.
Dans ce cas, j'utilise require le plus pres possible des fonctions que j'utilise (mais pas dans une boucle) et j'appelle ces fonctions avec le nom du module, ex :
 
require MIME::Base64;
$enc = MIME::Base64::encode_base64($var);
 
####################
 
Je veux identifier chaque ip sous une valeur numérique.
Personnellement, j'utilise cela lorsque je veux demander de taper le mot de passe d'un tableau de mots de passes (ex: taper la case H7)
 
Dans ce cas :

Ainsi, l'utilisateur a beau rafraichir la page, on lui demandera toujours H7, et non pas celle qu'il veut.

Si on veut juste arrondir à deux décimales un nombre, la technique normale est de faire: $mynumber = sprintf("%0.2f", $mynumber);
A+,

Salut,
merci je découvre
Mais c'est différent. Dans ton cas, ca conservera les zeros inutiles.

Si tu ne veux pas les zéros inutiles, tu fais $mynumber = sprintf("%0.2g", $mynumber);  
A+,

Tiens, voici une astuce toute bête, un "idiom", qui quand on la rencontre pour la première fois, fait dire: mais bien sur! comment n'y ais-je pas pensé avant.
Comment échanger le contenu de deux variables en une ligne de code:
($i, $j) = ($j, $i);
A+,

L'astuce du jour:
Je regardais certains des problèmes de langref.org

La solution du formatage d'une liste qu'ils proposaient ne me semblais pas géniale, j'ai pondu la mienne:

sub myjoin {
    return "" unless (scalar @_);
    return $_[0] unless (@_ > 1);
    return join(", ", @_[-@_..-2]) . " and " . $_[-1];
}

Bon ensuite on peut adapter selon ses besoins:
Si on veut ajouter un point final à une chaine non vide, on pourra faire

sub myjoin {
    return "" unless (scalar @_);
    return $_[0]."." unless (@_ > 1);
    return join(", ", @_[-@_..-2])." and ".$_[-1].".";
}

Le même avec la première lettre en majuscule:

sub myjoin {
    return "" unless (scalar @_);
    return ucfirst($_[0])."." unless (@_ > 1);
    return ucfirst(join(", ", @_[-@_..-2]))." and ".$_[-1].".";
}

Le même avec la première lettre de chaque item en majuscule:

sub myjoin {
    return "" unless (scalar @_);
    return ucfirst($_[0])."." unless (@_ > 1);
    return join(", ", map {ucfirst} @_[-@_..-2])." and ".ucfirst($_[-1]).".";
}

Le même avec la première lettre de chaque item en majuscule et le reste en minuscule:

sub myjoin {
    return "" unless (scalar @_);
    return ucfirst(lc($_[0]))."." unless (@_ > 1);
    return join(", ", map {ucfirst(lc($_))} @_[-@_..-2])." and ".ucfirst(lc($_[-1])).".";
}

Bon, ce qu'il faut retenir de l'exemple initial:
On teste le longueur de la liste des arguments passée en paramètre (la liste @_ d'un sub), en faisant scalar @_  (variante possibles: 0+@_, int(@_))
S'il y a rien on renvoie une chaîne vide, si la liste contient un unique élément, on le renvoie. $_[i] est le i+1-ième élément de @_
S'il y a au moins deux éléments dans @_, c'est la que ça devient intéressant:
on renvoie la concaténation de la sous liste de tous les éléments sauf le dernier, séparés par ", ", suivi de "and et du dernier élément.
Pour la concaténation..., on va bien sur utiliser join ", ", ...
La sous liste de tous les éléments sauf le dernier: @_[-@_..-2]: @_[m..n] c'est la sous liste du m+1-ième élément au n+1-ième élément de @_ (note: c'est une copie effectuée à partir de @_, cela n’accède pas en direct aux éléments de @_).
En perl, m..n représente la liste (m, m+1, m+2, ..., n). Si n < m cette liste est vide. @_[0..@_-1] est donc une copie de @_ par exemple
En perl dans les listes, les indices négatifs sont comptés à partir de la fin: @_[-1] est une liste qui a pour élément le dernier élément de @_, etc.
Donc @_[-@_..-1] est encore une copie de @_  (même nombre d'éléments et même dernier élément).
@_[-@_..-2] est donc une copie de @_, sauf son dernier élément ($_[-1] pour des raisons expliquées dans ce qui précède).
Une dernière remarque, les indices d'une liste @list varient de 0 à $#list en perl (c'est une autre notation pour $list[-1]). Dans le cas de la liste @_, ils varient donc de 0 à $#_ (!) Si je voulais rendre le code plus opaque, je pourrais remplacer $_[-1] par $_[$#_] par exemple.
On pourrait donc aussi réécrire la subroutine initiale comme:

sub myjoin {
    return "" unless (@_+0);
    return $_[0] unless (@_>1);
    return join(", ", @_[0..$#_-1])." and ".$_[$#_];
}

A+,

tu devrais faire du scheme plutot que du Perl

J'ai longtemps fait du smalltalk (mais c'est loin maintenant tout ça)
 
Bon pour rester dans le sujet, Active State a release une nouvelle version de Perl 5 en février, je l'installe dès que j'ai un peu de temps dispo.
 
A+,

qu'est ce que la version active state a de plus que la distribution normale ?

C'est quoi, la distribution normale?? Sur PC, je connais que deux distributions binaires de Perl: celle d'Active State et celle de Strawberry Perl.
Celle d'Active State a pour elle d'être assurée par une boite qui en vit entre autres, et a toujours sorti un produit de qualité, depuis plus de'une douzaine d'années. C'est la plus employée.
A+,

Bon, j'ai fait une installation clean de la dernière version d'Active State

L'installation s'est faite sans pb. Ne pas oublier de lancer PPM pour mettre à jour les modules, puis de lancer ensuite CPAN dans une fenêtre dos pour l'initialiser et avoir le cas échéant l'installation automatique de Mingw et dmake.
 
J'ai l'impression que PPM est nettement plus rapide et solide (mais c'est peut être parce que j'ai 250 modules installés en local contre 12 000 dans ma précédente installation).
 
A+,

On peut savoir l'intérêt de poster ce qui correspond à une version d'il y a deux ans? (le mien, c'était pour la dernière version binaire dispo sur PC/Windows, la prochaine sera probablement pas avant un an comme d'hab) Avec tout le texte? (j'avais édité le mien afin de ne laisser que les infos dépendant de la release) Et sans aucun commentaire?
A+,

dernière version stable standard distribuée sous ubuntu
 
aucune mention d'active state donc, c'est ça que je voulais souligner

Encore fallait il souligner que c'était sous Ubuntu. Je vois pas pourquoi ils seraient mentionnés, puisque leur savoir faire porte sur essentiellement sur la compilation des sources sur Windows, plus des outils de gestion de 12 000 packages binaires prets a l'emploi des modules de CPAN (contrairement à l'emploi direct de CPAN, ou il faut recompiler en bout de chaîne).
Active State a des versions linux (.rpm et .tar.gz), mais je ne les connais pas, je suppose que la pratique courante sous linux, c'est d'aller chercher les sources et de recompiler, ce qui n'est pas un pb sur cette plateforme. Au vu de www.perl.org, la v5.12.3 est la dernière version stable dispo.
A+,

A l'époque où je faisais du Perl sous Windows, les ppm d'activestate ne constituaient pas _toujours_ une solution efficace pour installer des modules. J'ai le souvenir de pas mal de modules dont l'installation était tout simplement impossible avec ppm.

Actuellement, soit un module est dans le base des PPMs (un peu plus de 13 000) actuellement et il s'installe, sauf conflit avec un autre module, et au vu du nb de conflits constatés sur 2000 modules, ça doit concerner 25 à 30 modules sur 13 000. Sur ces 25 à 30, la majorité des conflits portent sur des fichiers exemples portant un nom identique, et c'est aisément corrigeable, et quelques uns portent sur un module voulant faire régresser la version d'un autre module déjà installé, et la, j'apprécie le fait que le système d'active state le détecte, tout comme le fait qu'il détecte et installe les modules manquants dont dépend une installation.
Ce que ne sait pas faire le système d'Active State, c'est gérer l'installation de modules qui nécessitent une interactivité (ie l'installation va poser des questions à l'utilisateur).
Pour cela, et les modules qui ne sont pas dans les 13 000, il y a l'outil CPAN fourni par Active State, qui marche particulièrement bien, mais est moins simple à utiliser.
La combinaison PPM + CPAN permet habituellement d'installer tout module utile.
 
De toute façon, faudra m'expliquer qu'il y a mieux sur PC/Windows pour faire ça, parce que la seule autre solution compilée, c'est Strawberry Perl, et j'ai pas eu des échos que ça gère mieux l'install des modules.
A+,

Tiens, je viens de m'apercevoir que Active State a mis une nouvelle version dispo depuis le 20 juillet.

Au vu des nombreux ajouts et amélioration des perfs (concaténation de chaines 100 fois plus rapide, compilation des expressions régulières plus rapide), et corrections de bugs, je conseille vivement a tous ceux qui n'ont pas de raison de rester avec une ancienne version (telle que utilisation d'un module obsolète ou pas porté pour cette version) d'upgrader leur version.
A noter parmi les nouveautés:

A noter aussi ce paragraphe dans la section correction de bugs:

 
A+,

J'ai testé en mettant à jour la distribution avec ppm; c'est beaucoup beaucoup plus rapide cette nouvelle version!  
A+,

Tiens, Gilou, j'en profite que tu sois dans le coin. Pour un dev dont nous avions besoin au boulot, le choix s'est porté sur Perl. Il s'agit d'un eventhandler Nagios (le truc qui est appellé quand une alarme se déclenche pour envoyer une notification).
 
On avait démarré en partant sur des threads + variables partagées + Thread::Queue. (grosso modo, spawner des thread qui discutent avec divers serveurs de notification différents, et leur donner des evenements en entrée via des queues, tout en partageant une structure qui permet de définir dans quel thread on doit placer les alarmes qui arrivent en entrée).
 
Enfin pour être plus précis :
 
On a des messages qui arrivent => on consulte une première structure qui permet de les forwarder au thread qui doit les faire parvenir au bon serveur de notification (ca peut être du SNMP, ou du mail, ou du SMS par exemple en fonction de l'alarme). On enqueue les messages dans le bon thread via Thread::Queue. Le thread traite le message via des règles toujours définies dans une structure partagée (ca permet de les mettre a jour périodiquement au besoin).
 
Retour d'expérience, ca marche bien, mais ca a été une horreur pour contenir les memleaks, et spawner des threads c'est hyper coûteux.
 
Y'a des solutions alternatives pour ce genre de besoins, à ta connaissance ?

C'est un peu succint pour que je puisse répondre.
Je suppose que vous aviez été voir les modules Nagios sur CPAN.
Je suppose aussi que vous avez utilisé une version récente de perl (au moins 5.8) puisque tout l'implémentation interne des threads y a été changée.
Souvent, il faut regarder pourquoi on a besoin des threads, et regarder si une implémentation utilisant le traitement asynchrone à la AnyEvent ou les coroutines avec Coro n'est pas plus adapté à son problème.
A+,
 

Disons que ce qui nous a donné une grosse claque, c'est que les threads c'est loin d'être quelque chose d'anodin en Perl.
 
Déjà, effectivement, en mettant a jour Perl, on constate de grosses améliorations concernantl'occupation mémoire.
 
Après il faut faire très attention à tout : les variables partagées, les modules utilisés ... Il nous a fallu du temps avant que le soft puisse tourner longtemps en rendant la mémoire allouée.
 
Effectivement à l'avenir je vais essayer de travailler plus en amont la modélisation pour éviter les threads. Je regarde du coté de AnyEvent et Coro.

Pour obtenir toutes les permutations d'une liste a n éléments, il y a un module, use Algorithm::Permute; qui utilise du code C appelé par XS pour être plus rapide.
Si l'on veut en plus toutes les permutations des sous-listes et du code en pur Perl, on peut utiliser le code suivant:

#!/usr/bin/perl
use strict;
use warnings;
 
sub permute_init {
  my $digits = shift;
  return([ [[], $digits] ]);
}
 
sub permute_next {
  my $state = shift;
  my ($left, $right);
  my ($newleft, $newright);
  my ($val, $item, $i, $done);
 
  $item = pop @$state;
 
  if (defined($item)) {
    ($left, $right) = @$item;
 
     while (!$done) {
       if (scalar(@$right) > 0) {
     foreach $i (0 .. (scalar(@$right) - 1)) {
       $newright  = [];
       $newleft   = [];
       @$newright = @$right;
       @$newleft  = @$left;
       push(@$newleft, splice(@$newright, $i, 1));
       unshift(@$state, [$newleft, $newright]);
     }
       }
 
       if(scalar(@$left) > 0){ # avec ce test ci, on a toutes les combinaisons de 1, 2, ... n chiffres
       # if (scalar(@$right) == 0) { # avec ce test la, on a toutes les combinaisons de n chiffres
      $val = $left;
      $done = 1;
    }
       else {
     $item = pop(@$state);
     ($left, $right) = @$item;
       }
     }
  }
  return ($state, $val);
}
 
# deux exemples d'utilisation
my @list = qw(HFR Number One);
my $val;
my $state  = permute_init(\@list);
($state, $val) = permute_next($state);
while (defined($val)) {
  print join(' ',@$val), "\n";
  ($state, $val) = permute_next($state);
}
 
 
@list = 1..3;
$state  = permute_init(\@list);
($state, $val) = permute_next($state);
while (defined($val)) {
  print "@$val\n";
  ($state, $val) = permute_next($state);
}

 
 
A+,

Tiens, je viens de m'apercevoir que Active State a mis une nouvelle version dispo depuis le 7 Octobre.

Elle m'a paru encore plus rapide que la précédente, qui avait déjà pas mal gagné.
 
Une des plus grosses diffs avec les précédentes versions est ceci:

et ceci:

et plein d'optimisations pour gagner en mémoire et rapidité, mais éventuellement, au prix de certaines modifs de comportement:

A+,

Bon, en fait, je ne recommande pas cette nouvelle version:
Certains modules manquent, en particulier Tk, et quand on veut les recompiler avec cpan, ça passe pas (pas mal de problèmes au niveau des makefiles et de l'environnement de compilation).
La précédente version était plus aboutie à mon avis.
A+,