--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/Object/EventSource.pm	Tue Jul 14 12:54:37 2009 +0400
@@ -0,0 +1,133 @@
+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;