Discussion :

[dca_marshall]

Bonjour,

J'ai beau fouiller, je ne trouve pas !

Existe-t-il un pointeur disponible pour obtenir le contexte d'une fonction, quand celle-ci en appelle une autre ?

Dans la fonction appelée, je voudrai récupérer le stack de variables de la fonction appelante.

On récupère bien son nom et la ligne dans le module avec caller, il n'y a pas un truc ?

Par avance merci de votre contribution

[cmcmc]

Peut-être peux tu jeter un oeil à Eval::WithLexicals

Je ne suis pas sûr de comprendre ce que tu veux faire mais ça risque d'être extrêmement compliqué à cause des différentes portées à considérer (dynamique, lexicale, fichier, package, globale) et des perturbations apportées par local...

[Philou67430]

En lisant la doc de caller (perldoc -f caller), on trouve se paragraphe :

Furthermore, when called from within the DB package, caller
returns more detailed information: it sets the list variable
@DB::args to be the arguments with which the subroutine was
invoked.

Et dans la doc de DB, on trouve la variable globale :

@DB::args
Contains the arguments of current subroutine, or the @ARGV
array if in the toplevel context.

Ca me parait répondre à la question.

[dca_marshall]

Bonjour,

D'abord merci de vos réponses.

@cmcmc:
Je ne connaissais pas ce module, je regarde ça ce WE.

@Philou67430:
Le truc du @DB::args, j'utilise déjà le même principe pour passer les arguments qui sont référencés entre appelante et appelée.
En fait je passe un Anonymous Hash et récupère sa référence dans @_.


Pour aller un peu plus loin dans l'explication.

Soit fonction appelante F1 et fonction appelée F2.

F1 passe 4 ou 5 paramètres à F2 par un hash anonyme. Qui est bien récupéré par F2.

Quand F2 fait son boulot, elle peu détecter des erreurs venant du mauvais paramètrage de F1.

La majorité de ces erreurs sont reconnues F2. Mais les traitements de corrections sont très complexes et se trouve dans d'autres fonctions déjà utilisées.

Donc je voudrai, dans F2, prendre les variables du contexte de F1, les reformater et les passer à une multitude de fonctions (via un autre Hash), pour actions particulières.
Seules ces fonction sont à même de "réparée" la situation.

Et pour contribuer à la complexité, les noms fonctions tierces, sont dans un fichier XML de paramètres.
Dans le style IncidentType="IC1" WorkAround="F3".

Ceci revient à faire un Scheduler sur événement...

J'espère être clair dans l'énoncé.

Je vais quand même explorer vos recommandations. Je suis surement tombé dans des habitudes de dev et j'ai de la peau de saucisson devant les yeux...



Merci encore de votre contribution.

[cmcmc]

Donc je voudrai, dans F2, prendre les variables du contexte de F1, les reformater et les passer à une multitude de fonctions (via un autre Hash), pour actions particulières.

Qu'est-ce que tu appelles les variables du contexte de F1 ? Les paramètres d'appel de F1 ? Les variables lexicales déclarées dans F1 ? Les variables du package de F1 ? etc...

[dca_marshall]

Bonjour,

Pardon de ne pas l'avoir préciser.

Je souhaite obtenir les variables Lexicales.

Les variables de Package ne me sont pas nécessaires (le les obtient par ailleurs).

Les variables d'arguments de FA1 sont passées de F1 à F2 par une reférence de hash anonyme.

Celles de Fxx à F1 sont elles aussi passées par une autre référence à un autre hash (qui est aussi forwardée à F2).

Merci encore de ta contribution.

[Philou67430]

Pourrais-tu fournir un exemple simplifié de deux fonctions F1 et F2 et indiquer exactement à quelles données tu souhaites accéder, et si c'est uniquement en lecture, où également en écriture (avec un exemple de traitement simple par exemple) ?
En particulier, quand tu écris

"Mais les traitements de corrections sont très complexes
...
Donc je voudrai, dans F2, prendre les variables du contexte de F1, les reformater et les passer à une multitude de fonctions (via un autre Hash), pour actions particulières.

