File Coverage

blib/lib/Event/Notify.pm

Criterion	Covered	Total	%
statement	39	50	78.0
branch	10	18	55.5
condition	8	10	80.0
subroutine	9	10	90.0
pod	6	6	100.0
total	72	94	76.6

# $Id: /mirror/perl/Event-Notify/trunk/lib/Event/Notify.pm 31297 2007-11-29T11:30:40.898880Z daisuke  $
#
# Copyright (c) 2007 Daisuke Maki
# All rights reserved.

package Event::Notify;
use strict;
use warnings;
use vars qw($VERSION);
$VERSION = '0.00005';
use Carp ();

sub new
{
    my $class = shift;
    return bless { observers => {} }, $class;
}

sub register
{
    my ($self, $observer) = @_;
    $observer->register($self) if $observer->can('register');
}

sub register_event
{
    my($self, $event, $observer, $opts) = @_;

    $opts ||= {};

    if (! $event) {
        Carp::croak( "No event was specified" );
    }

    my $ref = ref($observer || '');
    if (! $ref) {
        Carp::croak( "Non-ref observer passed. Expected an object or a CODE ref");
    }

    my $slot;
    if ($ref eq 'CODE') {
        # You're not passing me a method name, are you? if so,
        # I won't croak, but I *will* complain
        if ($opts->{method}) {
            carp( "Useless use of method name for a CODE observer in Event::Notify->register_event()" );
        }
        $slot = [ $observer, undef ]
    } else {
        my $method = $opts->{method} || 'notify';

        if (! $observer->can($method)) {
            Carp::croak("$observer does not implement a $method() method");
        }
        $slot = [ $observer, $method ]
    }

    $self->{observers}{$event} ||= [];
    push @{ $self->{observers}{$event} }, $slot;
}

sub unregister_event
{
    my($self, $event, $observer) = @_;

    my $observers = $self->{observers}{$event};
    return () unless $observers;

    for my $i (0 .. $#{$observers}) {
        next unless $observers->[$i]->[0] == $observer;
        return splice(@$observers, $i, 1);
    }
    return ();
}

sub notify
{
    my ($self, $event, @args) = @_;

    my $observers = $self->{observers}{$event} || [];
    foreach my $data (@$observers) {
        my($o, $method) = @$data;
        ref $o eq 'CODE' ?
            $o->($event, @args) :
            $o->$method($event, @args)
        ;
    }
}

sub clear_observers
{
    my $self = shift;
    $self->{observers} = {};
}

1;

__END__