File Coverage

blib/lib/MooseX/Event/Role.pm

Criterion	Covered	Total	%
statement	10	12	83.3
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	14	16	87.5

# ABSTRACT: A Node style event Role for Moose
package MooseX::Event::Role;
{
  $MooseX::Event::Role::VERSION = '0.3.0_2';
}
use MooseX::Event ();
use Any::Moose 'Role';
use Scalar::Util qw( refaddr reftype blessed );
use Event::Wrappable ();


sub metaevent {
    my $self = shift;
    my( $event ) = @_;
    my $accessor = $self->can("event:$event");
    return defined $accessor ? $self->$accessor() : undef;
}


sub get_all_events {
    my $self = shift;
    return map {substr($_,6)} grep {/^event:/} map {$_->name} $self->meta->get_all_attributes;
}


sub event_listeners {
    my $self = shift;
    my( $event ) = @_;
    my $emeta = $self->metaevent($event);
    unless ( $emeta ) {
        require Carp;
        Carp::confess("Event $event does not exist");
    }
    my @listeners = values %{$emeta->listeners};
    return wantarray? @listeners : scalar @listeners;
}

# Having the first argument flatten the argument list isn't actually allowed
# in Rakudo (and possibly P6 too)


sub on {
    my $self = shift;
    my $listener = pop;

    # If it's not an Event::Wrappable object, make it one.
    if ( ! blessed $listener or ! $listener->isa("Event::Wrappable") ) {
        $listener = &Event::Wrappable::event( $listener );
    }

    for my $event (@_) {
        my $emeta = $self->metaevent($event);
        unless ( $emeta ) {
            require Carp;
            Carp::confess("Event $event does not exist");
        }
        $emeta->listen( $listener );
    }
    return $listener;
}

sub once {
    my $self = shift;
    my $listener = pop;

    # If it's not an Event::Wrappable object, make it one.
    if ( ! blessed $listener or ! $listener->isa("Event::Wrappable") ) {
        $listener = &Event::Wrappable::event( $listener );
    }

    for my $event (@_) {
        my $emeta = $self->metaevent($event);
        unless ( $emeta ) {
            require Carp;
            Carp::confess("Event $event does not exist");
        }
        $emeta->listen_once( $listener );
    }
    return $listener;
}

sub emit {
    my $self = shift;
    my( $event, @args ) = @_;
    # The event object attributes are lazy, so if one doesn't exist yet
    # don't trigger the creation of it just to fire events into the void
    if ( reftype $self eq 'HASH' ) {
        return unless exists $self->{"event:$event"};
    }
    my $emeta = $self->metaevent($event);
    unless ( $emeta ) {
        require Carp;
        Carp::confess("Event $event does not exist");
    }
    $emeta->emit_self( @args );
}



sub remove_all_listeners {
    my $self = shift;
    foreach ($self->get_all_events) {
        $self->metaevent($_)->stop_all_listeners;
    }
}


sub remove_listener {
    my $self = shift;
    my( $event, $listener ) = @_;
    my $emeta = $self->metaevent($event);
    unless ( $emeta ) {
        require Carp;
        Carp::confess("Event $event does not exist");
    }
    $emeta->stop_listener($listener);
}

1;


__END__