La programmation fonctionnelle en Perl

Voici un petit programme rappelant très brièvement quelques propriétés fondamentales des références (j'explique ce qui se passe, mais n'entrerai pas dans les détails de la syntaxe) :

#!/usr/bin/perl
use strict;
use warnings;
sub pri {print @_, "\n"}; # simule la fonction say qui existe à partir de Perl 5.10
my $a = 5;
say $a;         # imprime 5
my $a_ref = \$a;  # \ prend une référence. $a_ref est une référence vers $a
pri $a_ref;     # imprime: SCALAR(0x80359e18), l'adresse mémoire de $a
pri $$a_ref;    # imprime la valeur référencée par $a_ref, soit 5
$$a_ref ++;     # incrémente  la valeur référencée par $a_ref, soit 6
pri  $$a_ref;   # imprime 6
pri $a;         # imprime 6: le contenu de la variable $a a été modifié
                # par l'incrémentation de $$a_ref.

On voit que $a_ref contient l'adresse mémoire de la variable $a, permet d'accéder au contenu de $a et même de le modifier.

La suite du programme prend une référence sur une variable de tableau (ce pourrait aussi être un hachage) :

my @c = qw / 5 6 7/;
pri "@c";        # imprime 5 6 7
my $c_ref= \@c;  # $c_ref est une référence vers le tableau @c
pri $c_ref;      # imprime ARRAY(0x80355bb0), l'adresse mémoire de @c
pri "@$c_ref";   # imprime le contenu du tableau référencé par $c_ref,
                 # soit 5, 6, 7
$$c_ref[1] = 18; # modifie la 2e valeur du tableau référencé par $c_ref
pri "@$c_ref";   # imprime 5 18 7
pri "@c";        # le tableau @c a bien été modifié, imprime 5 18 7

On voit que la variable $c_ref est une référence, donc une variable scalaire (variable simple), mais qu'elle permet cependant d'accéder aux valeurs du tableau @c. Ce point est essentiel, car il est à l'origine de toute la puissance des références : ce sont de simples variables scalaires, mais elles permettent de se référer à d'autres variables simples, à des tableaux, à des hachages et à toutes sortes d'objets plus compliqués.

Si l'on désire passer un tableau en paramètre à une fonction, on peut passer l'ensemble du tableau lui-même, ou passer une référence à ce tableau. La syntaxe d'accès aux éléments du tableau dans la fonction sera légèrement différente, mais toutes les données du tableau seront accessibles. On peut penser que, si le tableau est très grand, cette seconde solution a un gros avantage sur le plan des performances (durée d'exécution et occupation mémoire) : elle évite de recopier tous les éléments du tableau. En fait, c'est certes vrai, mais seulement dans une mesure relativement limitée, car le tableau @_ des arguments passés à la fonction contient en fait des alias de ces arguments (et non réellement une copie), et prendre ces alias est nettement moins coûteux que de copier le tableau (voir l'encart ci-contre).

use strict;
use warnings;
use Benchmark;

my @tableau = 0..100000;

sub valeur { my @array = @_; my $c = $array[10000]; print $c if $c == 17; }
sub alias {my $c = $_[10000]; print $c if $c == 17; };
sub reference { my $a_ref = shift; my $c = $a_ref->[10000]; print $c if $c == 17;  }

timethese ( 10000, {
                "valeur"         => sub { valeur(@tableau); },
                "alias"         => sub { alias(@tableau) },
                "reference"      => sub { reference(\@tableau) }
} );

$ perl  pass_array_bench.pl
Benchmark: timing 10000 iterations of alias, reference, valeur...
     alias:  3 wallclock secs ( 2.92 usr +  0.00 sys =  2.92 CPU) @ 3428.18/s (n=10000)
 reference:  0 wallclock secs ( 0.00 usr +  0.00 sys =  0.00 CPU)
            (warning: too few iterations for a reliable count)
    valeur: 52 wallclock secs (51.32 usr +  0.00 sys = 51.32 CPU) @ 194.84/s (n=10000)

Benchmark: timing 100000 iterations of alias, reference, valeur...
     alias: 27 wallclock secs (28.84 usr +  0.00 sys = 28.84 CPU) @ 3466.93/s (n=100000)
 reference:  1 wallclock secs ( 0.06 usr +  0.00 sys =  0.06 CPU) @ 1612903.23/s (n=100000)
            (warning: too few iterations for a reliable count)
    valeur: 556 wallclock secs (556.52 usr +  0.02 sys = 556.53 CPU) @ 179.68/s (n=100000)

$ perl  pass_array_bench.pl
Benchmark: timing 1000000 iterations of alias, reference...
     alias: 289 wallclock secs (288.74 usr +  0.00 sys = 288.74 CPU) @ 3463.29/s (n=1000000)
 reference:  1 wallclock secs ( 0.58 usr +  0.00 sys =  0.58 CPU) @ 1733102.25/s (n=1000000)

Si l'on passe deux tableaux à une fonction, ces deux tableaux sont en fait fusionnés en une seule liste de paramètres et la fonction ne voit qu'un seul tableau résultant de la concaténation des valeurs des deux tableaux. Si on passe une référence à chaque tableau, la fonction est capable d'accéder séparément aux éléments de chaque tableau grâce aux références individuelles. Tout ce que nous venons de dire sur le passage de tableaux en paramètre à des fonctions s'applique aussi aux valeurs renvoyées par des fonctions à la fonction appelante si ces valeurs renvoyées sont des tableaux. Voilà déjà quatre avantages importants des références. Celui qui vient est encore plus crucial.

Notre programme a déjà créé $c_ref. La suite du programme crée directement deux autres références, cette fois vers des tableaux anonymes (des tableaux sans nom, des tableaux qui ne sont pas prédéclarés comme tels), puis créons un tableau contenant nos trois références vers des tableaux :

my @$d_ref = qw / 14 13 12/; # peut s'écrire: my $d_ref = [14, 13, 12];
my @$e_ref = qw / 34 35 36/;   # ou: my $e_ref = [34, 35, 36];
my @f = ($c_ref, $d_ref, $e_ref); # @f est un tableau de refs vers des tableaux
pri "@f"; # imprime ARRAY(0x80355bb0) ARRAY(0x80355a30) ARRAY(0x8034f508)

Le tableau @f est maintenant un tableau contenant trois scalaires, qui sont tous trois des références vers d'autres tableaux aux éléments desquels il est possible d'accéder. Ce tableau de références à d'autres tableaux est appelé plus couramment (c'est un raccourci légèrement abusif, mais très parlant) un tableau de tableaux (array of arrays, ou AoA) ayant la structure suivante :

0  ARRAY(0x803558e0)
   0  ARRAY(0x80355bb0)
      0  5
      1  18
      2  7
   1  ARRAY(0x80355a30)
      0  14
      1  13
      2  12
   2  ARRAY(0x8034f508)
      0  34
      1  35
      2  36

Ceci nous dit que le tableau @f est situé à l'adresse mémoire 0x803558e0 et qu'il contient trois références à des tableaux, dont le premier est à l'adresse 0x80355bb0 et contient les éléments 5, 18 et 7, et ainsi de suite pour les deux autres

Perl offre diverses manières syntaxiques d'accéder aux éléments de ce tableau de tableaux :

 

Sélectionnez

1.
2.
3.
4.
5.
6.

pri $f[0][1]; # imprime le deuxième élément du premier tableau, soit 18
pri $f[2][0]; # imprime 34
pri $f[2]->[0]; # notation "fléchée", affiche également 34
my $i_ref = $f[2]; # $i_ref est une nouvelle référence contenant ARRAY(0x8034f508)
pri $$i_ref[0]; # affiche encore 34
$f[3][1] = 87; # crée un nouveau tableau dans le AoA et met 89 à l'indice 1

Cette dernière commande a créé directement un nouveau tableau dans le tableau de tableaux et mis la valeur 87 en deuxième position.

0  ARRAY(0x803558e0)
   0  ARRAY(0x80355bb0)
      0  5
      1  18
      2  7
   1  ARRAY(0x80355a30)
      0  14
      1  13
      2  12
   2  ARRAY(0x8034f508)
      0  34
      1  35
      2  36
   3  ARRAY(0x803f81c0)
      0  empty slot
      1  87

Ce tableau @f aurait également pu être déclaré comme suit (en utilisant la syntaxe [] déjà mentionnée) :

my @f = ([5, 18, 7], [34, 35, 36], [34, 35, 36], [undef, 87]);

La syntaxe Perl offre plusieurs autres méthodes de définition ou d'accès à des tableaux de tableaux, ce résumé est très succinct.

Mais, de même que notre programme a créé un tableau de tableaux, il est possible de créer des tableaux de tableaux de tableaux (AoAoA), des hachages de hachages (HoH), des hachages de hachages de hachages (HoHoH), des tableaux de hachages (AoH), des hachages de tableaux (HoA), etc. On peut en fait créer des structures imbriquées arbitrairement complexes, selon les besoins.

Tout ceci est rendu possible par l'introduction des références. Celles-ci ont d'autres tours dans leur sac.

La fonction sort, par exemple, effectue par défaut un tri lexicographique. Pour effectuer un tri numérique, il faut lui passer un bloc de code ou une fonction effectuant une comparaison numérique entre deux éléments de la liste d'éléments à trier. Voici un exemple d'un fragment de script Perl montrant cette différence :