il n'est pas clair si tu souhaites réparer ces variables dans le contexte de F2, ou à la fois dans le contexte de F2 mais aussi de F1.
Comme tu indiques qu'il s'agit de lexicales et d'un hash anonyme, je pense qu'il s'agit bien de ne réparer la situation que dans F2, mais comme je n'ai pas encore tout saisis, le doute persiste.

[dca_marshall]

@Philou67430
Merci encore de ton intérêt.

Les variables ne seront pas modifiées, ça passe par des méthodes objets et les fonctions en erreur seront rejouées avec les nouvelles valeurs des propriétés d'objets.
Il s'agit donc de réparer les objets, pas les variables.

Voici en 3 modules (succincts) pour illustrer ce qui est recherché.

Module 1:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
package module1;
sub F1(@) {
	my $function=(caller(0))[3];
	my $rc=12;
	my $var1='toto';
	my $var2='titi';
	my $var3='tutu';
	my $var4='tata';
	my $var5='tete';
	$rc=module2::F2({ function => $function, param1 => $var1 })
	return $rc;
}
1;

Module 2:

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
 
package module2;
sub F2(@) {
	use Switch;
	my $function=(caller(0))[3];
	my ($refArg)=@_;
 
	switch ($refArg->{param1}) {
		case 'toto' {
			print "La fonction ".$refArg->{function}." envoi bien ce qu'il faut ".$refArg->{param1}."\n";
			return 0;
		}
		else {
			# Je voudrai ici obtenir en lecture le contenu de module1::F1::var1 à var5, sans les nommer, pour faire un truc du style :
			module3::F3({ le hash contenant toutes les my de module1::F1,  })
			return 12;
		}
	}
	return 4;
}
1;

Module 3:

Code :

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

1
2
3
4
5
6
7
8
package module3;
sub F3(@) {
	my $function=(caller(0))[3];
	my ($refArg)=@_;
	# Faire ce qu'il faut ici pour réparer l'objet avec les valeurs de la pile de variables
	return 0;
}
1;

Je n'ai pas testé ça, mais juste écrit pour l'exemple.
J'espère que c'est plus clair pour toi.

Merci beaucoup.

[Philou67430]

Ça m'a l'air plus clair. Je ne connais pas de méthode permettant d'accéder à des variables lexicalement locales en dehors de l'étendue actuelle, par exemple, accéder à $var2 de module1::F1 dans module3::F3.

[cmcmc]

J'espère que c'est plus clair

C'est plus clair effectivement. Ce qu'il te faut je crois c'est PadWalker, comme dans l'exemple ci-dessous (basé sur le tien, j'ai simplement viré Switch, et modifié F1 pour exhiber les deux comportements) :

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
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
# -*- Mode: cperl; coding: utf-8; tab-width: 8; indent-tabs-mode: nil; cperl-indent-level: 4 -*-
# test.pl
use strict;
use warnings;
 
package module1;
sub F1(@) {
    my $function = (caller(0))[3];
    my $rc = 12;
    my $var1 = 'toto';
    my $var2 = 'titi';
    my $var3 = 'tutu';
    my $var4 = 'tata';
    my $var5 = 'tete';
    my @list1='foo bar baz';
    my %hash1 = (qux => 'xyzzy');
 
    ($var1) = @_;
 
    $rc=module2::F2({ function => $function, param1 => $var1 });
    return $rc;
}
 
package module2;
use PadWalker;
sub F2(@) {
    my $function=(caller(0))[3];
    my ($refArg)=@_;
 
    if ($refArg->{param1} eq 'toto') {
        print "La fonction ".$refArg->{function}." envoi bien ce qu'il faut ".$refArg->{param1}."\n";
        return 0;
    } else {
        # Je voudrai ici obtenir en lecture le contenu de module1::F1::var1 à var5, sans les nommer, pour faire un truc du style :
        my $up = 1;
        ++$up while ((caller($up))[3] ne $refArg->{function});
        module3::F3(PadWalker::peek_my($up));
        return 12;
    }
    return 4;
}
 
package module3;
sub F3(@) {
    my $function=(caller(0))[3];
    my ($refArg)=@_;
    # Faire ce qu'il faut ici pour réparer l'objet avec les valeurs de la pile de variables
    use Data::Dumper;
    print "faire ce qu'il faut avec " . Dumper($refArg);
    return 0;
}
 
package main;
module1::F1('toto');
module1::F1('die die die');

chez moi ça donne ça :

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
Taisha:~/tttmp/eval-my-vars-upstack $ perl test.pl
La fonction module1::F1 envoi bien ce qu'il faut toto
faire ce qu'il faut avec $VAR1 = {
          '$var4' => \'tata',
          '$var3' => \'tutu',
          '$var5' => \'tete',
          '@list1' => [
                        'foo bar baz'
                      ],
          '%hash1' => {
                        'qux' => 'xyzzy'
                      },
          '$var2' => \'titi',
          '$function' => \'module1::F1',
          '$rc' => \12,
          '$var1' => \'die die die'
        };
