view release on metacpan or  search on metacpan

contrib/Events.mom  view on Meta::CPAN

#!/usr/bin/perl -w
#----------------------------------------------------------------------------
#   App::Modular::Module::Events - perl program modularization framewok
#                                 event handler class
#
#   Copyright (c) 2003-2004 Baltasar Cevc
#
#   This code is released under the L<perlartistic> Perl Artistic
#   License, which can should be accessible via the C<perldoc
#   perlartistic> command and the file COPYING provided with this
#
#   DISCLAIMER: THIS SOFTWARE AND DOCUMENTATION IS PROVIDED "AS IS," AND
#   COPYRIGHT HOLDERS MAKE NO REPRESENTATIONS OR WARRANTIES, EXPRESS OR
#   IMPLIED, INCLUDING BUT NOT LIMITED TO, WARRANTIES OF MERCHANTABILITY
#   OR FITNESS FOR ANY PARTICULAR PURPOSE OR THAT THE USE OF THE SOFTWARE
#   OR DOCUMENTATION WILL NOT INFRINGE ANY THIRD PARTY PATENTS, COPYRIGHTS,
#   TRADEMARKS OR OTHER RIGHTS.
#   IF YOU USE THIS SOFTWARE, YOU DO SO AT YOUR OWN RISK.
#
#   See this internet site for more details: http://technik.juz-kirchheim.de/
#
#   Creation:       30.07.04    bc
#   Last Update:    17.02.05    bc
#   Version:         0. 1. 1  
# ----------------------------------------------------------------------------

###################
###             ###
###    INIT     ###
###             ###
################### 
package App::Modular::Module::Events;
use base qw(App::Modular::Module);

###################
###    Pragma   ###
###################
use strict;
use warnings;

###################
### Dependencies###
###################
use 5.006_001;

###################
###  Version    ###
###################
our ($VERSION);
$VERSION = 0.001_001;

###################
### Constructor ###
###################
sub module_init {
   my ($type) = @_;

   my $self = $type->SUPER::module_init($type);

   $self->{'events'} = {};

   return $self;
};

###################
###Register Event##
###################
# register a module as event listener/"handler"
sub register {
   my ($self, $module, $event) = @_;
   my (@listeners) = ();
   if (ref $module) {
      $module = ref $module;
      $module =~ s/^App::Modular::Module:://;
   }

   $self->modularizer()->mlog (95, 
       "adding event $event listener for module $module");
   ${$self->{'events'}}{$event} =
      \@listeners unless (${$self->{'events'}}{$event});
   # we'll only save module names as listeners for easier handling
   push @{${$self->{'events'}}{$event}}, $module;

   # return an array of all listening modules for this event
   return @{${$self->{'events'}}{$event}};
};

sub deregister {
   my ($self, $module, $event) = @_;
   my $offset;

   $self->modularizer->mlog (99, "deregistering event $event listener for module $module"); 
   for ($offset = 0; $offset <= $#{${$self->{'events'}}{$event}}; $offset ++) {
      splice @{${$self->{'events'}}{$event}}, $offset, 1
         if (${${$self->{'events'}}{$event}}[$offset] eq $module);
   };
};

# trigger an event (call the handlers of all registered listeners)
sub trigger {
   my ($self, $event, @parameters) = @_;
   my (@listeners, %listeners);
   my $module;

   # return unless the event is known
   unless ($event) {
      $self->modualrizer->mlog(2, "Event handler: trigger: need ".
         "event as argument");
         return undef;
   }
   unless (${$self->{'events'}}{$event}) {
      $self->modularizer->mlog(2, "Event handler: '$event' unknown");
      return undef;
   }

   # we know this event: juppie, let's start
   $self -> modularizer -> mlog (95,
      "Sending event '$event' signal to modules:");