diff options
Diffstat (limited to 'src/MTools/MObjet.pm')
| -rw-r--r-- | src/MTools/MObjet.pm | 128 |
1 files changed, 128 insertions, 0 deletions
diff --git a/src/MTools/MObjet.pm b/src/MTools/MObjet.pm new file mode 100644 index 0000000..b35c07f --- /dev/null +++ b/src/MTools/MObjet.pm @@ -0,0 +1,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 MObject est l'objet racine des composants MTools. +# Il defini 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; |