my @tableau = qw / 1 7 17 12 15 3 10/;
my @tri_1 = sort @tableau;
print "@tri_1 \n"; # imprime: 1 10 12 15 17 3 7
my @tri_2 = sort {$a <=> $b} @tableau;
print "@tri_2 \n"; # imprime: 1 3 7 10 12 15 17

Dans le premier cas, le 3 et le 7 viennent après le 10, le 12, le 15 et le 17, ce qui correspond à un tri lexicographique (on compare le premier caractère, puis, s'ils sont égaux, le second, et ainsi de suite). Ce n'est bien sûr pas satisfaisant pour des nombres que l'on veut trier numériquement. La seconde version trie bien les nombres selon notre désir. Pour cela, il a fallu ajouter entre la fonction sort et la liste des nombres à trier un bloc de code spécifiant comment doit s'effectuer la comparaison entre deux nombres successifs. Le bloc de tri numérique, {$a <=> $b}, constitue, dans le cas particulier de la fonction sort, une sorte de référence vers la fonction de comparaison nécessaire. (1)

Soit à écrire une fonction écrivant les carrés des dix premiers nombres entiers. La fonction map est bien adaptée :

$ perl -e 'print join " ", map {$_ * $_} 1..10;'
1 4 9 16 25 36 49 64 81 100

Comme nous l'avons vu dans le premier volet de ce tutoriel, l'opérateur map prend en entrée la liste de nombres générée par 1..10, soit les nombres de 1 à 10, affecte chacun de ces nombres à la variable $_, effectue l'opération demandée dans le bloc (ici, multiplier $_ par lui-même), et renvoie la liste des résultats. Ici encore, le bloc {$_ * $_} est (dans ce contexte) une sorte de référence à la fonction à appliquer à chaque élément.

Les opérateurs sort et map sont des fonctions qui acceptent une fonction comme paramètre. Quand une fonction peut être le paramètre d'appel ou la valeur de retour d'une autre fonction, on parle de fonctions d'ordre supérieur (ou parfois de fonctions première classe). Toute la puissance de sort et de map découle de cette capacité à définir leur comportement détaillé en leur passant un bloc de code ou une fonction. Nous allons maintenant voir comment faire ce genre de choses en Perl pour obtenir la même puissance pour nos propres fonctions, et combien cela peut être utile.

Supposons que nous voulions parcourir toute la profondeur d'un répertoire sur notre disque dur, pour déterminer la taille prise par ce répertoire et l'ensemble de ses sous-répertoires. Pour ce faire, on peut écrire une procédure, éventuellement récursive, qui explore le répertoire racine. Si elle trouve un fichier, elle ajoute sa taille à une variable globale. Si le programme trouve un répertoire, il parcourt ce nouveau répertoire avec les mêmes règles. À la fin, il affiche le total de l'espace disque pris par le répertoire et ses sous-répertoires. (Le code de ce programme viendra plus loin, soyez un peu patient pour l'instant.)

Quelques jours plus tard, nous devons écrire un programme qui recherche tous les fichiers modifiés depuis la dernière sauvegarde. Pour ce faire, il est possible d'écrire une procédure, éventuellement récursive, qui explore le répertoire racine. Si elle trouve un fichier, elle l'ajoute à une liste de fichier à sauvegarder si sa date de dernière modification est supérieure à la date pivot. Si la procédure trouve un répertoire, elle parcourt ce nouveau répertoire avec les mêmes règles. À la fin, le programme affiche les fichiers à sauvegarder du répertoire choisi et de ses sous-répertoires.

La semaine suivante, nous désirons effacer tous les fichiers *.tmp ou *.TMP d'un répertoire et de ses sous-répertoires. Pour ce faire, on peut écrire un programme, éventuellement récursif, qui explore le répertoire racine. S'il trouve un fichier de type *.tmp ou *.TMP, il l'efface. S'il trouve un répertoire, il parcourt ce nouveau répertoire avec les mêmes règles.

Stop ! Là, n'importe quel développeur digne de ce nom doit bondir et se poser la question : « Je fais trois fois presque exactement la même chose, parcourir l'arbre des répertoires et sous-répertoires, seule l'action individuelle finale sur les fichiers change à chaque fois. N'est-il pas possible d'écrire une seule fois le parcours des répertoires et sous-répertoires ? »

Bien sûr, on peut écrire un programme de parcours, puis, selon un paramètre, un flag ou une variable globale, décider que faire pour chaque fichier rencontré. Mais ce genre de stratégie ne fonctionne généralement pas bien. La prochaine fois, c'est encore autre chose qu'il faudra faire, et il faudra modifier une nouvelle fois le programme.

La bonne solution est généralement d'écrire un programme réellement générique (ou abstrait) de parcours purement technique de l'arbre de répertoires, sans préjuger en aucune façon (ou le moins possible) de ce qu'il devra faire de ce qu'il trouve. Quand il trouve quelque chose, il appelle la fonction assurant le contenu fonctionnel : calculer l'espace disque, sauvegarder les fichiers ou effacer les fichiers temporaires (ou, peut-être, demain, compresser les fichiers vieux de plus de trois mois, effacer ceux vieux de plus d'un an, archiver les fichiers de type *.ARC, etc.). Si nous avons écrit une fonction vraiment générique de parcours et avons décidé que l'action à entreprendre fait partie du paramétrage de cette fonction, il y a une bonne chance de ne plus devoir toucher à l'algorithme de parcours.

Comme dans le cas des fonctions map et sort vues précédemment, la solution la plus efficace (et élégante) consiste à passer en paramètre à la fonction technique générique (abstraite) une autre fonction chargée des actions particulières à entreprendre. Une fonction générique comme celle que nous venons de décrire sera souvent incluse dans un module, car elle peut être réutilisée par d'autres personnes ou dans d'autres projets.

Nous allons réaliser cette fonction générique de parcours de répertoires très bientôt, quand nous saurons comment faire. Rien de bien compliqué, elle prendra moins de 10 lignes de code Perl. Clarifions juste un petit point de vocabulaire avant de nous lancer dans le grand bain.

Supposons qu'il faille écrire un programme espace_disque.pl pour mesurer l'espace disque. À un moment donné, ce programme appelle la procédure parcourt_repertoire du module DiskExploreTools. Cette procédure parcourt le disque et, pour chaque fichier trouvé, appelle la fonction totalise_espace_disque qui lui a été passée en paramètre et qui est quant à elle définie dans le programme principal espace_disque.pl. Le programme principal appelle une fonction d'un module qui, a un moment donné, rappelle à son tour une fonction définie dans le programme principal. C'est à cause de ce mécanisme d'aller et retour entre le programme principal et le module que l'on appelle ce genre de fonction une fonction de rappel (callback function) : le programme appelle une fonction générique abstraite qui effectue un certain travail, et celle-ci rappelle la fonction concrète qui effectue la tâche recherchée.

Les références sur des fonctions vont nous permettre d'actionner ce genre de mécanisme (et de faire beaucoup d'autres choses que nous verrons plus loin).

Supposons que, dans le parcours de répertoire, l'on désire utiliser une fonction de rappel qui se contente dans un premier temps d'imprimer à l'écran la liste des fichiers rencontrés. Cette fonction doit simplement imprimer le paramètre reçu (le nom du fichier) et passer à la ligne.

Cette fonction très simple peut s'écrire comme suit :

sub imprime_fichier {
     my $fichier = shift;
     print $fichier, "\n";
}

La fonction de parcours récursif de répertoire peut ensuite s'écrire comme suit :

sub parcours_dir {
    my ($path) = @_;
    my @dir_entries = glob("$path/*");
    foreach my $entry (@dir_entries) {
        imprime_fichier($entry) if -f $entry;
        parcours_dir($entry) if -d $entry;
    }
}

L'appel de la fonction se fait normalement :

parcours_dir($chemin_de_depart);

