File Coverage

blib/lib/Aspect/Library/Listenable.pm

Criterion	Covered	Total	%
statement	99	103	96.1
branch	21	32	65.6
condition	11	18	61.1
subroutine	22	22	100.0
pod	0	12	0.0
total	153	187	81.8

package Aspect::Library::Listenable;

# TODO: update docs to explain always_fire, setting handler params
# specifically instead of getting default (event), and event cloning

use strict;
use warnings;
use Carp                               ();
use Scalar::Util                       ();
use Sub::Install                       ();
use Aspect::Modular                    ();
use Aspect::Advice::Before             ();
use Aspect::Library::Listenable::Event ();

our $VERSION = '0.97_06';
our @ISA     = 'Aspect::Modular';

sub import {
	my $into = caller();

	Sub::Install::install_sub( {
		code => $_,
		into => $into,
	} ) foreach qw{
		add_listener
		remove_listener
	};

	return 1;
}

sub get_advice {
	my ($self, $event_name, $pointcut, %event_params) = @_;
	Aspect::Advice::Before->new(
		lexical  => $self->lexical,
		pointcut => $pointcut,
		code     => sub {
			my $context    = $_;
			my $listenable = $context->self;
			my %params     = %event_params;

			local $_;
			return unless has_listeners($listenable, $event_name);

			my $always_fire = delete $params{__always_fire};
			my %old_state = get_listenable_state($listenable, \%params);
			$context->original->( $context->args );
			my %new_state = get_listenable_state($listenable, \%params);

			return if
				!$always_fire &&
				keys %old_state &&
				is_equal_state(\%old_state, \%new_state);

			my @params = $context->args;
			shift @params; # remove $self
			my $event = Aspect::Library::Listenable::Event->new(
				name   => $event_name,
				source => $listenable,
				params => \@params,
				%new_state,
				map {("old_$_" => $old_state{$_})} keys %old_state,
			);

			fire_event($event);
		},
	);
}

sub add_listener ($$$) {
	my ($listenable, $event_name, $listener) = @_;
	Carp::croak "listenable is not a hash based object: [$listenable]"
		unless is_hash($listenable);
	my $key = get_listener_key($event_name);
	$listenable->{$key} = [] unless exists $listenable->{$key};
	my $listeners = get_listeners($listenable, $event_name);
	my $lastIndex = (push @$listeners, $listener) - 1;
	if ( ref $listener eq 'ARRAY' ) { # type 3 listener
		Scalar::Util::weaken( $listeners->[$lastIndex]->[1] );
	} elsif ( ref $listener ne 'CODE' ) { # type 2 listener
		Scalar::Util::weaken( $listeners->[$lastIndex] );
	}
}

sub remove_listener ($$$) {
	my ($listenable, $event_name, $listener) = @_;
	my $listeners = get_listeners($listenable, $event_name);
	Carp::croak "listenable has no listeners for event: [$event_name]"
		unless $listeners;
	my $oldSize = @$listeners;
	foreach my $i (0..@$listeners - 1) {
		my $l = $listeners->[$i];
		if ((ref $l eq 'ARRAY' && $listener eq $l->[1]) || $listener eq $l) {
			splice @$listeners, $i, 1;
			last;
		}
	}
	Carp::croak "listener not found: [$event_name, $listener]"
		if $oldSize == @$listeners;
}

# private helpers -------------------------------------------------------------

sub fire_event {
	my $event = shift;
	my ($source, $event_name) = ($event->source, $event->name);
	return unless has_listeners($source, $event_name);
	notify_listener($_, $event) for @{get_listeners($source, $event_name)};
}

sub notify_listener {
	my ($listener, $event) = @_;
	local $_;
	my $clone = $event->clone;
	my $method_name;
	if (ref $listener eq 'CODE') {
		&$listener($clone);
	} elsif (ref $listener eq 'ARRAY') {
		my $o = $listener->[1];
		return unless defined $o; # could be a dead weak ref
		$method_name = $listener->[0];
		my @params = $listener->[2]?
			map { $event->$_ } @{$listener->[2]}:
			($clone);
		$o->$method_name(@params);
	} else {
		return unless defined $listener; # could be a dead weak ref
		$method_name = 'handle_event_'. $event->name;
		$listener->$method_name($clone);
	}
}

sub has_listeners {
	my ($listenable, $event_name) = @_;
	my $listeners = get_listeners($listenable, $event_name);
	return $listeners && @$listeners;
}

sub get_listeners {
	my ($listenable, $event_name) = @_;
	return $listenable->{get_listener_key($event_name)};
}

sub get_listener_key { '_'. __PACKAGE__. '_'. pop }

sub get_listenable_state {
	my ($listenable, $event_params)  = @_;
	local $_;
	return map {
		my $state_getter = $event_params->{$_};
		$_ => $listenable->$state_getter;
	} keys %$event_params
}

sub is_equal_state {
	my ($old_state, $new_state) = @_;
	for my $key (keys %$new_state) {
		return 0 unless
			is_equal_value($old_state->{$key}, $new_state->{$key});
	}
	return 1;
}

# TODO: need smarter ways to figure out equality
sub is_equal_value {
	my ($old, $new) = @_;
	return
		(!defined $new && !defined $old) ||
		(
			defined $new && defined $old &&
			!ref($old) && !ref($new) &&
			$old eq $new
		);
}

sub is_hash {
	shift =~ /=?([A-Z]+)\(/;
	return $1 eq 'HASH';
}

1;

__END__