Discussion :

[ptonnerre]

Bonjour,

je m’intéresse beaucoup aux possibilités de programmation fonctionnelle de Perl.

La lecture de la première partie du tutoriel Programmation fonctionnelle en Perl sur les opérateurs de liste m’a été très utile dans la constitution d’expressions pour un script de sauvegardes Oracle (RMAN et datapump) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
if ( $nb_table ) { 
    $table_string = join ",", 
    map { $_ =~ s/'/\\'/g ; $_ } 
    map { "'" . $_ . "'" }
    map { $_ =~ s/^.*\/.*\.// ; $_ } 
        @liste_tables;
    $table_string = ' INCLUDE=TABLE:\"IN \(' . $table_string . '\)\"' ;
}
[...]
if ( $nb_seq ) { 
    $seq_string = join ",", 
    map { $_ =~ s/'/\\'/g ; $_ }
    map { "'" . $_ . "'" }
    map { $sql_drop .= 'DROP SEQUENCE ' . $user . '.' . $_ . ";\n" ; $_ }
    map { $_ =~ s/^.*\/.*\.// ; $_ }
    @liste_seq;
    $seq_string = ' INCLUDE=SEQUENCE:\"IN \(' . $seq_string . '\)\"' ;
    chomp($sql_drop);
}

Après la lecture de la seconde partie, consacrée aux fonctions d'ordre supérieur, j'ai tenté d'imaginer quelques applications possibles de ces nouvelles notions.

Les fonctions de rappel :
en regardant un de mes derniers programmes, je me suis rendu compte que j'avais plusieurs ouvertures de fichier avec lecture ligne à ligne. Je pensais à créer une fonction générique se chargeant de l'ouverture du fichier, de sa lecture et enfin de sa fermeture. Pour chaque ligne, une fonction de rappel serait appelée pour le traitement correspondant.
Est-ce une bonne idée d'utiliser cette programmation dans ce cas ?
Avez-vous des exemples d'utilisation pour lesquels vous avez eu recours aux fonctions de rappel ?

Les tables de distribution :
au travail, nous utilisons un modèle de programme pour tous nos scripts, quel que soit l'OS.
Chaque script enchaine une série de traitements, fonction des deux premiers arguments qu'il reçoit.
La plupart du temps, le script s'exécute du début à la fin ; par contre, lors de reprises, il nous arrive de le lancer à partir d'une certaine balise, et éventuellement, jusqu'à un autre, située avant la fin normale du script.

La version actuelle de la boucle de traitement principale est :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
until ( $reprise eq 'fin' ) {
    oxa_msg_info ( $r_log, 0,"LABEL : $reprise" );
 
    if ( $reprise eq 'debut') {
        oxa_msg_info ( $r_log, 0, '==> Début de traitement' );
        $reprise = utils_next_step ( 'traitement', $reprise, $fin );
 
    } elsif ( $reprise eq 'traitement') {
        oxa_msg_info ( $r_log, 0, '==> Traitement' );
        process ( $r_log, $r_h_env );
        $reprise = utils_next_step ( 'fin_traitement', $reprise, $fin );
 
    } elsif ( $reprise eq 'fin_traitement' ) {
        oxa_msg_info ( $r_log, 0, '==> Fin de traitement' );
        $reprise = utils_next_step ( 'fin', $reprise, $fin );
 
    } else {
        oxa_msg_err( $r_log, 0, "KO - Etiquette $reprise invalide", 99, $r_h_env );
        $reprise = utils_next_step ('fin', $reprise, $fin );
    }
}

Une version de test opérationnelle utilisant une table de distribution est :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
 
my %dispatch_table = (
        debut          => sub { $reprise = utils_next_step( 'traitement0', $reprise, $fin ) },
        traitement0    => sub { process0 ( $r_log, $r_h_env, $r_h_cpt );
                                $reprise = utils_next_step( 'traitement1', $reprise, $fin )},
        traitement1    => sub { process1 ( $r_log, $r_h_env, $r_h_cpt );
                                $reprise = utils_next_step( 'traitement', $reprise, $fin )},
        traitement     => sub { process ( $r_log, $r_h_env, $r_h_cpt );
                                $reprise = utils_next_step( 'fin', $reprise, $fin )},
        fin            => sub { $reprise = utils_next_step( 'fin', $reprise, $fin ) },
        );
 
until ( $reprise eq 'fin' ) {
    if ( defined $dispatch_table{$reprise}) {
        oxa_msg_info ( $r_log, 0, "$r_h_env->{'dash132'}" );
        oxa_msg_info ( $r_log, 0,"LABEL : $reprise" );
        $dispatch_table{$reprise}->();
    } else {
        oxa_msg_err( $r_log, 0, "KO - Etiquette $reprise invalide", 99, $r_h_env );
    }
}

Le programme fonctionne mais j'ai du mal à voir le gain potentiel de cette technique dans le cas présent.
Est-ce plus lisible ? Est-ce judicieux ?


Commentaires, avis, critiques sur mon utilisation des opérateurs de liste, des fonctions de rappel, des tables de distribution bienvenus.

Merci

[Lolo78]

Bonjour,

Sur ton utilisation des opérateurs de listes:

Ne sachant pas ce qu'il y a dans les tableaux qui tu soumets à un pipeline de maps, je ne peux pas trop juger, mais ça m'a l'air pas mal. Sauf que tu peux fortement simplifier la syntaxe d'une grosse partie de tes maps.

Sachant qu'une instruction contenant expression régulière telle que

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
s/toto/titi/;

travaille par défaut sur la variable par défaut $_, elle est donc équivalente à:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
$_ =~ s/toto/titi/;

Du coup, le premier map de ton code:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
map { $_ =~ s/'/\\'/g ; $_ }

peut se réécrire plus simplement:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
map { s/'/\\'/g }

(Et le map renvoie bien la dernière valeur modifiée de $_.)

Cela s'applique bien sûr aux autres maps faisant des substitution du même type.

Sur les fonctions de rappel

Je pense que c'est une bonne idée, surtout si ça te permet par exemple de mettre ta fonction générique dans un module et de lui passer ta fonction de rappel.

Je dois souvent lire deux fichiers triés en parallèle pour les comparer. J'ai mis dans un module la fonction générique de lecture en parallèle de deux fichiers et je lui passe un hachage contenant deux ou trois paramètres (du genre: sur quels champs faire la comparaison) ainsi que deux fonctions de rappel. Nous avons au boulot au moins une bonne quinzaine d'applications utilisant ce module, qui a été adopté avec enthousiasme par mes collègues.

La troisième partie du tutoriel ouvre des possibilités encore plus vastes.


Sur la table de distribution:

C'est à toi de juger s'il y a un gain, je ne peux pas trop dire. Ça me paraît légèrement plus simple, mais bon, c'est toi le juge.

Mais, si tu as ce genre de code dans plusieurs programmes, la table de distribution peut peut-être aller dans un module et en être exportée.

De plus, tu peux aussi envisager de construire dynamiquement une partie de la table de distribution avec quelque chose comme ceci (ça compile, mais ce n'est pas testé, parce que c'est non testable sans un contexte plus large):

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
 
my %dispatch = (
         debut          => sub { $reprise = utils_next_step( 'traitement0', $reprise, $fin ) },
         fin            => sub { $reprise = utils_next_step( 'fin', $reprise, $fin ) }
         );
 
 my @etapes = qw / traitement0 traitement1 traitement fin/;
 for my $i (0..$#etapes - 1) {
    $dispatch{$etapes[$i]} = sub { process0 ( $r_log, $r_h_env, $r_h_cpt );
                                   $reprise = utils_next_step( $etapes[$i + 1], $reprise, $fin )}; 
 }

Ici, la table est assez petite, donc le gain en concision est assez modeste. Avec plus d'étapes (et peut-être as-tu en réalité plus d'étapes), il deviendrait plus net.

D'une façon générale, les tables de distributions sont particulièrement pratiques quand (1) il y a beaucoup de cas, et/ou (2) quand on peut construire (ou doit modifier) la table dynamiquement.

Voilà, j'espère que c'est utile.

[ptonnerre]

Bonsoir,

j'ai pris bonne note pour les substitutions avec les opérateurs de listes et ai mis à jour mon programme.

Pour les fonctions de rappel, je vais me lancer avec cette idée de lecture de fichier avec fonction de rappel pour le traitement des lignes.
Je pense que sera utile et réutilisable dans nos futurs scripts.

Concernant les tables de distribution, j'hésite un peu pour le moment : je trouve que cela diminue la lisibilité. Je vais continuer à approfondir le sujet.

Merci pour tes conseils Lolo78, je vis continuer la lecture de ces tutoriaux très instructifs et ouvrant de nouvelles et nombreuses perspectives.

[ptonnerre]

Bonsoir,

j'ai continué d'approfondir le tutoriel en parcourant la seconde partie, "les fonctions d'ordre supérieur".

Au travail, notre modèle de script passe systématiquement au fonctions de traitements deux tables de hachage : une contenant l'environnement d'exécution et une contenant des compteurs.

Ce même script utilise des modules maison dont les fonctions reçoivent systématiquement la référence d'un fichier de log et celle de la table de hachage de l'environnement.

Je me suis inspiré de l'exemple du chapitre 3-2-2 pour m'affranchir de ces passages d'arguments récurrents et j'avoue que cela a simplifié de manière significative le code du programme principal et celui des modules. Les fonctions retrouvent maintenant toutes seules les arguments systématiques dont elles ont besoin.

Module :
en début de module :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
 
my ( $r_f_set_val, $r_f_get_val );
{
    my ( $ref_log, $ref_h_env );
    $r_f_set_val = sub { ( $ref_log, $ref_h_env ) = @_; };
    $r_f_get_val = sub { return ( $ref_log, $ref_h_env ); };
}

La fonction qui initialise les valeurs :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
 
sub oxa_debut { 
    my ( $r_log, $r_h_env ) = @_;
    $r_f_set_val->( $r_log, $r_h_env );
    [...]

les fonctions récupèrent les valeurs persistantes de la manière suivante :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
 
sub oxa_app {
    my ( $domaine, $application ) = @_;
 
    my ( $ref_log, $ref_h_env ) = $r_f_get_val->();
    say $ref_log "OXAPP:$domaine";
    say $ref_log "OXSAP:$application";
    [...]

Le programme appelant :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
 
sub main {
 
    my ( $r_h_env, $r_h_cpt ) = init_env();
    $r_f_set_env->( $r_h_env, $r_h_cpt );
 
    # Initialisation
    oxa_debut    ( $r_log, $r_h_env );
    [...]

Le principe des fermetures nécessite un peu de temps avant de se clarifier, mais le jeu en vaut vraiment la chandelle.
C'est une réelle avancée, enthousiasmante, qui ouvre de nombreuses possibilités et évolutions.

To be continued...

[disedorgue]

Bonjour,
Je ne peux que te conseiller de passer à la partie 3 : étendre le langage, cela te permettra de simplifier un peu plus ton code.
Perso, je trouve ce tuto simplement magnifique, et qui, contrairement à beaucoup de livre sur perl, montre comment aborder la programmation perl tel qu'il se doit.
Un grand Merci à Lolo78 pour ce cadeau.

[ptonnerre]

Bonjour,
Perso, je trouve ce tuto simplement magnifique, et qui, contrairement à beaucoup de livre sur perl, montre comment aborder la programmation perl tel qu'il se doit.
Un grand Merci à Lolo78 pour ce cadeau.

Je confirme, c'est magnifique, merci à lui

[Lolo78]

Merci à vous deux pour ces gerbes de fleurs.

[ptonnerre]

Bonjour,

mon module et mon modèle de script ont légèrement évolué depuis mon précédent post et leur écriture s'est encore allégée grâce à l'utilisation des fermetures.

Module :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
 
my $r_f_get_val;
sub f_set_val {
    my ( $ref_log, $ref_h_env ) = @_;
    return sub {
        return ( $ref_log, $ref_h_env );
    }
}

la fonction qui appelle le mutateur et reçoit la référence à l'accesseur :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
 
sub oxa_debut {
    my ( $r_log, $r_h_env ) = @_;
 
    $r_f_get_val = f_set_val ( $r_log, $r_h_env );

une fonction qui appelle l'accesseur :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
 
sub oxa_app {
    my ( $domaine, $application ) = @_;
 
    my ( $ref_log, $ref_h_env ) = $r_f_get_val->();
    say $ref_log "OXAPP:$domaine";
    say $ref_log "OXSAP:$application";

Je poursuis la lecture de la partie 2 du tutoriel par le chapitre 3-5-1 et son exemple de lecture de deux fichiers en parallèle.

Je tente dans un premier temps d'utiliser un itérateur pour le fichier ficA suivant, mais n'arrive pas à retourner le tableau du dernier client, cli3 :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
0;cli1;fA;billday_cli1;last_bill_date; next_bill_date;
1;cli1;fA;prest_cli1_1;xxxxxxxxxxx
1;cli1;fA;prest_cli1_2;qsdfsdfqsdf
2;cli1;fA;dos1;caractéristiques cli1/dos1;
2;cli1;fA;dos2;caractéristiques cli1/dos2;
3;cli1;fA;dos1;prest1,caractéristiques cli1/dos1/prest1;
3;cli1;fA;dos1;prest1,caractéristiques cli1/dos1/prest1;
3;cli1;fA;dos2;prest1,caractéristiques cli1/dos2/prest1;
3;cli1;fA;dos2;prest1,caractéristiques cli1/dos2/prest1;
0;cli2;fA;billday_cli1;last_bill_date; next_bill_date;
1;cli2;fA;prest_cli1_2;qqsfsdqfsdf
2;cli2;fA;dos1;caractéristiques cli1/dos1;
2;cli2;fA;dos2;caractéristiques cli1/dos2;
3;cli2;fA;dos1;prest1,caractéristiques cli1/dos1/pr
0;cli3;fA;billday_cli1;last_bill_date; next_bill_date;
1;cli3;fA;prest_cli1_2;qarzearpzaer
2;cli3;fA;dos1;caractéristiques cli1/dos1;
2;cli3;fA;dos2;caractéristiques cli1/dos2;
3;cli3;fA;dos1;prest1,caractéristiques cli1/dos1/pr

Le code que j'utilise :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
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;/ ) {
                say $line;
                return \@cust_lines;
            } else {
                say $line;
                push @cust_lines, [split /;/, $line];
            }
        }
    }
}
 
 
my $dir = $ENV{'PROD_TECH_PERL'} . '/files';
my $file_a = $dir . '/ficA';
my $file_v = $dir . '/ficV';
 
my $a_iter = return_iter_cust ($file_a);
my $v_iter = return_iter_cust ($file_v);
 
while ( my $full_a_cli_ref = $a_iter->()) {
    print Dumper(\@$full_a_cli_ref) . "\n";
}

produit la sortie :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
          ],
          [
            '3',
            'cli2',
            'fA',
            'dos1',
            'prest1,caractéristiques cli1/dos1/pr'
          ]
        ];
 