La fonction parcours_dir est une fonction récursive simple qui lit le contenu du répertoire reçu en paramètre. Pour chaque objet trouvé dans le répertoire, elle appelle imprime_fichier si c'est un fichier, et elle s'appelle récursivement avec le nom du répertoire si c'est un répertoire. On pourrait ajouter quelques contrôles (par exemple, on ne fait rien si l'objet rencontré n'est ni un fichier, ni un répertoire, ce qui peut arriver sur certains systèmes d'exploitation), mais cela fonctionne au moins sous Unix et Windows/Dos (mais sans doute pas sous d'autres OS, mais cela nous suffira pour le moment).

Le principal problème est que l'appel à imprime_fichier est codé en dur dans le code de parcours_dir. Si l'on désire faire autre chose avec les fichiers trouvés, il faut changer parcours_dir. Ce n'est pas ce qui était voulu, la fonction parcours_dir devait être générique. Il serait souhaitable, par exemple, pouvoir la mettre dans un module et ne plus y toucher.

Les changements à faire sont très simples : il faut passer à la fonction parcours_dir le code de la fonction imprime_fichier en paramètre, du même que nous avons précédemment passé à sort ou à map des blocs de code.

Nul besoin de changer la fonction imprime_fichier, il faut juste créer une variable contenant une référence vers cette fonction, ce qui peut se faire de la façon suivante :

sub imprime_fichier {
     my $fichier = shift;
     print $fichier, "\n";
}
my $imprime_fic_ref = \&imprime_fichier;  # crée une référence sur la fonction

La variable $imprime_fic_ref est une variable scalaire ordinaire que nous allons pouvoir passer en argument à une fonction comme n'importe quelle autre variable. Sa seule particularité est qu'elle est une référence vers une fonction, vers du code Perl. On appelle souvent ce genre de variable une « code_ref » ou « coderef ». Nous utiliserons souvent le vocable coderef dans la suite pour désigner plus simplement une référence vers une fonction.

Il faut ensuite passer cette référence en paramètre à parcours_dir lors de l'appel de la fonction. Rien de plus simple :

parcours_dir($imprime_fic_ref, $chemin_de_depart);

Et la fonction parcours_dir doit maintenant utiliser ce nouveau paramètre au lieu de la fonction imprime_fichier utilisée antérieurement :

sub parcours_dir {
    my ($code_ref, $path) = @_;
    my @dir_entries = glob("$path/*");
    foreach my $entry (@dir_entries) {
        $code_ref->($entry) if -f $entry;
        parcours_dir($code_ref, $entry) if -d $entry;
    }
}

Trois petits changements : la fonction parcours_dir reçoit un nouveau paramètre, la référence à la fonction de rappel ($code_ref) et utilise la syntaxe $code_ref->($entry), au lieu de imprime_fichier($entry), pour appeler la fonction. Et comme la fonction parcours_dir est récursive, il faut encore ajouter le paramètre de la référence vers la fonction de rappel dans l'appel récursif.

Voilà, ça y est, nous avons maintenant une fonction générique (abstraite) : la fonction parcours_dir reçoit en paramètre une référence sur la fonction qu'elle doit appeler pour chaque fichier. Il n'y a plus besoin de modifier parcours_dir pour obtenir une fonctionnalité différente, il suffira de lui passer une référence à une autre fonction. Voici le programme complet :

#!/usr/bin/perl
use strict;
use warnings;

my $dir_depart = $ARGV[0];
chomp $dir_depart;

sub imprime_fichier {
     my $fichier = shift;
     print $fichier, "\n";
}
my $code_ref = \&imprime_fichier; # crée une référence sur la fonction

parcours_dir($code_ref, $dir_depart);

sub parcours_dir {
    my ($code_ref, $path) = @_;
    my @dir_entries = glob("$path/*");
    foreach my $entry (@dir_entries) {
        $code_ref->($entry) if -f $entry;
        parcours_dir($code_ref, $entry) if -d $entry;
    }
}

Par rapport à ce qui précédait, la référence à la fonction de rappel a été renommée $code_ref, plutôt que $imprime_fic_ref, pour refléter le fait que la fonction pourra selon les besoins faire une tout autre chose qu'imprimer la liste des fichiers.

Si maintenant nous désirons connaître la taille de l'ensemble des fichiers dans le répertoire et les sous-répertoires, il suffit de remplacer imprime_fichier par une autre fonction de rappel.

my $glob_size;
my $code_ref = \&find_total_size;
parcours_dir($code_ref, $dir_depart);
print "Taille totale: $glob_size \n";

sub find_total_size {
    my $fichier = shift;
    my $size = -s $fichier;
    print $fichier, ' ', $size, "\n";
    $glob_size += $size;
}

La fonction centrale, parcours_dir, reste inchangée. Le but est atteint, on a réellement une fonction générique réutilisable à volonté.

On pourrait critiquer, non sans raison, l'utilisation de la variable globale $glob_size, mais cela permet d'éviter pour l'instant de compliquer inutilement le code en devant passer en argument et renvoyer cette variable à chaque appel de la fonction de rappel. Nous verrons plus loin des techniques (voir notamment le chapitre sur les fermeturesLes fermetures (closures)) permettant d'éviter ce genre de problème et présenterons dans le troisième volet de ce tutoriel une nouvelle version de parcours_dir faisant appel à la technique dite de la curryfication.

Si vous trouvez la fonction parcours_dir pratique et désirez vous en servir, sachez qu'il existe un module standard, File::Find, nettement plus perfectionné, faisant à peu près la même chose et bien d'autres choses en plus. De plus, comme indiqué plus haut, la fonction simpliste ci-dessus ne marchera peut-être pas sous tous les systèmes d'exploitation. C'est donc plutôt ce module que vous devriez utiliser si vous avez besoin de parcourir un répertoire à la recherche de certains fichiers. Ce module attend comme premier paramètre une référence vers une fonction (notée \&wanted dans la documentation) analogue à ce que nous avons nommé $code_ref ci-dessus.

Les fonctions de rappel sont très souvent utilisées dans les modules, lorsque l'on souhaite réaliser une fonction ou un ensemble de fonctions génériques tout en conservant la possibilité de personnaliser le comportement (de même que, comme nous l'avons vu, la fonction sort met en œuvre un algorithme de tri efficace, mais qu'il faut lui passer en paramètre le code chargé de comparer les données entre elles).

Revenons à notre première référence vers une fonction. Nous l'avons écrite comme suit :

sub imprime_fichier {
     my $fichier = shift;
     print $fichier, "\n";
}
my $imprime_fic_ref = \&imprime_fichier; # crée une référence sur la fonction
parcours_dir($imprime_fic_ref, $dir_depart);

Nous avons d'abord défini une fonction ordinaire, imprime_fichier, puis avons utilisé la syntaxe \&imprime_fichier pour stocker dans la variable scalaire $imprime_fic_ref la référence vers cette fonction et passé cette variable en paramètre à la fonction parcours_dir. Il est possible d'utiliser une autre façon de faire consistant à créer la référence directement dans l'appel de parcours_dir :

sub imprime_fichier {
     my $fichier = shift;
     print $fichier, "\n";
}
parcours_dir(\&imprime_fichier, $dir_depart);

Une simplification inverse de la syntaxe d'origine consiste à remarquer que le nom de la fonction imprime_fichier ne sert plus à aucun moment, nous ne nous servons plus que de la référence ailleurs dans le programme.

Il existe un moyen plus simple de définir directement une référence vers une fonction :

my $imprime_fic_ref = sub {
     my $fichier = shift;
     print $fichier, "\n";
}

La fonction n'a plus de nom, elle est devenue ce que l'on appelle une fonction anonyme. La référence $imprime_fic_ref est maintenant la seule manière de l'utiliser. Mais cette référence est une simple variable scalaire, nous pouvons en faire tout ce que nous pouvons faire avec des scalaires : passer la fonction en argument à une autre fonction, la renvoyer comme une valeur de retour d'une fonction (nous y reviendrons longuement), construire un tableau ou une table de hachage de références à des fonctions, etc. De même que l'utilisation de références à des tableaux ou des tables de hachage anonymes permet la création de structures de données complexes comme des tableaux de tableaux, des tableaux de hachage, des hachages de tableaux, des hachages de hachages, etc., la possibilité de créer des références vers des fonctions anonymes offre une extraordinaire puissance expressive supplémentaire à qui sait comment s'en servir. Il devient également possible de définir des fonctions dans des fonctions et de créer des fonctions lexicales privées.

Les fonctions deviennent ce que l'on appelle en programmation fonctionnelle des citoyens de premier ordre ou d'ordre supérieur.

Il est même possible d'aller un cran plus loin dans la simplification syntaxique. Pour passer le code d'une fonction de rappel à une fonction, il n'est même pas besoin de donner un nom à la référence à cette fonction. Il suffit de passer directement la référence au code en paramètre. Au lieu d'écrire :

my $code_ref = sub { print "$_[0]\n"};
parcours_dir($code_ref, $dir_depart);

On peut écrire :

parcours_dir(sub { print "$_[0]\n"}, $dir_depart);

Nous verrons dans la partie 3 de ce tutoriel une simplification supplémentaire grâce à l'utilisation des prototypes.

Dans certains cas, on désire passer à une fonction non seulement une coderef, mais aussi les arguments à passer à cette coderef, qu'il convient de distinguer des arguments passés à la fonction. Une coderef étant une variable scalaire ordinaire, elle peut être incluse dans une structure de données (hachage ou tableau) contenant la coderef et les données dont elle a besoin. C'est par exemple le cas quand on utilise certains modules comme Perl/Tk (toolkit graphique) : on passe à la fonction appelée une référence à un tableau contenant la coderef et les arguments dont elle a besoin avec un appel du style :

my_function( [\&callback_func, $cb_param1, $cb_param2], $arg2, $arg3);

Ici, la fonction my_function prend trois arguments : une référence à un tableau anonyme (ce qui figure entre les crochets […]), $arg2 et $arg3. Le tableau anonyme contient lui-même trois éléments : la coderef \&callback_func, et les deux paramètres qui devront être passés à cette fonction de rappel, $cp_param1 et $cb_param2. Il faut bien sûr que la fonction my_function soit codée de façon à traiter correctement les arguments qu'elle reçoit (cela n'a rien de compliqué, mais traiter cet aspect ici sortirait du cadre de ce tutoriel).

Un dernier point de syntaxe. Jusqu'à présent, pour appeler la fonction référée par $toto, nous avons utilisé la syntaxe suivante :

$toto->($param1);

