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->{$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