From: Matt S Trout Date: Mon, 18 Jun 2012 01:14:59 +0000 (+0100) Subject: sanity for class call handler X-Git-Tag: v0.001001~14 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=scpubgit%2FObject-Remote.git;a=commitdiff_plain;h=3687a42d0f4ac20dfd2cb31cb76cf9866ee63f14 sanity for class call handler --- diff --git a/lib/Object/Remote/Connection.pm b/lib/Object/Remote/Connection.pm index bb47fd0..94bea15 100644 --- a/lib/Object/Remote/Connection.pm +++ b/lib/Object/Remote/Connection.pm @@ -128,13 +128,16 @@ sub send_class_call { sub register_class_call_handler { my ($self) = @_; - $self->local_objects_by_id->{'class_call_handler'} - = Object::Remote::CodeContainer->new( - code => sub { - my ($class, $method) = (shift, shift); - use_module($class)->$method(@_); - } - ); + $self->local_objects_by_id->{'class_call_handler'} ||= do { + my $o = Object::Remote::CodeContainer->new( + code => sub { + my ($class, $method) = (shift, shift); + use_module($class)->$method(@_); + } + ); + $self->_local_object_to_id($o); + $o; + }; } sub register_remote { @@ -188,7 +191,7 @@ sub _send { sub _serialize { my ($self, $data) = @_; - local our @New_Ids; + local our @New_Ids = (-1); return eval { my $flat = $self->_encode($self->_deobjectify($data)); warn "$$ >>> ${flat}\n" if $DEBUG; @@ -205,7 +208,7 @@ sub _local_object_to_id { my ($self, $object) = @_; my $id = refaddr($object); $self->local_objects_by_id->{$id} ||= do { - push our(@New_Ids), $id; + push our(@New_Ids), $id if @New_Ids; $object; }; return $id; diff --git a/lib/Object/Remote/ConnectionServer.pm b/lib/Object/Remote/ConnectionServer.pm index 26536ec..85869d0 100644 --- a/lib/Object/Remote/ConnectionServer.pm +++ b/lib/Object/Remote/ConnectionServer.pm @@ -32,6 +32,10 @@ has connection_args => ( is => 'ro', default => sub { [] } ); +has connection_callback => ( + is => 'ro', default => sub { sub { shift } } +); + sub BUILD { Object::Remote->current_loop->want_run; } @@ -50,7 +54,7 @@ sub _listen_ready { send_to_fh => $new, on_close => $f, # and so will die $c @{$self->connection_args} - ); + )->${\$self->connection_callback}; $f->on_ready(sub { undef($c) }); $c->ready_future->done; print $new "Shere\n" or die "Couldn't send to new socket: $!";