1;cli3;fA;prest_cli1_2;qarzearpzaer
2;cli3;fA;dos1;caractéristiques cli1/dos1;
2;cli3;fA;dos2;caractéristiques cli1/dos2;
3;cli3;fA;dos1;prest1,caractéristiques cli1/dos1/pr

J'ai essayé plusieurs return du tableau, notamment après la structure while, la fonction eof, mais sans succès...
La boucle while lit bien les lignes du client cli3 suivant la rupture (elles sont affichées) mais je ne trouve pas de solution pour retourner la référence au tableau de ce dernier client.

[disedorgue]

Je pense que ton test de sortie n'est pas bon, puisque tu retournes la référence du tableau quand tu détectes que ton fichier à une ligne commençant par '0;' mais dans ce cas tu n'as pas encore intégré cli3.
Il faudrait que tu rajoutes un control dans ton else pour savoir si tu as fini de lire le fichier et dans ce cas retourner la référence.
Donc, quelque chose du genre devrait le faire:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
else {
  say $line;
  push @cust_lines, [split /;/, $line];
  return \@cust_lines if eof($IN);
}

[Lolo78]

Bonsoir,

il est probable que le code que j'ai présenté dans le tutoriel soit un peu trop simplifié et pose un problème sur le dernier enregistrement du fichier, comme c'est souvent le cas quand on traite des enregistrements de façon différée par rapport à leur lecture (par exemple pour effectuer un dédoublonnage). Il existe diverses solutions pour ce problème, mais, plutôt que d'en proposer une, je regarderai demain ce que faisait le programme réel pour gérer le cas particulier du dernier groupe d'enregistrements. Il a été testé de façon détaillée et exhaustive, je suis pratiquement sûr qu'il marchait correctement. (J'emploie le passé parce que ce programme ne sert plus depuis un moment.)

