view Lib/IMPL/Object/EventSource.pm @ 2:78cd38551534

in develop
author Sergey
date Mon, 10 Aug 2009 17:39:08 +0400
parents 03e58a454b20
children 94d47b388442
line wrap: on
line source

package IMPL::Object::EventSource;
use strict;
require IMPL::Exception;
use IMPL::Class::Property;

sub CreateEvent {
    my ($class,$event) = @_;
    
    die new IMPL::Exception('A name is required for the event') unless $event;
    
    (my $fullEventName = "$class$event") =~ s/:://g;
    
    my $globalEventTable = new IMPL::Object::EventSource::EventTable($fullEventName);
    my $propEventTable = $event.'Table';
    public CreateProperty($class,$propEventTable,prop_all);
    public CreateProperty($class,$event,
        {
            get => sub {
                my $this = shift;
                if (not defined wantarray and caller(1) eq $class) {
                    (ref $this ? $this->$propEventTable() || $globalEventTable : $globalEventTable)->Invoke($this);
                } else {
                    if (ref $this) {
                        if (my $table = $this->$propEventTable()) {
                            return $table;
                        } else {
                            $table = new IMPL::Object::EventSource::EventTable($fullEventName,$globalEventTable);
                            $this->$propEventTable($table);
                            return $table;
                        }
                    } else {
                        return $globalEventTable;
                    }
                }
            },
            set => sub {
                (ref $_[0] ? $_[0]->$propEventTable() || $globalEventTable : $globalEventTable)->Invoke(@_);
            }
        }
    );
}

sub CreateStaticEvent {
    my ($class,$event) = @_;
    
    die new IMPL::Exception('A name is required for the event') unless $event;
    
    (my $fullEventName = "$class$event") =~ s/:://g;
    
    my $globalEventTable = new IMPL::Object::EventSource::EventTable($fullEventName);
    
    no strict 'refs';
    *{"${class}::$event"} = sub {
        my $class = shift;
        if (not @_) {
            if (not defined wantarray and caller(1) eq $class) {
                $globalEventTable->Invoke($class);
            } else {
                return $globalEventTable;
            }
        } else {
            $globalEventTable->Invoke(@_);
        }
    };
}

package IMPL::Object::EventSource::EventTable;
use base qw(IMPL::Object);
use IMPL::Class::Property;
use IMPL::Class::Property::Direct;
use Scalar::Util qw(weaken);

use overload
    '+=' => \&opSubscribe,
    'fallback' => 1;

BEGIN {
    public _direct property Name => prop_get;
    public _direct property Handlers => { get => \&get_handlers };
    private _direct property Next => prop_all;
    private _direct property NextId => prop_all;
}

sub CTOR {
    my $this = shift;
    $this->SUPER::CTOR();
    
    $this->{$Handlers} = {};
    $this->{$Name} = shift;
    $this->{$Next} = shift;
    $this->{$NextId} = 1;
}

sub get_handlers {
    my $this = shift;
    return values %{$this->{$Handlers}};
}

sub Invoke {
    my $this = shift;

    my $tmp; 
    $tmp = $_ and local($_) or &$tmp(@_) foreach values %{$this->{$Handlers}};
    
    $this->{$Next}->Invoke(@_) if $this->{$Next};
}

sub Subscribe {
    my ($this,$consumer,$nameHandler) = @_;
    
    my $id = $this->{$NextId} ++;

    if (ref $consumer eq 'CODE') {
        $this->{$Handlers}{$id} = $consumer;
    } else {
        $nameHandler ||= $this->Name or die new IMPL::Exception('The name for the event handler method must be specified');
        my $method = $consumer->can($nameHandler) or die new IMPL::Exception('Can\'t find the event handler method',$nameHandler,$consumer);
        
        weaken($consumer) if ref $consumer;
        $this->{$Handlers}{$id} = sub {
            unshift @_, $consumer;
            $consumer ? goto &$method : delete $this->{$Handlers}{$id};
        };
    }
    
    return $id;
}

sub Remove {
    my ($this,$id) = @_;
    return delete $this->{$Handlers}{$id};
}
1;