Mercurial > pub > Impl
view Lib/IMPL/Object/EventSource.pm @ 0:03e58a454b20
Создан репозитарий
author | Sergey |
---|---|
date | Tue, 14 Jul 2009 12:54:37 +0400 |
parents | |
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;