Taisha:~/tttmp/eval-my-vars-upstack $

Incidemment, à quoi servent les prototypes ???

[edit : ça marche aussi avec @list1 = qw/foo bar baz/; ]

[dca_marshall]

@cmcmc
Je crois que tu as mis le doigt dessus.
Je m'empresse de tester ça aujourd'hui.

Pour les prototype je sais que c'est mal d'utiliser @_.
Mais je te promet de m'améliorer
Encore milles mercissssssss

Attendez avant de fermer.
Je te fais un retour à cmcmc...

[dca_marshall]

@cmcmc

Je test le truc.
J'ai compris le principe, mais ça part en boucle.
Je regarde ça de plus prêt demain (suis dans le code depuis 5h00 ce matin sur d'autres sujets, en plus d'impressions 3D qui font n'importe quoi. Je sais, pas de rapport, mais, à part ta contribution, mauvaise journée).

En tout cas, merci encore de ta participation.
Je te fais retour au plus vite....

[cmcmc]

J'ai compris le principe, mais ça part en boucle.

c'est sûr que Perl ne manque pas d'outils pour se tirer dans le pied mais celui ci relève clairement plus du missile anti-chars que du lance-pierre ...

Ne pas oublier en particulier que les valeurs du hash retourné par PadWalker::peek_my sont des références sur les variables my de la fonction cible.

A titre indicatif, au cas où ...

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
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
# -*- Mode: cperl; coding: utf-8; tab-width: 8; indent-tabs-mode: nil; cperl-indent-level: 4 -*-
# test3.pl
use strict;
use warnings;
use utf8;
use Data::Dumper;
 
package Prefix;
sub TIEHANDLE {
    my ($class, $prefix) = @_;
    my $self = { prefix => $prefix, text => ''};
    bless $self, $class
}
sub PRINT {
    my $self = shift;
    for (split /(\n)/, join '', @_) {
        if (m/\n/) {
            print "$self->{prefix}$self->{text}\n";
            $self->{text} = ''
        } else {
            $self->{text} .= $_
        }
    }
}
sub CLOSE {
    my $self = shift;
    print "$self->{prefix}$self->{text}\n" and $self->{text} = '' if $self->{text}
}
sub UNTIE {
    my $self = shift;
    $self->CLOSE;
}
 
package Prefix::Guard;
 
sub new {
    my ($class, $glob, $prefix) = @_;
    tie *$glob, 'Prefix', $prefix;
    bless { glob => $glob}, $class;
}
 
DESTROY {
    my $self = shift;
    my $glob = $self->{glob};
    untie *$glob;
}
 
package module1;
use Data::Dumper;
sub F1(@) {
    my $function = (caller(0))[3];
    my $rc = 12;
    my $var1 = 'toto';
    my $var2 = 'titi';
    my $var3 = 'tutu';
    my $var4 = 'tata';
    my $var5 = 2000;
    my @list1 = qw/foo bar baz/;
    my %hash1 = (qux => 'xyzzy');
 
    ($var1) = @_;
 
    {
        my $guard = Prefix::Guard->new( *F1, "[F1 avant F2] ");
        print F1 +Data::Dumper->Dump([$var1, $var2, $var3, $var4, $var5, \@list1, \%hash1], [qw(*var1 *var2 *var3 *var4 *var5 *list1 *hash1)]);
    }
    $rc=module2::F2({ function => $function, param1 => $var1 });
    {
        my $guard = Prefix::Guard->new( *F1, "[F1 après F2] ");
        print F1 +Data::Dumper->Dump([$var1, $var2, $var3, $var4, $var5, \@list1, \%hash1], [qw(*var1 *var2 *var3 *var4 *var5 *list1 *hash1)]);
    }
    return $rc;
}
 
package module2;
use PadWalker;
sub F2(@) {
    my $function=(caller(0))[3];
    my ($refArg)=@_;
 
    my $guard = Prefix::Guard->new( *F2, '[F2] ');
 
    if ($refArg->{param1} eq 'toto') {
        print F2 "La fonction ".$refArg->{function}." envoi bien ce qu'il faut ".$refArg->{param1}."\n";
        return 0;
    } else {
        print F2 "Ça ne va pas du tout, je sors l'artillerie.\n";
        # Je voudrai ici obtenir en lecture le contenu de module1::F1::var1 à var5, sans les nommer, pour faire un truc du style :
        my $up = 1;
        ++$up while ((caller($up))[3] ne $refArg->{function});
        module3::F3(PadWalker::peek_my($up));
        return 12;
    }
    return 4;
}
 
package module3;
use Data::Dumper;
sub F3(@) {
    my $function=(caller(0))[3];
    my ($refArg)=@_;
    tie *F3, 'Prefix', '[F3] ';
    # Faire ce qu'il faut ici pour réparer l'objet avec les valeurs de la pile de variables
    print F3 "faire ce qu'il faut avec " . Dumper($refArg);
    print F3 "ces variables sont insensées : on les remet dans le droit chemin\n";
    for (qw($var1 $var2 $var3 $var4 $var5 @list1 %hash1)) {
        my $name = $_;
        for ($refArg->{$name}) {
            if (ref eq 'SCALAR') {
                print F3 "  on corrige $name de '${$_}'";
                ${$_} = reverse ${$_};
                print F3 " en '${$_}'\n";
                next;
            }
            if (ref eq 'ARRAY') {
                print F3 "  on corrige $name de (@{$_})";
                @{$_} = reverse @{$_};
                print F3 " en (@{$_})\n";
                next;
            }
            if (ref eq 'HASH') {
                my @l = %{$_};
                print F3 "  on corrige $name de (@l)";
                %{$_} = reverse %{$_};
                @l = %{$_};
                print F3 " en (@l)\n";
                next;
            }
        }
    }
    return 0;
}
 
package main;
module1::F1('die die die');

Chez moi :

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
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
Taisha:~/tttmp/eval-my-vars-upstack $ perl test3.pl
[F1 avant F2] $var1 = 'die die die';
[F1 avant F2] $var2 = 'titi';
[F1 avant F2] $var3 = 'tutu';
[F1 avant F2] $var4 = 'tata';
[F1 avant F2] $var5 = 2000;
[F1 avant F2] @list1 = (
[F1 avant F2]            'foo',
[F1 avant F2]            'bar',
[F1 avant F2]            'baz'
[F1 avant F2]          );
[F1 avant F2] %hash1 = (
[F1 avant F2]            'qux' => 'xyzzy'
[F1 avant F2]          );
[F2] Ça ne va pas du tout, je sors l'artillerie.
[F3] faire ce qu'il faut avec $VAR1 = {
[F3]           '$var4' => \'tata',
[F3]           '$var3' => \'tutu',
[F3]           '$var5' => \2000,
[F3]           '@list1' => [
[F3]                         'foo',
[F3]                         'bar',
[F3]                         'baz'
[F3]                       ],
[F3]           '%hash1' => {
[F3]                         'qux' => 'xyzzy'
[F3]                       },
[F3]           '$var2' => \'titi',
[F3]           '$function' => \'module1::F1',
[F3]           '$rc' => \12,
[F3]           '$var1' => \'die die die'
[F3]         };
[F3] ces variables sont insensées : on les remet dans le droit chemin
[F3]   on corrige $var1 de 'die die die' en 'eid eid eid'
[F3]   on corrige $var2 de 'titi' en 'itit'
[F3]   on corrige $var3 de 'tutu' en 'utut'
[F3]   on corrige $var4 de 'tata' en 'atat'
[F3]   on corrige $var5 de '2000' en '0002'
[F3]   on corrige @list1 de (foo bar baz) en (baz bar foo)
[F3]   on corrige %hash1 de (qux xyzzy) en (xyzzy qux)
[F1 après F2] $var1 = 'eid eid eid';
[F1 après F2] $var2 = 'itit';
[F1 après F2] $var3 = 'utut';
[F1 après F2] $var4 = 'atat';
[F1 après F2] $var5 = '0002';
[F1 après F2] @list1 = (
[F1 après F2]            'baz',
[F1 après F2]            'bar',
[F1 après F2]            'foo'
[F1 après F2]          );
[F1 après F2] %hash1 = (
[F1 après F2]            'xyzzy' => 'qux'
[F1 après F2]          );
Taisha:~/tttmp/eval-my-vars-upstack $

