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
|
package MTools::MObjet;
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU LGPL Libray General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU Library General Public License for more details.
#
# You should have received a copy of the GNU Library General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA,
# or refer to http://www.gnu.org/copyleft/lgpl.html
#
##################################################################
# Le composant MObjet est l'objet racine des composants MTools.
# Il definit les fonctions applicables uniquement aux objets MTools.
#
# IMPORTANT : Une autre partie des fonctions applicables aux objets MTools est definie dans la classe MTools.
# La difference entre ces deux classes de fonctions est que les fonctions definies dans MTools sont egalement
# applicables ? des objets zinc tandis que les fonctions definies ici ne peuvent etre appliquees que a des objets heritant de MTools::MObjet.
#
# Concepts :
# * Objet MTools : objet heritant de MObjet
# * Les PROPERTY : Les proprietes sont des attributs particuliers et modifiables
# par un appel a "mconfigure". Elles peuvent etre ecoutees et synchronisees avec d'autres proprietes
# MTools ou meme zinc ! (cf MTools::plink et MTools::plisten). En consequence elles sont la pour engendrer un comportement
# consecutif ? leur modification et doivent etre distinguees des attibuts qui peuvent se contenter d'etre ds clef de hash de l'objet.
# * Les EVENT : les evenements peuvent etre emis par n'importe quel objet MTools et capter par un binding.
#
# Les fonctions public :
# * recordEvent : permet de permettre a un objet MObjet d'emettre un evenement.
# * recordProperty : permet de declarer et initialiser une propriete.
# NOTA : Il pourrait manquer une declaration collective des proprietes. Initialement,
# celle-ci n'a pas ete effectuee pour essayer de limiter l'usage des proprietes
# et ne pas les utiliser comme des attributs.
# * notify : permet a un objet MTools de notifier un evenement prealablement enregistre par recordEvent
# * propagate : permet a un objet de propager un evenement emis par un autre objet
# (correspond a un recordEvent puis un binding sur un evenement d'un objet effectuant le notify du meme evt
# depuis l'objet declarant la propagation)
use strict;
use MTools;
use vars qw /@ISA @EXPORT @EXPORT_OK/;
BEGIN
{
@ISA = qw //;
}
sub new {
my ($class) = @_;
my $self = {};
$self -> {instance} = -1;
bless $self, $class;
return $self;
}
sub recordEvent {
my ($self, $event) = @_;
if (!(defined $self -> {__events} -> {$event}))
{
$self -> {__events} -> {$event} = [];
}
}
sub recordProperty {
my ($self, $prop, $val) = @_;
$self -> {__properties} -> {$prop} -> {val} = $val;
}
sub notify {
my ($self, $event, @params) = @_;
if (!defined $self -> {__events} -> {$event})
{
print "ERREUR $self : Vous essayer de notifier l'evenement $event qui n'est pas declare\n";
return;
}
my @tb = @{$self -> {__events} -> {$event}};
for (my $i = 0; $i < @tb; $i++)
{
executer ($tb[$i], @params);
}
}
sub propagate {
my ($self, $from, $event, @nargs) = @_;
$self -> recordEvent ($event);
$from -> __addListener ($event,
sub {
my (@args) = @_;
$self -> notify ($event, @args, @nargs);
}
);
}
sub __addListener {
my ($self, $event, $methode) = @_;
if (defined $self -> {__events} -> {$event})
{
push (@{$self -> {__events} -> {$event}}, $methode);
return $methode;
}
else
{
print "ERREUR : l'objet $self n'?met jamais l'evt $event... L'abonnement est donc inutile\n";
}
}
sub __removeListener {
my ($self, $event, $methode) = @_;
if (defined $self -> {__events} -> {$event})
{
my @events = @{$self -> {__events} -> {$event}};
for (my $i = @events - 1; $i >= 0; $i--)
{
if ($events [$i] == $methode)
{
splice (@{$self -> {__events} -> {$event}}, $i, 1);
}
}
}
}
1;
|
