File Coverage

blib/lib/Object/Pad/Role/EventEmitter.pm

Criterion	Covered	Total	%
statement	80	84	95.2
branch	11	16	68.7
condition	5	7	71.4
subroutine	22	22	100.0
pod	5	5	100.0
total	123	134	91.7

use v5.16;  # because of __SUB__
use Feature::Compat::Try;
use Object::Pad 0.79;

package Object::Pad::Role::EventEmitter;
role Object::Pad::Role::EventEmitter;

use Scalar::Util qw(blessed);
use Scope::Guard;


field %subscribers;
field $_guard; # Emulate DEMOLISH

method emit( $event, @args ) {
    if (exists $subscribers{$event}) {
        for my $cb (@{$subscribers{$event}}) {
            $cb->[0]->( $self, @args );
        }
    }
}

method has_subscribers( $event ) {
    return ((exists $subscribers{$event})
            and (@{$subscribers{$event}} > 0));
}

method on( $event, $subscriber ) {
    $subscribers{$event} //= [];
    if (not $_guard) { # Emulate DEMOLISH
        $_guard = Scope::Guard->new(
            sub {
                for my $event (keys %subscribers) {
                    # make sure all futures are cancelled
                    # and queues are finished
                    for my $item (@{$subscribers{$event}}) {
                        $item->[1]->();
                    }
                }
            })
    }

    my $item;
    if (blessed $subscriber) {
        if ($subscriber->isa("Future")) {
            $item = [
                sub {
                    my ($self) = @_;
                    $subscriber->done( @_ );
                    $self->unsubscribe( $event, __SUB__ );
                },
                sub { $subscriber->cancel; }
                ];
        }
        else { # this must be a Future::Queue
            $item = [
                sub {
                    my ($self) = @_;
                    try {
                        $subscriber->push( [ @_ ] );
                    }
                    catch ($e) {
                        # the queue was finished; unsubscribe
                        $self->unsubscribe( $event, __SUB__ );
                    }
                },
                sub { $subscriber->finish; }
                ];
        }
    }
    else {
        $item = [ $subscriber, sub { } ];
    }
    push @{$subscribers{$event}}, $item;
    return $item->[0];
}

method once( $event, $subscriber ) {
    return $self->on(
        $event,
        sub {
            my ($self) = @_;
            $subscriber->( @_ );
            $self->unsubscribe( $event, __SUB__ );
        });
}

method unsubscribe( $event, $subscription=undef ) {
    return unless exists $subscribers{$event};

    if ($subscription) {
        my $idx;
        my $items = $subscribers{$event};
        ($items->[$_]->[0] == $subscription) and ($idx = $_), last for $#$items;

        if (defined $idx) {
            my $deleted = splice @$items, $idx, 1, ();
            $deleted->[1]->();
        }
        delete $subscribers{$event} unless @$items;
    }
    else {
        for my $item (@{$subscribers{$event}}) {
            $item->[1]->();
        }
        delete $subscribers{$event};
    }

    return;
}

1;

__END__