[ptonnerre]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
else {
  say $line;
  push @cust_lines, [split /;/, $line];
  return \@cust_lines if eof($IN);
}

Cela fonctionne avec ta modification, un grand MERCI


J'avais testé cette solution mais en omettant d'écrire le fh en argument de la fonction eof
Je n'ai jamais eu jusqu'à présent besoin d'utiliser cette fonction, les fins de fichiers étant obligatoirement présentes après la fin de la lecture effectuée par la structure correspondante (while)

Par contre, dans cet exemple, le return final ne peut se placer après la structure de lecture, au risque de boucler sur des erreurs après la fin de fichier.

[Lolo78]

Bonjour ptonnerre,

j'ai regardé mon programme réel au boulot, et j'avais effectivement oublié un petit bout de code en simplifiant et anonymisant le programme d'origine.

Ma solution pour gérer le dernier groupe d'enregistrements était essentiellement du même ordre que celle proposée par disedorgue, même si ce n'était pas tout-à-fait au même endroit dans le code:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
if ( $line =~ /^0;/ or eof $IN) {

[disedorgue]

Euh... il manquerait pas la dernière ligne dans le tableau en le mettant ici ?
Car dans la partie if, on ne fait pas de push...

[Lolo78]

Effectivement, ça pourrait arriver, mais ça n'est jamais arrivé dans les faits, sans doute parce qu'il y avait toujours une dernière ligne vide dans les fichiers en entrée.

[ptonnerre]

Après avoir utilisé les fermetures dans notre modèle de script et dans les modules maison, j'ai eu l'occasion de les mettre en oeuvre dans un premier script de production.

Un nouveau rapport quotidien d'une chaine de traitement nécessite d'exécuter via SSH des commandes sur plusieurs serveurs distants (entre 10 et 15) pour traitements à différentes étapes du script, chaque serveur pouvant être interrogé plusieurs fois.

J'ai utilisé le module Net::SSH:: Perl et au lieu de répéter la partie ouverture de connexion puis exécution de la commande, l'utilisation des fermetures dans une usine à fonction a considérablement allégé le code et sans doute amélioré ses performances par rapport à une programmation procédurale classique.

En début de programme :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
sub f_open_ssh {
    my ( $srv, $ref_h_env ) = @_;
 
    my $user    = $ref_h_env->{'script_user'};
    my @keyfile = ( "/home/${user}/.ssh/id_rsa" );
    my $sshobj  = Net::SSH:: Perl->new ( $srv_appl, identity_files => \@keyfile );
    $sshobj->login();
 
    return sub {
        my ( $stdout, $stderr, $rc ) = $sshobj->cmd( shift );
        return ( $stdout, $stderr, $rc );
    }
}

ouverture de la connexion sur un serveur :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

my $r_f_exec_ssh_cmd_srv1 = f_open_ssh ( $srv1, $ref_h_env );

utilisation à plusieurs endroits du script :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
my $cmd = ".....";
my ( $stdout, $stderr, $rc ) = $r_f_exec_ssh_cmd_srv1->( $cmd );

Idem pour srv2, srv3...

Pratique non !
Reste à attaquer sérieusement la partie 3 de cet excellent tutoriel