use strict;
use warnings;
package EventArgs;
sub new
{
my ($class) = @_;
my $self = {};
$self->{HANDLED} = 0;
bless($self, $class);
return $self;
}
sub handled
{
my ($self, $value) = @_;
if (defined($value)) { $self->{HANDLED} = $value; }
return $self->{HANDLED};
}
1;
package Event;
sub new
{
my ($class) = @_;
my $self = {};
$self->{HANDLERS} = [];
bless($self, $class);
return $self;
}
sub DESTROY
{
my ($self) = @_;
$self->removeall;
}
sub add
{
my ($self, $handler) = @_;
push(@{$self->{HANDLERS}}, $handler) if defined($handler);
return $self;
}
sub remove
{
my ($self, $handler) = @_;
if (defined($handler))
{
my $i = 0;
my @handlers = @{$self->{HANDLERS}};
for (; $i <= $#handlers; $i++)
{
last if $self->{HANDLERS}->[$i] == $handler;
}
splice(@{$self->{HANDLERS}}, $i, 1) if $i <= $#handlers;
}
return $self;
}
sub removeall
{
my ($self) = @_;
splice(@{$self->{HANDLERS}});
return $self;
}
sub trigger
{
my ($self, $sender, $args) = @_;
if (scalar(@{$self->{HANDLERS}}) > 0)
{
foreach (@{$self->{HANDLERS}})
{
$_->($sender, $args);
last if $args->handled;
}
}
}
1;
package main;
my $ev = Event->new;
my $sample = undef;
print "----------------\n";
sub handler
{
my ($sender, $args) = @_;
print "Handler 2\n";
}
$ev->add(sub { my ($sender, $args) = @_; print "Handler 1\n"; });
$ev->trigger($sample, EventArgs->new);
print "----------------\n";
$ev->add(\&handler);
$ev->trigger($sample, EventArgs->new);
print "----------------\n";
$ev->remove(\&handler);
$ev->add(sub { my($sender, $args) = @_; print "New handler\n"; });
$ev->trigger($sample, EventArgs->new);
print "----------------\n";
sub blockingHandler
{
my ($sender, $args) = @_;
$args->handled(1);
print "Last handler\n";
}
$ev->add(\&blockingHandler);
$ev->add(sub { my ($sender, $args) = @_; print "should not run\n"; });
$ev->trigger($sample, EventArgs->new);
print "----------------\n";
$ev->removeall;
$ev->add(sub { my($sender, $args) = @_; print "Sole handler\n" });
$ev->trigger($sample, EventArgs->new);