--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/IMPL/Object/EventSource.pm	Fri Sep 04 19:40:23 2015 +0300
@@ -0,0 +1,191 @@
+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 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