sanity for class call handler

diff --git a/lib/Object/Remote/Connection.pm b/lib/Object/Remote/Connection.pm
index bb47fd0..94bea15 100644 (file)
--- 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 (file)
--- 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: $!";