Mercurial > pub > Impl
view Lib/IMPL/Object/EventSource.pm @ 16:75d55f4ee263
Окончательная концепция описания схем и построения DOM документов
author | Sergey |
---|---|
date | Tue, 08 Sep 2009 17:29:07 +0400 |
parents | 94d47b388442 |
children | 16ada169ca75 |
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 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; __END__ =pod =head1 SYNOPSIS package Foo; use base 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