Don't do evil

[Philou67430]

Don't do evil

Too late

[dca_marshall]

Bonjour cmcmc,

Je vois que tu t'amuse bien !

Bon je viens d'intégrer tous ça.
C'est vrai que c'est très lourd. C'est juste monumental...
Je n'avais pas imaginé que cela ramènerai aussi le hash qui me sert sert de base données (il fait entre 3 et 21Go selon le cas).

Je vais voir ce que cela coûte en performance pour les seules valeurs qui m'intéressent.
Si c'est vraiment trop lourd, je crois que je vais me rabattre sur qq chose de plus académique.

En tous cas j'ai vraiment apprécié ton aide et tes mises en application.
J'explore les capacités de de cette solution et la garde sous le coude, pour au moins du Debug.

Merci encore à toi cmcmc (sans oublier Philou67430).
Je vous suis très reconnaissant.

A très vite.

[Philou67430]

Si c'est vraiment trop lourd, je crois que je vais me rabattre sur qq chose de plus académique.

Comme lever des exceptions et les traiter en retour ?

[cmcmc]

Bonjour cmcmc,

Je vois que tu t'amuse bien !

C'est effectivement un problème amusant

Bon je viens d'intégrer tous ça.
C'est vrai que c'est très lourd. C'est juste monumental...
Je n'avais pas imaginé que cela ramènerai aussi le hash qui me sert sert de base données (il fait entre 3 et 21Go selon le cas).

Ouch. Donc éviter les dumps de données (quoique

Code :

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

$Data::Dumper::Maxdepth

peut être utile dans ce cas )

Je vais voir ce que cela coûte en performance pour les seules valeurs qui m'intéressent.

A priori très peu de choses, tu ne traites que des références, et une référence à une BD de 21 Go ne coûte pas plus qu'une référence à un scalaire...

Si c'est vraiment trop lourd, je crois que je vais me rabattre sur qq chose de plus académique.

Ce qui est probablement sage si tu as accès au code en question

En tous cas j'ai vraiment apprécié ton aide et tes mises en application.
J'explore les capacités de de cette solution et la garde sous le coude, pour au moins du Debug.

Oui, ça ouvre un accès programmatique à des capacités normalement réservées au debugger. Tu peux également jeter un œil à Devel::Trepan pour voir comment il opère

Merci encore à toi cmcmc (sans oublier Philou67430).
Je vous suis très reconnaissant.

A très vite.

N'hésite pas Incidemment, note bien que c'est toi et toi seul qui peut marquer un topic comme résolu.