Il est également possible d'utiliser le « sigil » & pour déréférencer le coderef et d'appeler la fonction de rappel comme suit :

&$toto($param1);

Cette méthode plus classique (ou moins moderne) reste parfaitement valide. Choisissez celle que vous préférez ou qui vous paraît la plus claire, mais il est utile de savoir que les deux existent et qu'elles font la même chose. Personnellement, j'ai d'abord utilisé assez longtemps la seconde et ne suis passé à la première qu'assez récemment, la trouvant finalement un peu plus lisible.

Prenons pour commencer un exemple un peu simpliste. Supposons dans un premier temps que nous désirions réaliser une fonction qui renvoie à la demande les carrés des nombres entiers successifs. Supposons en outre que cette fonction doive pouvoir être appelée de plusieurs endroits du programme, y compris à des endroits dans lesquels le programme ne sait pas quel a été le dernier nombre utilisé ou le dernier carré obtenu. Il faut donc que la fonction « se souvienne » du dernier nombre utilisé.

Ce genre de fonction s'appelle un itérateur, elle ne fournit pas une liste bornée de nombres comme le faisaient les fonctions map et grep examinées dans la première partie de ce tutoriel, elle ne fournit pas non plus le carré d'un nombre qui lui est passé en paramètre, mais elle fournit à la demande et un par un une liste, potentiellement infinie (en théorie), de carrés d'entiers successifs. Bien sûr, un ordinateur a une mémoire finie et ne peut gérer une liste réellement infinie, mais un itérateur fournit un moyen de générer une liste potentiellement illimitée de valeurs, grâce au mécanisme d'évaluation dite paresseuse ou retardée (lazy evaluation ou call-by-need) qu'il met en place : il ne crée pas la liste illimitée, il se contente de fournir à chaque demande le prochain élément de la liste.

La plupart des développeurs utilisent régulièrement des itérateurs, parfois sans le savoir : ainsi, la fonction Perl readline ou l'opérateur <$FH> sont des itérateurs sur des fichiers : en contexte scalaire, ils retournent une ligne du fichier à chaque demande. Même si le fichier est gigantesque et beaucoup trop gros pour la mémoire vive de l'ordinateur, le fait d'utiliser un itérateur pour le lire ligne par ligne permet de traiter le fichier sans aucun problème de mémoire.

Nous reviendrons plus loin assez longuement sur les itérateurs et les façons d'en construire.

Pour générer des carrés à la demande, essayons ceci :

#!/usr/bin/perl
use strict;
use warnings;

my $square = fournit_carre();
print $square, "\n";

# ...
# tout à fait ailleurs dans le code
my $new_square = fournit_carre();
print $new_square, "\n";

sub fournit_carre {
    my $premier_nombre = 0;
    $premier_nombre ++;
    return $premier_nombre ** 2;
}

Cela ne marche évidemment pas et affiche :

$ perl carre1.pl
1
1

La variable $premier_nombre est réinitialisée à 0 à chaque appel, et la fonction retourne à chaque fois le carré de 1 (donc 1).

Essayons de ruser et de réécrire la fonction comme suit :

sub fournit_carre {
    my $premier_nombre = 0;
    my $nombre = $premier_nombre unless defined $nombre;
    $nombre ++;
    return $nombre ** 2;
}

C'est encore pire, le programme ne compile même plus (du moins en utilisant les pragmas strict et warnings):

$ perl carre2.pl
Global symbol "$nombre" requires explicit package name at carre1.pl line 14.
Execution of carre1.pl aborted due to compilation errors.

Essayons d'éliminer cette erreur de compilation en déclarant $nombre avant de l'utiliser :

sub fournit_carre {
    my $premier_nombre = 0;
    my $nombre;
    $nombre = $premier_nombre unless defined $nombre;
    $nombre ++;
    return $nombre ** 2;
}

Le programme compile à nouveau, mais le résultat n'est toujours pas ce qui est recherché :

$ perl carre3.pl
1
1

La variable $nombre est réinitialisée à chaque appel et n'est donc pas définie quand on la teste, et elle reprend donc à chaque fois la valeur de $premier_nombre.

La solution est en fait très simple, mais pas forcément évidente à deviner pour qui ne la connaît pas ou ne l'a pas déjà vue au moins une fois :

{    my $nombre = 0;
    sub fournit_carre {
        $nombre ++;
        return $nombre ** 2;
    }
}

Ce qui donne le résultat recherché :

$ perl carre_closure.pl
1
4

Comment cela fonctionne-t-il ? Les accolades au début et à la fin forment un bloc lexical. La variable lexicale $nombre déclarée au début de ce bloc est visible lexicalement jusqu'à la fin du bloc, donc, en particulier, dans le corps de la fonction carre_closure. Cette variable est initialisée à 0 lors de la compilation, mais le code de cette initialisation n'est pas exécuté lorsque la fonction est appelée. Résultat : la variable $nombre conserve sa valeur entre deux appels de la fonction ; elle prend la valeur 1 lors du premier appel, 2 lors du second appel, puis 3, et ainsi de suite.

my $c_ref;
sub initie_c {
     my $c = 10;
     $c_ref = \$c;
}
print $$c_ref; # imprime 10

J'ai bien ici une fermeture, puisque la fonction fournit_carre utilise et met à jour la variable lexicale $nombre qui lui est propre. Aucun autre endroit du programme ne connaît cette variable ni ne peut y accéder, que ce soit en lecture ou en écriture. La donnée constitue un objet persistant et elle est réellement complètement privée au bloc lexical qui encadre la fonction.

