File Coverage

blib/lib/mop/internals/observable.pm

Criterion	Covered	Total	%
statement	52	52	100.0
branch	11	14	78.5
condition	2	3	66.6
subroutine	9	9	100.0
pod	0	4	0.0
total	74	82	90.2

package mop::internals::observable;

use v5.16;
use warnings;

use Scalar::Util qw[ refaddr ];

use mop::internals::util;

our $VERSION   = '0.03';
our $AUTHORITY = 'cpan:STEVAN';

mop::internals::util::init_attribute_storage(my %callbacks);

sub bind {
    my ($self, $event_name, $callback) = @_;
    $callbacks{ $self } = \{}
        unless $callbacks{ $self };
    ${$callbacks{ $self }}->{ $event_name } = []
        unless exists ${$callbacks{ $self }}->{ $event_name };
    push @{ ${$callbacks{ $self }}->{ $event_name } } => $callback;
    $self;
}

sub unbind {
    my ($self, $event_name, $callback) = @_;
    return $self unless $callbacks{ $self };
    return $self unless ${$callbacks{ $self }}->{ $event_name };
    @{ ${$callbacks{ $self }}->{ $event_name } } = grep {
        refaddr($_) != refaddr($callback)
    } @{ ${$callbacks{ $self }}->{ $event_name } };
    $self;
}

sub fire {
    my ($self, $event_name, @args) = @_;
    return $self unless $callbacks{ $self };
    return $self unless ${$callbacks{ $self }}->{ $event_name };
    $self->$_( @args ) foreach @{ ${$callbacks{ $self }}->{ $event_name } };
    return $self;
}

sub has_events {
    my $self = shift;
    return $callbacks{ $self } && ${ $callbacks{ $self } } && !!%{ ${ $callbacks{ $self } } };
}

sub __INIT_METACLASS__ {
    state $METACLASS;
    return $METACLASS if defined $METACLASS;
    require mop::role;
    $METACLASS = mop::role->new(
        name       => 'mop::observable',
        version    => $VERSION,
        authority  => $AUTHORITY
    );

    $METACLASS->add_attribute(mop::attribute->new(
        name    => '$!callbacks',
        storage => \%callbacks
    ));

    $METACLASS->add_method( mop::method->new( name => 'bind',   body => \&bind   ) );
    $METACLASS->add_method( mop::method->new( name => 'unbind', body => \&unbind ) );
    $METACLASS->add_method( mop::method->new( name => 'fire',   body => \&fire   ) );

    $METACLASS->add_method( mop::method->new( name => 'has_events', body => \&has_events ) );

    $METACLASS;
}

1;

__END__