view Lib/IMPL/Object/EventSource.pm @ 250:129e48bb5afb

DOM refactoring ObjectToDOM methods are virtual QueryToDOM uses inflators Fixed transform for the complex values in the ObjectToDOM QueryToDOM doesn't allow to use complex values (HASHes) as values for nodes (overpost problem)
author sergey
date Wed, 07 Nov 2012 04:17:53 +0400
parents d1676be8afcc
children 4ddb27ff4a0b
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 {
        shift;
        if (not @_) {
            if (not defined wantarray and caller(1) eq $class) {
                $globalEventTable->Invoke($class);
            } else {
                return $globalEventTable;
            }
        } else {
            $globalEventTable->Invoke($class,@_);
        }
    };
}

package IMPL::Object::EventSource::EventTable;
use parent 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->{$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;

__END__
=pod
=head1 SYNOPSIS
package Foo;
use parent qw(IMPL::Object IMPL::Object::EventSource);

# declare events
__PACKAGE__->CreateEvent('OnUpdate');
__PACKAGE__->CreateStaticEvent('OnNewObject');

sub CTOR {
    my $this = shift;
    // rise static event
    $this->OnNewObject();
}

sub Update {
    my ($this,$val) = @_;
    
    // rise object event
    $this->OnUpdate($val);
}

package Bar;

// subscribe static event
Foo->OnNewObject->Subscribe(sub { warn "New $_[0] created" } );

sub LookForFoo {
    my ($this,$foo) = @_;
    
    // subscribe object event
    $foo->OnUpdate->Subscribe($this,'OnFooUpdate');
}

// event handler
sub OnFooUpdate {
    my ($this,$sender,$value) = @_;
}

=head1 DESCRIPTION
Позволяет объявлять и инициировать события. События делятся на статические и
локальные. Статические события объявляются для класса и при возникновении
данного события вызываются всегда все подписчики. Статические события могут быть
вызваны как для класса, так и для объекта, что приведет к одинаковым результатам.

Локальные события состоят из статической (как статические события) и локальной
части. Если подписываться на события класса, то обработчики будут вызываться при
любых вариантах инициации данного события (как у статических событий). При
подписке на события объекта, обработчик будет вызван только при возникновении
событий у данного объекта.

=head1 METHODS
=level 4
=back

=head1 EventTable

=cut