#!/usr/bin/perl -w

# Crude draft of what a POE object layer could look like.  Each object has
# an associated Session that receives messages for the object.  If the object
# needs to post messages, it uses post($to_object, @args) or 
# post_respond($to_object, @args, $postback);
# $to_object and $postback CURRENTLY have the form state@object.  This means
# that 'state@poe://kernel/session' would work if you subscribe to that remote
# session.  $postback MUST point to the current object.

# state@poe://kernel/object is bletcherous.  It would have to be fixed to
# accept poe://kernel/object/state.... or object/state.  Or IKC specifier
# syntax could be changed...  state@kernel!object ?  or kernel!object!state
# and object!state

use strict;
use Carp qw(croak);

sub POE::Kernel::ASSERT_REFCOUNT () {1}
use POE;

$|++;
sub DEBUG () {0};

my $some_object=SomePackage->new();

POE::Component::Object->create(
        name=>'SomeObject',
        object=>{package=>'SomePackage', ctor=>'new'},
        method1=>{},
        method2=>{},
        method3=>{prototype=>"N", args_n=>1},    # Number
        postback=>{args_n=>1},
        options=>{trace=>0},
    );

my $other=OtherPackage->new();
POE::Component::Object->create(
        name=>'OtherObject',
        object=>$other,
        method1=>{args_n=>0},
    );

$poe_kernel->post(OtherObject=>'method1');
$poe_kernel->run();
exit 0;


################################################################
package OtherPackage;
use strict;
use vars qw(@ISA);
BEGIN { @ISA=qw(POE::Component::Object);}

sub new
{
    bless {}, $_[0];
}

sub method1
{
    my($self)=@_;
    print "This is $self->method1\n";
    die "To many times!\n" if $self->{m1}++;
    $self->post('method1@SomeObject');
}



################################################################
package SomePackage;
use strict;
use vars qw(@ISA);
BEGIN { @ISA=qw(POE::Component::Object);}

sub new
{
    bless {}, $_[0];
}

sub method1
{
    my($self)=@_;
    print "This is $self->method1\n";
    die "To many times!\n" if $self->{m1}++;
    $self->post("method2");
}

sub method2
{
    my($self)=@_;
    print "This is $self->method2\n";
    die "To many times!\n" if $self->{m2}++;
    scalar $self->post_respond("method3", 42, "postback");
}

sub method3
{
    my($self, $n)=@_;
    print "This is $self->method3, called with $n\n";
    die "To many times!\n" if $self->{m3}++;
    return -$n;
}

sub postback
{
    my($self, $n)=@_;
    print "Postback of $n\n";
}

##############################################################################
package POE::Component::Object;

use strict;
use POE::Kernel;
use POE::Session;
use Data::Dumper;

use vars qw(@POE);
sub DEBUG () {0}

sub create
{
    my $package=shift @_;
    my %args=@_;
    
    my %create;
    foreach my $k (qw(options)) {
        next unless exists $args{$k};
        $create{$k}=delete $args{$k};
    }

    my $object_conf=delete $args{object};
    my $object;
    if(UNIVERSAL::isa($object_conf, "UNIVERSAL")) {
        $object=$object_conf;
    } else {
        # TODO needs better error checking
        $object=$object_conf->{package}->can($object_conf->{ctor})->($object_conf->{package});
    }

    die "No object" unless $object;
    my $name=delete $args{name};

    my %methods;
    my @states=qw(_default);
    foreach my $method (keys %args) {
        die "Please don't call your method $method" if $method=~ /^_/;
        $methods{$method}=$args{$method};
#        push @states, $method;
    }
    
    POE::Session->create(
            args=>[\%methods, $name],
            package_states=>[
                $package=>[qw(_start _stop)],
            ],
            object_states=>[
                $object=>\@states
            ],
            %create,
        );
}

################################################################
sub _start
{
    my($kernel, $heap, $methods, $name)=@_[KERNEL, HEAP, ARG0, ARG1];

    $heap->{methods}=$methods;
    die "No name" unless $name;
    $kernel->alias_set($name);
}

################################################################
sub _default
{
    local @POE=splice @_, 0, ARG0; # gratuitous use of splice() detected at line 133 of file objects.perl
    my($method, $args)=@_;

    my($object, $heap)=@POE[OBJECT, HEAP];

    DEBUG and warn "_default $method";
    return if $method =~ /^_/;

    die "No object" unless $object;
    unless($heap->{methods}{$method}){
        warn $object;
        warn "Object $object doesn't have $method";
        return;
    }
    my $info=$heap->{methods}{$method};

    unless($object->can($method)) {
        warn "Can't call method $method on ", ref $object;
        return;
    }

    if(defined($info->{args_n}) and $info->{args_n}!=1+$#$args) {
        warn ref($object), "->$method must be called with $info->{args_n} arguments";
        return;
    }

    my $ret=eval{$object->can($method)->($object, @$args)};
    warn $@ if $@;
    return $ret;
}

################################################################
sub _stop
{
    my($kernel, $heap)=@_;
    # here is where we rollback subscriptions and what-not
}

sub _parse ($)
{
    my($name)=@_;
    my($state, $session)=split '@', $name, 2;
    $session||=$POE[SESSION];
    die "No session!" unless $session;
    return $session, $state;
}

################################################################
sub post
{
    my($self, $name, @args)=@_;
    my($session, $state)=_parse $name;

    $POE[KERNEL]->post($session, $state, @args);
}

################################################################
sub post_respond
{
    my($self, $name, @args)=@_;
    my $postback=pop @args;

    my($session, $state)=_parse $name;

    my($psession, $pstate)=_parse $postback;
    die "post_respond must post back to calling object" 
            unless $psession == $POE[SESSION];

    if(wantarray) {
        $POE[KERNEL]->post($psession, $pstate, 
                    $POE[KERNEL]->call($session, $state, @args));
    } else {
        $POE[KERNEL]->post($psession, $pstate, scalar
                    $POE[KERNEL]->call($session, $state, @args));
    }
}

1;