Un développeur C pourrait dire que $nombre est une variable statique (une variable déclarée au sein d'une fonction avec le mot-clef static et qui conserve sa valeur entre deux appels à la fonction). Depuis la version 5.14 de Perl, un mécanisme analogue existe en Perl : le déclarateur state qui crée une variable lexicale dont le contenu persiste entre deux appels successifs à la fonction. L'utilisation de cette fonctionnalité nécessite le pragma use feature "state";. Ceci nous donne par exemple le programme suivant :

#!/usr/bin/perl
use strict;
use warnings;
use feature "state";

my $square = fournit_carre();
print $square, "\n";

my $new_square = fournit_carre();
print $new_square, "\n";

sub fournit_carre {
    state $nombre = 0;
    return ++$nombre ** 2;
}

Ce qui imprime bien :

$ perl carre_state.pl
1
4

À noter que l'instruction « state $nombre = 0 ;» n'est exécutée qu'une seule fois, lors du premier appel à la fonction, ce qui peut paraître contre-intuitif à première vue. Ce mécanisme existe depuis la version 5.14 de Perl (sortie en mai 2011), alors que le mécanisme de fermeture étudié antérieurement a vu le jour avec la version 5.0 de Perl (datant de 1994). Nous nous en tiendrons pour la suite à la version traditionnelle, ne serait-ce que parce que, dans le monde professionnel, beaucoup de gens doivent encore travailler avec des versions plus anciennes de Perl (beaucoup de serveurs de production fonctionnent avec des versions de systèmes d'exploitation datant de 5 ou 10 ans, et les versions les plus récentes de Perl n'ont pas forcément été portées pour des versions d'AIX, de Solaris ou d'HP-UX aussi anciennes). Nous verrons aussi bientôt d'autres avantages des fermetures pour lesquels le déclarateur state n'apporterait rien.

Dans leur utilisation la plus fréquente, les fermetures sont souvent des fonctions anonymes, au point que certains pensent parfois qu'une fermeture doit être une fonction anonyme. Il est vrai que toute la puissance des fermetures se révèle dans le cadre de fonctions anonymes, comme nous le verrons plus loin, mais une fonction nommée peut parfaitement « se fermer » sur une ou plusieurs variable(s). La fonction fournit_carre est un exemple de fermeture nommée. Avant d'en venir aux fermetures anonymes, examinons brièvement un exemple réel pratique (c'est-à-dire non théorique) de fermeture nommée.

J'ai donc décidé d'écrire une interface de plus haut niveau simplifiant l'accès aux objets de la base. Par exemple, une simple recherche en base nécessite l'appel successif des actions suivantes de l'API : transformation de la chaîne de recherche en objet de recherche interne à la base, activation de l'API avec cet objet de recherche, récupération de l'objet résultat, transformation de l'objet interne résultat en une chaîne de caractères utilisable, libération de la mémoire utilisée par les objets internes (sans parler des vérifications d'erreur à chacune des étapes). L'interface que j'ai écrite permet de lancer au niveau du programme applicatif une seule opération se chargeant derrière la scène d'enchaîner les différentes actions nécessaires. Cette interface prend la forme d'un module Perl réutilisable assez simple (quelques centaines de lignes de code). Cette interface utilise incidemment certaines des techniques précédemment décrites dans le présent document (fonctions de rappel, tables de distribution, etc.), mais ce n'est pas ici le sujet, je n'entrerai pas dans ces détails.

L'utilisation de ce module d'interface commence nécessairement par l'appel à une fonction, init_connection, qui se charge d'enchaîner quelques actions (connexion à la base, ouverture d'une transaction, etc.) et retourne trois identifiants : pointeur vers un buffer d'erreur, identifiant de connexion, identifiant de transaction. Chaque fonction de l'API de base nécessite de passer en paramètres ces identifiants, en sus de la structure de données relative à l'action à effectuer en base. Devoir passer en paramètre chacun de ces trois paramètres (toujours les mêmes) à chaque appel aurait compliqué notablement l'utilisation de cette interface.

En simplifiant quelque peu, j'ai donc simplement déclaré ces trois paramètres globaux à ce module. Ceux-ci sont initialisés lors de l'appel à la fonction init_connection, et le module forme une fermeture qui se souvient ensuite de ces trois paramètres. Ils forment maintenant un objet persistant réutilisable. Il n'est donc plus nécessaire de transmettre ces paramètres en arguments aux appels des fonctions du module, qui sont capables de les récupérer elles-mêmes, ce qui simplifie notablement l'utilisation de cette interface.

Voici le pseudocode d'une version abstraite très simplifiée de l'interface. Cette version élimine notamment une bonne partie de code de gestion des éventuelles erreurs d'accès à la base.

package Mon_interface;
use strict;
use warnings;
use Low_level_api;

our @ISA = qw/Exporter/;
our @EXPORT = qw (init_connection);
our @EXPORT_OK = qw (recherche_objet …);

my ($error_buff_p, $connexion_id, $transaction_id);
my $init_done = 0;

sub init_connection {
    my ($param1, $param2 …) = @_;
    my $ebuf_p = API_create_buff($some_param);
    my $connect_id = API_connect($some_other_param …);
    my $trans_id = open_transaction($ebuf_p, $connect_id, $autres_params …);
    # quelques autres opérations
    ($error_buff_p, $connexion_id, $transaction_id) = ($ebuf_p, $connect_id, $trans_id);
    $init_done = 1;
    return ($ebuf_p, $connect_id, $trans_id);
}

sub  open_transaction {
    my ($ebuf_p, $connect_id, $param1, $param2 …) = @_;
    # ...fait quelques petites choses supplémentaires
    my $transaction_id = API_create_transaction($ebuf_p, $connect_id, #various_params...);
    # … fait d'autres petites choses
    return  $transaction_id;
} 

# … nombreuses fonctions diverses 

sub recherche_objet {
    my $search_string_ref = shift;
    die_error ("Appelez d'abord la fonction init_connection\n" unless $init_done);
    my $search_struct_p = string_to_struct_convert ($error_buff_p, $search_string_ref);
    die_error($search_string) if  error_detected($error_buff_p);
    my $return_struct_p = API_object_search ($error_buff_p, $transaction_id, $connexion_id, $search_struct_p);
    die_error (…) if error_detected($error_buff_p);
    my $return_string = struct_to_string_convert($error_buff_p, $return_struct_p);
    die_error( $search_string) if  error_detected($error_buff_p);
    free_memory($_) for ($search_struct_p, $return_struct_p);
    return \$return_string;
}
1;

Le programme principal appelant ce module pourra contenir notamment le code suivant :

use strict;
use warnings;
use Mon_interface;

chomp @ARGV;
my $config_file = shift;
my %config = read_config($config_file);
#...
# les paramètres $ebuf, $connect_id, $trans_id sont en principe inutiles ici, mais sont tout 
# de même récupérés au cas où l'on voudrait appeler une fonction de l'API de bas niveau
my ($ebuf, $connect_id, $trans_id) =  init_connection($some_params);
# …
my $search_string = "...";
my $result_ref =  recherche_objet($search_string);
# exploitation de $result_ref, etc.
# ...

Le module Mon_interface (ce n'est pas son vrai nom) se charge de toutes les actions de bas niveau. Comme il constitue une fermeture, il stocke notamment comme objets persistants les trois identifiants de connexion. Le programme principal peut se contenter d'appeler la fonction init_connexion, puis par exemple la fonction recherche_objet, avec un seul argument, la chaîne de caractères constituant la liste de recherche en base.

Utiliser ainsi des fonctions intermédiaires pour simplifier l'appel de fonction principal à un seul argument (les autres arguments étant ici stockés comme objets persistants dans une fermeture) est une forme manuelle simple et minimaliste d'une autre technique importante de la programmation fonctionnelle sur laquelle nous reviendrons dans la troisième partie de ce tutoriel, la curryfication.

Le module ci-dessus utilise des variables lexicales globales au module pour des raisons de simplicité, afin de partager ces trois variables entre les différentes fonctions du module. Cela ne pose pas de problème parce que ces variables sont parfaitement encapsulées dans le module, qui est lui-même simple et ne fait pas grand-chose de plus que de mettre à la disposition du programme appelant une bibliothèque de fonctions presque indépendantes les unes des autres permettant d'accéder en lecture ou en écriture aux objets de la base. Le programme appelant n'a aucun moyen d'accéder directement à ces variables totalement privées, et il n'y a donc aucun risque de collision de noms. L'utilisation de ces variables globales au module (il faudrait plutôt dire partagées entre les fonctions du module) ne pose donc pas de problème à mes yeux.

Certains puristes pourraient cependant protester (le terme puriste n'a ici rien de péjoratif, je suis moi-même certainement le puriste de certains). Surtout, le module pourrait être (voire devenir) plus compliqué, auquel cas l'utilisation de variables globales au module pourrait commencer à être nettement plus difficile à justifier. Qu'à cela ne tienne, nous pouvons encapsuler nos variables bien plus étroitement.

Il suffit de supprimer la déclaration des quatre variables globales au module et de créer deux fermetures de portée plus limitée, dont le rôle correspond à ce que l'on appelle en programmation orientée objet un accesseur et un mutateur :

{
    my ($error_buff_p, $connexion_id, $transaction_id);
    my $init_done = 0;
    sub get_val {return ($error_buff_p, $connexion_id, $transaction_id, $init_done);};
    sub set_val { ($error_buff_p, $connexion_id, $transaction_id, $init_done) = @_;};
}

Dans la fonction $init_connexion, les lignes suivantes :

    ($error_buff_p, $connexion_id, $transaction_id) = ($ebuf_p, $connect_id, $trans_id);
    $init_done = 1;

sont remplacées par :

    set_val($ebuf_p, $connect_id, $trans_id, 1);

De même, les autres fonctions de l'interface peuvent accéder aux valeurs de ces variables en appelant la fonction get_val. Par exemple, la fonction recherche_objet peut être modifiée comme suit :

sub recherche_objet {
    my $search_string_ref = shift;
    my ($error_buff_p, $connexion_id, $transaction_id, init_done) = get_val();
    die_error ("Appelez d'abord la fonction init_connection\n" unless $init_done);
    # …
}

Et voilà, le tour est joué, il n'y a plus de variables globales. C'était très simple finalement. Oui, mais… Est-il bien certain que l'on a vraiment gagné au change ? Pas si sûr… En effet, le programme appelant n'avait jusqu'à présent aucun moyen d'accès direct à ces données privées du module. Il en a maintenant un : il peut appeler les fonctions get_val et set_val. Même si ces fonctions ne sont pas exportées par le module, le programme appelant peut toujours les appeler en préfixant leur nom par celui du module et éventuellement faire n'importe quoi :

Mon_interface::set_val(1, 2, 3, 4); # aïe, pas bon du tout

Cette modification a certes permis de supprimer les variables globales, mais elle a offert au programme appelant une porte dérobée d'accès à des données qui lui étaient jusqu'ici parfaitement inaccessibles. L'accès en lecture par la fonction get_val ne paraît sans doute pas trop gênant, mais l'accès en écriture par la fonction set_val peut-être plus fâcheux. En fait, les deux cas peuvent être problématiques : si le développeur du programme appelant utilise ce moyen pour contourner l'interface qui lui a été offerte, le risque est que plus rien ne marche le jour où l'implémentation interne du module change, même si le développeur auteur de ces changements du module a pris la peine de respecter scrupuleusement l'interface existante.

Le problème provient du fait qu'une fonction ne peut pas être privée en Perl (du moins c'était vrai jusqu'à très récemment, la version 5.18 de Perl introduit à titre expérimental des fonctions de portée lexicale). Plus exactement, on ne pouvait pas avoir jusqu'à la version 5.18 de fonctions nommées de portée lexicale. Mais, alors, ne peut-on pas contourner le problème avec des références lexicales sur des fonctions anonymes, par exemple en ajoutant au début du module les coderefs suivantes :

my $get_var_ref = sub {return ($error_buff_p, $connexion_id, $transaction_id, $init_done)};
my $set_val_ref = sub {($error_buff_p, $connexion_id, $transaction_id, $init_done) = @_;};

L'utilisation de références sur des fonctions anonymes présentée au paragraphe précédent peut marcher, moyennant quelques autres changements ailleurs dans le code, mais, pour simplifier la discussion, nous allons maintenant abandonner ce module et considérer le module Essai_loc_func, une version bien plus dépouillée de la même problématique, avec une seule variable, un accesseur et un mutateur :

use strict;
use warnings;
package Essai_loc_func;
require Exporter;
our @ISA = qw/Exporter/;
our @EXPORT_OK = qw (init read_val);

my ($set_val_ref, $get_val_ref);
{
    my $val;
    $set_val_ref = sub { $val = shift; };
    $get_val_ref = sub { return $val ; };
}
sub init     { $set_val_ref->(shift);   };
sub read_val { return $get_val_ref->(); };
1;

Le programme utilisateur minimal peut avoir cette forme :

use strict;
use warnings;
use Essai_loc_func qw (init read_val) ;

init(7);
my $ret_val = read_val();
print $ret_val, "\n";    # imprime 7

Ces coderefs $set_val_ref et $get_val_ref sont des fermetures anonymes. Elles ne sont plus accessibles au programme appelant, on retrouve l'encapsulation forte du point de départ. Mais, si nous examinons le chemin parcouru, on peut aussi considérer que nous n'avons fait que tourner en rond : nous nous retrouvons avec deux nouvelles variables globales au module, les références aux fonctions anonymes, alors que tout le but était précisément de se débarrasser des variables globales.

Il peut sembler que nous sommes revenus au point de départ, puisque nous n'avons toujours pas la solution permettant d'éliminer les variables globales. D'un autre côté, nos nouvelles variables globales représentent des fonctions, qui sont généralement globales de toute façon, alors que les variables relatives à l'état de l'application sont maintenant bien locales et privées. Si le module était plus complexe, ce serait sans doute une réelle avancée. Peut-être avons-nous également progressé dans notre compréhension des grandes forces et menues faiblesses des fermetures. Nous allons voir que ces fermetures anonymes nous permettent de faire beaucoup de nouvelles choses.

Considérons le problème professionnel réel suivant. Il s'agit de comparer les données de deux fichiers provenant de deux applications différentes concernant les mêmes clients. Les clients sont présents par ordre croissant de numéros de client. Un client est constitué de plusieurs enregistrements de types 0 à 6 :

• Ligne de type 0 : une seule ligne de données propres à l'entité client ;
• Lignes de type 1 : 0, 1 ou plusieurs lignes correspondant à des prestations souscrites par le client ;
• Lignes de type 2 : 1 ou plusieurs lignes correspondant aux abonnements téléphoniques souscrits par le client ;
• Lignes de type 3 : pour chaque ligne de type 2, une ou plusieurs lignes correspondant aux prestations associées à chaque abonnement téléphonique ;
• etc.

Les données se présentent approximativement de la façon suivante :

0;cli1;billday_cli1;last_bill_date; next_bill_date;
1;cli1;prest_cli1_1; …
1;cli1;prest_cli1_2; …
2;cli1;dos1;caractéristiques cli1/dos1;
2;cli1;dos2;caractéristiques cli1/dos2;
3;cli1;dos1;prest1,caractéristiques cli1/dos1/prest1;
3;cli1;dos1;prest1,caractéristiques cli1/dos1/prest1;
3;cli1;dos2;prest1,caractéristiques cli1/dos2/prest1;
3;cli1;dos2;prest1,caractéristiques cli1/dos2/prest1;
…
0;cli2;billday_cli1;last_bill_date; next_bill_date;
1;cli2;prest_cli1_2; …
2;cli2;dos1;caractéristiques cli1/dos1;
2;cli2;dos2;caractéristiques cli1/dos2;
3;cli2;dos1;prest1,caractéristiques cli1/dos1/pr

Le programme doit lire les deux fichiers en parallèle et désire stoker dans un tableau toutes les lignes relatives à un client pour chacune des deux applications. Lire tous les enregistrements relatifs à un client dans ce genre de fichier présente une petite difficulté : on ne sait que l'on a lu toutes les lignes associées à un client donné que quand on trouve une ligne de type 0 relative à un nouveau client (ou quand on arrive à la fin du fichier), qu'il faut mettre de côté le temps de traiter les données relatives au client courant, puis reprendre la ligne mise de côté avant de recommencer à lire les fichiers. Rien de bien compliqué, mais comme nous lisons deux fichiers en parallèle, le code pour traiter ces cas particuliers risque de se trouver dupliqué, ce qui n'est pas très satisfaisant. Voici donc une fonction retournant un itérateur sur chacun des fichiers en entrée.(3)

sub return_iter_cust {
    my $file_in = shift;
    my $line;
    open my $IN,  "<", $file_in or die "cannot open input file $file_in $!";
    return sub {
        my @cust_lines;
        $line = <$IN> unless defined $line;
        chomp $line;
        push @cust_lines, [split /;/, $line];
        while ($line = <$IN>) {
            chomp $line;
            if ($line =~ /^0;/) {   #   le type de ligne est le premier caractère de la ligne
                    return \@cust_lines;
            } else {
                push @cust_lines, [split /;/, $line];
            }
        }
    }
}

Voici le code utilisant ces fonctions :

#    création des deux itérateurs sur les fichiers A et V
    my $a_iter = return_iter_cust ($file_a);
    my $v_iter = return_iter_cust ($file_v);
    #    utilisation des itérateurs
    while (my $full_a_cli_ref = $a_iter->()) {
        my $full_v_cli_ref = $v_iter->();
        # ...
    }

Les deux itérateurs « se ferment » sur deux valeurs, le descripteur de fichier (file handler) et la ligne du client suivant à mettre de côté pour l'utiliser à l'itération suivante.

En été 2013, quelqu'un a proposé un défi sur le forum PerlMonks (sans doute le forum Perl le plus connu sur le plan international) : proposer une solution à un problème posé sur le site Rosetta Code (http://rosettacode.org/wiki/Same_Fringe). Il s'agit de comparer les feuilles de deux arbres binaires pour déterminer s'ils ont la même liste de feuilles lors d'un parcours de gauche à droite. La structure (et l'équilibre) des arbres n'a pas d'importance, seuls comptent le nombre, l'ordre et la valeur des feuilles. Il était précisé dans le défi que la solution devait être de préférence « paresseuse », c'est-à-dire qu'il fallait lire une par une chaque feuille de chaque arbre binaire pour les comparer, et arrêter la comparaison dès qu'une différence était trouvée ; autrement dit, la solution simple consistant à parcourir récursivement chaque arbre complètement pour établir deux listes de feuilles puis comparer les listes n'était pas jugée acceptable. Je précise qu'il n'y avait aucune solution proposée en Perl à l'époque sur le site Rosetta Code.

J'ai essayé de répondre à ce défi en essayant d'abord un parcours récursif des arbres (un peu comme le parcours des répertoires au début du présent document), mais me suis vite aperçu qu'il était au mieux très difficile d'effectuer deux parcours récursifs en parallèle. Il m'est donc apparu assez rapidement qu'il fallait implanter deux itérateurs, un pour chaque arbre. Chaque itérateur récupère la feuille suivante de l'arbre sur lequel il travaille et la comparaison s'arrête si les feuilles récupérées ne sont pas identiques. Si on arrive à la fin de la comparaison, les listes des feuilles étaient bien identiques.

Voici le programme auquel je suis arrivé (j'ai élagué ci-dessous une partie du jeu de tests) :

#!/usr/bin/perl
use strict;
use warnings;

my $a = [ 1, [ 2, [ 3, [ 4, 5 ] ] ] ];
my $b = [ 1, [ [ 2, 3 ], [ 4, 5 ] ] ];
my $c = [ [ [ [ 1, 2 ], 3 ], 4 ], 5 ];
sameFringe( $a, $a );
sameFringe( $a, $b );
sameFringe( $a, $c );

sub sameFringe {
    my $next_el1 = create_iterator(shift);
    my $next_el2 = create_iterator(shift);
    my $match = 1;
    while (1) {
        my $left = $next_el1->();
        my $right = $next_el2->();
        no warnings 'uninitialized';
        print $left, " ", $right, "\n";
        unless ($left eq $right) {$match = 0 ; last} ;
        last unless defined $left;
    }
    $match ? print "the trees match\n": print "the trees don't match\n";
}

sub create_iterator {
    my $ref = shift;
    my @ref_list;
    return sub {
        while (ref $ref eq 'ARRAY') {
            unshift @ref_list, @$ref;
            $ref = shift @ref_list;
        } 
        my $leaf = $ref;
        $ref = shift @ref_list;
        return $leaf;
    }
}

Le code de la solution proprement dite (sans les jeux de test) tient en moins de 30 lignes de code (je n'ai pas fait d'effort particulier de concision), ce qui est à peu près l'ordre de grandeur des solutions présentées dans les langages fonctionnels (Ocaml ou Clojure, par exemple). Les langages objet comme Java nécessitent environ 5 fois plus de code. Ada ou C sont encore plus gourmands en lignes de code, mais il est vrai qu'Ada a une structure syntaxique un peu bavarde rendant ce genre de comparaison un peu injuste à son égard. Haskell et Picolisp font légèrement mieux que la version Perl (environ 20 lignes de code). À signaler que le gagnant toutes catégories (de très loin) est Perl 6 : sa solution tient en 4 lignes ! Il est assez courant aujourd'hui de voir beaucoup de gens (peut-être blasés, mais sans doute très bien informés pour certains) douter qu'une version de production de Perl 6 voie finalement le jour ; sans prendre parti dans ce débat, je dirais seulement qu'au vu de la puissance expressive de Perl 6, il y a tout lieu d'espérer que l'avenir leur donnera tort.

Pour la petite histoire, 3 solutions réellement valables (à mes yeux) ont été présentées sur le forum PerlMonks. Deux très similaires fondées sur des itérateurs (celle qui se trouve actuellement sur le site Rosetta Code à l'adresse indiquée et la mienne présentée ci-dessus) et une troisième, assez différente et originale, utilisant des threads en parallèle pour parcourir les arbres.

Au début de ce document, nous avons ajouté des fonctions de rappel pour rendre générique la fonction récursive parcours_dir(). Ne peut-on pas faire la même chose avec les fermetures pour produire par exemple un itérateur générique ?

L'itérateur générique pourrait avoir par exemple la forme suivante :

sub create_iter {
     my ($code_ref, @rest) = @_;
     return sub {$code_ref->();}
}

Il reçoit deux catégories de paramètres, une référence sur une fonction et la liste des variables sur lesquelles la fermeture doit se fermer.

On veut ensuite créer l'itérateur renvoyant une suite de nombres pairs en appelant la fonction create_iter :

my $pair = create_iter(sub {my $c; $c += 2; return $c;},  0);   #  ne marche pas

Et là, ça ne marche pas : si la variable $c est définie à cet endroit, la fonction ne se fermera pas dessus, puisqu'elle est définie ailleurs (pas dans la même portée). Cela ne marchera guère mieux si l'on essaie d'utiliser le tableau @rest défini là où il faut :

my $pair = create_iter(sub {$rest[0] += 2; return $rest[0] ;},  0) ;   #  ne marche toujours pas

Cela ne compilera même pas si le pragma 'use strict;' est activé, parce que la variable @rest n'est pas définie à cet endroit (et la transformer en variable lexicale et l'affublant d'une déclaration de type my ne résout rien puisque l'on retombe dans le problème précédent). Sans le 'use strict;', le programme pourra sans doute compiler, mais ne fonctionnera pas pour autant, les variables sont hors de portée.

En fait, nous avons des problèmes, car nous ne savons pas trop comment gérer les variables, mais le fond du problème est que cela ne peut tout simplement pas marcher parce que la fonction de rappel n'est pas définie dans le contexte voulu, dans l'environnement d'exécution qui en ferait une fermeture.

Est-il donc impossible de réaliser un itérateur générique ? Avec le genre de solutions essayées, il semble bien que oui.

Mais il y a moyen de contourner le problème au moyen d'une petite ruse permettant de passer passer en paramètre le code de la fonction de rappel et de faire en sorte qu'il ne soit réellement défini qu'au sein de l'environnement de la fermeture. Cette ruse est l'utilisation de la fonction Perl eval, qui prend en paramètre une chaîne de caractères et l'exécute comme du code Perl (à condition que le contenu de la chaîne de caractères soit du code Perl valide).

Voici donc une usine à itérateurs générique créant 4 itérateurs différents. Le premier paramètre passé à create_iter() n'est plus une coderef, mais une chaîne de caractères représentant le code de la fonction à implémenter comme fermeture. Les fonctions associées à fibo et fIbo2 sont toutes les deux des itérateurs sur la suite de Fibonacci, mais l'une utilise des variables locales, l'autre utilise directement le tableau variable de fermeture (le but étant d'illustrer deux syntaxes légèrement différentes). La fonction fact itère sur les factorielles successives d'un nombre, et l'itérateur sur les carrés des nombres entiers montre que cela fonctionne aussi avec un nombre différent de paramètres (un au lieu de deux).

use strict;
use warnings;

sub create_iter {
     my ($code_string, @rest) = @_;
     eval $code_string;
}

my $fibo1 = create_iter (
    ' return sub {my ($c, $d) = @rest;
             my $e = $c + $d; @rest = ($d, $e); 
             return $e;}
    ',
    1, 1);
print "Fibo 1: \n";
print $fibo1->(), " ", for 1..7; # 

my $fibo2 = create_iter (
    q {
        return sub {@rest[0,1] = ($rest[1], $rest[0] + $rest[1]);
         return $rest[1];}
    },
     1, 1);
print "\n\nFibo2, premier appel: \n";
print $fibo2->(), " " for 1..5;

my $fact = create_iter (<<'EOS'
    return sub { $rest[0]++; $rest[1] *= $rest[0];};
EOS
    , 1, 1);
print "\n\nFact: \n";
print $fact->(), " ", for 1..5;

print "\n\nFibo2, second appel: \n";
print $fibo2->(), " " for 1..5;

my $carres = create_iter ('sub { (++$rest[0])**2 }', 1);
print "\n\nCarres: \n";
print $carres->(), " " for 1..5;

Ce programme imprime ce qui suit :

$ perl  generic_iter.pl
Fibo 1:
2 3 5 8 13 21 34

Fibo2, premier appel:
2 3 5 8 13

Fact:
2 6 24 120 720

Fibo2, second appel:
21 34 55 89 144

Carres:
4 9 16 25 36

Je n'ai jusqu'à présent pas encore utilisé d'itérateur générique de ce type dans la vie réelle, mais, à vrai dire, je n'ai imaginé cette solution qu'assez récemment (je ne prétends en aucun cas en être l'inventeur, mais comme je ne l'ai jamais vue décrite ou utilisée ailleurs, je peux du moins dire que je l'ai imaginée personnellement). Je ne sais donc pas vraiment si ce genre d'itérateur a une grande utilité dans la pratique, mais l'utilisation de la fonction eval est à retenir comme un moyen supplémentaire de passer une fonction à une fonction sous la forme d'une chaîne de caractères, dans des cas un peu compliqués où des coderef ne fonctionneraient pas correctement. Plusieurs modules du CPAN utilisent cette possibilité. Par exemple, le module Benchmark de Perl offre la possibilité de passer en paramètre la fonction dont on désire mesurer les performances soit sous la forme d'une coderef, soit sous celle d'une chaîne de caractères qui est alors testée avec eval.

Deux classiques de l'algorithmique : créer une file d'attente ou queue FIFO (first in, first out : premier entré, premier sorti) ou une pile (stack) LIFO (last in, first out : dernier entré, premier sorti). Chaque structure de données nécessite au moins deux fonctions, une pour ajouter un élément et une pour en retirer (et récupérer) un. La syntaxe permettant à l'usine à fonctions de retourner deux fonctions ne pose aucune difficulté particulière :

use strict;
use warnings;

sub create_fifo {
    my @fifo_arr;
     return (sub {return shift @fifo_arr;}, sub {push @fifo_arr, shift;}) ;
}
my ($fifo_get, $fifo_put) = create_fifo ();
$fifo_put->($_) for 1..10;
print $fifo_get->() for 1..5;
print "\n";

sub create_lifo {
     my @lifo_arr;
     return (sub {return pop @lifo_arr;}, sub {push @lifo_arr, shift;}) ;
}
my ($lifo_get, $lifo_put) = create_lifo ();
$lifo_put->($_) for 1..10;
print $lifo_get->() for 1..5;

Bien entendu, les implémentations ci-dessus d'une file et d'une pile sont réduites à leur plus simple expression. Il faudrait au minimum ajouter du code de gestion des erreurs (traiter le cas d'un get sur une file ou une pile vide, par exemple).

Une application professionnelle réelle : je dois écrire un programme comparant les données de clients entre deux applications. Ce sont les mêmes clients, mais la modélisation des offres commerciales diffère entre les deux applications. Pour comparer les données, il faut d'abord effectuer une transcodification des offres de l'application A en offres de l'application B (ou l'inverse), pour vérifier que ce sont bien les mêmes. Pour ce faire, il existe six fichiers de correspondance entre les deux systèmes. Chaque fichier est constitué de façon identique : un champ donnant le code de l'application A et un champ donnant la correspondance dans l'application B, séparés par des points-virgules. Il suffit donc, avant de commencer la comparaison, de lire ces six fichiers et de les charger dans des tables de hachage permettant d'effectuer la transcodification entre les deux systèmes à comparer.

Plutôt que d'écrire six fonctions lisant chacune un fichier en entrée et alimentant chacune un hachage global utilisé par la suite, j'ai écrit une seule usine à fonctions fabriquant des fermetures anonymes. Cette usine à fonctions est appelée six fois avec à chaque fois le nom du fichier en entrée, alimente un hash local privé avec le contenu du fichier et retourne une fonction dont le seul rôle est d'effectuer la transcodification en lisant son propre hash privé.

Cette fonction génératrice de fonctions anonymes est écrite comme suit :

sub load_params {
     my $file_name = shift;
     my @files = glob ("$data_path${file_name}*.txt");
     my $file = pop @files;
     my %param;
     open my $IN, "<", $file or die "Ouverture impossible de $file $!";
     while (<$IN>) {
         chomp;
         next if /^\s*$/;
         my ($key, $val) = split /;/, $_;
         $param{$key} = $val
     }
     close $IN;
     return sub {
         my $key = shift;
         return unless defined $param{$key};
         return $param{$key};
     }
}

La première partie reçoit un nom incomplet du fichier à charger, recherche le fichier, l'ouvre et le charge dans le hash %param. La fonction renvoie ensuite une fonction anonyme chargée d'effectuer la transcodification en renvoyant la valeur du hash correspondant à la clé reçue en paramètre. Le hash de paramétrage porte le même nom dans chacun des six cas, mais c'est dans chaque cas un hash différent qui est privé à la fonction anonyme renvoyée. En appelant la bonne fonction anonyme, on a la certitude de consulter le hash voulu. Il suffit maintenant d'appeler six fois la fonction load_params pour obtenir six coderefs spécialisées.

Voici la génération des fonctions anonymes pour deux des six fichiers de paramétrage :

my $offer_mapping_ref        = load_params("B_mapping_offer-mapping_");
my $migration_mapping_ref    = load_params("B_mapping_migration-status_");

La transcodification proprement dite est pratiquement aussi simple que s'il fallait consulter une table de hachage :

my $ot_B = $offer_mapping_ref->($offre_A);

La mise en place de ce mécanisme d'usine à fonctions a permis de réduire à moins de 25 lignes de code des opérations qui en auraient demandé sans doute entre 130 et 150 avec des méthodes plus classiques. Cela peut paraître un peu plus compliqué la première fois que l'on utilise ce genre de procédé, mais c'est très clair dès la seconde fois qu'on l'utilise. Et s'il y a une anomalie quelque part, il n'y a besoin de la corriger qu'une seule fois (et non six fois), ce qui simplifie considérablement la maintenance.

Une évolution nécessitant un nouveau fichier de paramétrage (pour autant qu'il ait la même structure) demande a priori l'ajout de deux lignes de code, pas plus. La fonction centrale loads_params ne nécessite pas le moindre changement.

Cela dit, il y a aussi moyen d'obtenir un résultat similaire en à peu près aussi peu de lignes de codes sans recourir aux fermetures : on peut aussi créer une fonction générique qui lit le fichier concerné et renvoie le hash voulu :

sub load_params {
     my $file_name = shift;
     my @files = glob ("$data_path${file_name}*.txt");
     my $file = pop @files;
     my %param;
     open my $IN, "<", $file or die "Ouverture impossible de $file $!";
     while (<$IN>) {
         chomp;
         next if /^\s*$/;
         my ($key, $val) = split /;/, $_;
         $param{$key} = $val
     }
     close $IN;
     return %param;
}

La différence importante entre les deux techniques est que la version avec fermeture permet d'encapsuler les données (il n'y a vraiment aucun autre moyen d'y accéder que par l'interface offerte, et il est impossible de les modifier), alors que la dernière version ci-dessus laisse à l'utilisateur le moyen de les modifier (ce qui est généralement une mauvaise idée), même si le code se trouve dans un module séparé.

3-5-6-a. Premier exemple d'écriture dans des fichiers multiples▲

#!/usr/bin/perl
use strict;
use warnings;

my ($jour, $mois) =  (localtime time)[3, 4];
my $date = sprintf  "%02d%02d", ++$mois, $jour;
my $root_name = "99$date-";
my $chemin = './RESULT';

my $write_od1 = create_file_writer("$chemin/B$root_name");
my $write_od2 = create_file_writer("$chemin/E$root_name");
my $write_od3 = create_file_writer("$chemin/H$root_name");
# fichiers de suppression de BV
my $write_suppr = create_file_writer("$chemin/majmv-");

my %dispatch_table = (
    'COD1' => $write_od1,
    'COD2' => $write_od2,
    'COD3' => $write_od3,
    'SUPP' => $write_suppr 
);

# note: on aurait pu écrire directement les fonctions dans la table:
# $dispatch_table{'COD1'} = create_file_writer("$chemin/B$root_name");
# et ainsi de suite. Nous l'avons laissé en deux étapes pour des 
# raisons pédagogiques, afin de rester simple et clair. 

my $file_in = "./TMP/CORRECTION_MV.TMP";
open my $INFILE, "<", $file_in or die "Ouverture impossible du fichier $file_in - $!";
while (my $line = <$INFILE>) {
    my $plateforme = substr $line, 52, 4;
    $dispatch_table{$plateforme}->($line);
}

sub create_file_writer {
    my $root_file_name = shift;
    my $line_count = 0;
    my (@count_file, $fh);
    my $old_dos = "";
    return sub {
        my $line = shift;
        if ($line_count == 0) {  #   cas où il va falloir changer de fichier
            my $new_dos = substr $line, 4, 10;
            # on ne change de fichier que si c'est un nouveau dossier
            print $fh and return if $new_dos eq $old_dos; 
            close $fh if defined $fh;
            @count_file = incremente_compteur(@count_file);
            my $sequence = join '', @count_file;
            my $file_name = "$root_file_name$sequence.txt";
            open $fh , ">", $file_name or die "Ne peut ouvrir $file_name$!";
        }
        print $fh $line;
        $line_count ++;
        if ( $line_count >= 19990) {   # max = 20000, mais il ne faut pas dégrouper 
            $line_count = 0;
            $old_dos = substr $line, 4, 10;
        }
    }
}    
            
sub incremente_compteur {
    # la gestion des numéros de séquence alphabétiques n'est pas si simple
    # et mérite une procédure séparée, mais ne présente pas d'intérêt 
    # particulier dans notre exemple pour ce tutoriel
    # …
     return @new_counter;
}

3-5-6-b. Second exemple d'écriture dans des fichiers multiples▲

my $GB_BACKFILL = "$pwd/BADDEBT-BACKFILL_FILE-GB";
my $DE_BACKFILL = "$pwd/BADDEBT-BACKFILL_FILE-DE";
my $FR_BACKFILL = "$pwd/BADDEBT-BACKFILL_FILE-FR";
my $ES_BACKFILL = "$pwd/BADDEBT-BACKFILL_FILE-ES";
my $IT_BACKFILL = "$pwd/BADDEBT-BACKFILL_FILE-IT";

open (GB_BACKFILL, "> $GB_BACKFILL") or die "unable to open output file: $!";
open (DE_BACKFILL, "> $DE_BACKFILL") or die "unable to open output file: $!";
open (FR_BACKFILL, "> $FR_BACKFILL") or die "unable to open output file: $!";
open (ES_BACKFILL, "> $ES_BACKFILL") or die "unable to open output file: $!";
open (IT_BACKFILL, "> $IT_BACKFILL") or die "unable to open output file: $!";

while (my $line=<BADDEBT>) {
    my @row = split (",",$line);

    $date = $row[1];
    $esid = $row[4];
    $amount = $row[5];
    $ppcl_id=$row[8];
    $cur=$row[6];
    $cust_id =$row[9]; 
    if ($custid)
    {
       if($ppcl_id == 3)
       {
           print GB_BACKFILL "$custid|$date|391|$esid|-$amount|$cur|$ppcl_id|8\n ";
       }
       elsif($ppcl_id==4)
       {
           print DE_BACKFILL "$custid|$date|391|$esid|-$amount|$cur|$ppcl_id|8\n";
       }
       elsif($ppcl_id==5)
       {
           print FR_BACKFILL "$custid|$date|391|$esid|-$amount|$cur|$ppcl_id|8\n ";
       }
       elsif ($ppcl_id==44551)
       {
           print ES_BACKFILL "$custid|$date|391|$esid|-$amount|$cur|$ppcl_id|8\n";
       }
       elsif($ppcl_id == 35691)
       {
           print IT_BACKFILL "$custid|$date|391|$esid|-$amount|$cur|$ppcl_id|8\n ";
       }
    }
}

open my $US_BACKFILL, '>', 'usfile.txt' or die "$!"; 
open my $CA_BACKFILL, '>', 'cafile.txt' or die "$!"; 
open my $BR_BACKFILL, '>', 'brfile.txt' or die "$!"; 
# etc. pour les autres fichiers
# ...
 
my $BACKFILL = $ppcl_id ==      1 ? $US_BACKFILL 
             : $ppcl_id ==      7 ? $CA_BACKFILL 
             : $ppcl_id == 526970 ? $BR_BACKFILL 
             # : etc.
             :                      undef 
             ; 
if (defined $BACKFILL) { 
   print {$BACKFILL} "$custid|$date|391|$esid|-$amount|$cur|$ppcl_id|8\n ";  
}

my ?CKFILL; 
 
open $BACKFILL{1}, '>', 'US_backfill.txt' or die "failed to open 'US_BACKFILL.txt' $!"; 
open $BACKFILL{6}, '>', 'JP_BACKFIll.txt' or die "failed to open 'JP_BACKFILL.txt' $!"; 
open $BACKFILL{7}, '>', 'CA_backfill.txt' or die "failed to open 'CA_BACKFILL.txt' $!"; 
# ...
 
# Des accolades sont nécessaires autour du descripteur de fichier 
print {$BACKFILL{$ppcl_id}} "$custid|$date|391|$esid|-$amount|$cur|$ppcl_id|8\n ";

my %dispatch; 
$dispatch{3}      = create_func( "$pwd/BADDEBT-BACKFILL_FILE-GB"); 
$dispatch{4}      = create_func( "$pwd/BADDEBT-BACKFILL_FILE-DE"); 
$dispatch{5}      = create_func( "$pwd/BADDEBT-BACKFILL_FILE-FR"); 
$dispatch{44551}  = create_func( "$pwd/BADDEBT-BACKFILL_FILE-ES"); 
$dispatch{35691}  = create_func( "$pwd/BADDEBT-BACKFILL_FILE-IT"); 

while (my $line = <BADDEBT>) {
    my ($date, $esid, $amount, $ppcl_id, $cur, $custid) = (split ",", $line)[1,4,5,8,6,9];
    $dispatch{$ppcl_id}->("$custid|$date|391|$esid|-$amount|$cur|$ppcl_id|8") if $custid; 
}
sub create_func { 
     open my $FH, ">", $_[0] or die "could not open $_[0] $!"; 
     return sub { print $FH shift, "\n"; } 
}