view release on metacpan or  search on metacpan

lib/Ambrosia/Event.pm  view on Meta::CPAN

package Ambrosia::Event;
use strict;
use warnings;

use Ambrosia::Meta;
class sealed
{
    private => [qw/_handlers/],
};

our $VERSION = 0.010;

sub import
{
    no strict 'refs';
    no warnings 'redefine';

    my $proto = shift;
    throw Ambrosia::error::Exception("'$proto' cannot inherit from sealed class '" . __PACKAGE__ . '\'.') if $proto ne __PACKAGE__;

    my $INSTANCE_CLASS = caller(0);

    foreach my $e ( @_ ) #@events )
    {
        *{"${INSTANCE_CLASS}::$e"} = sub()
        {
            #my $pack = ref $_[0];
            #$pack =~ s/::/_/sg;
            #attachHandler($pack . '_' . $e, $_[1]);
            attachHandler($_[0], $e, $_[1]);
            $_[0];
        };
    }
    *{"${INSTANCE_CLASS}::publicEvent"} = sub()
    {
        my $self = shift;
        fireEvent($self, @_);
    };
}

{
    my %__EVENT_HANDLER__ = ();

    sub new : Private {};

    sub instance
    {
        return $__EVENT_HANDLER__{$$} ||= __PACKAGE__->SUPER::new();
    }
}

sub _init
{
    my $self = shift;
    $self->SUPER::_init(@_);
    $self->_handlers = {};
}

sub attachHandler
{
    my $class = shift;
    my $type = ref $class || $class || '';
    my $name = shift;
    my $handler = shift;

    my $h = instance();

    if ( my $prev = $h->_handlers->{$type}->{$name} )
    {
        $h->_handlers->{$type}->{$name} = sub { $handler->(@_) || $prev->(@_) };
    }
    elsif (ref $handler eq 'CODE')
    {
        $h->_handlers->{$type}->{$name} = $handler;
    }
    else
    {
        die 'error';
    }