X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=scpubgit%2FObject-Remote.git;a=blobdiff_plain;f=lib%2FObject%2FRemote%2FConnection.pm;h=21bcec455061ad756157128644a3f72fc3b4d36b;hp=8f4d44304db1cffc5b473c9f8e69b188c821634c;hb=12fb4a80d68ad14c18a35f60cc6d8a671f728ac9;hpb=c5736e1ce44d413c01e9497aa49d4174f9bb37bf diff --git a/lib/Object/Remote/Connection.pm b/lib/Object/Remote/Connection.pm index 8f4d443..21bcec4 100644 --- a/lib/Object/Remote/Connection.pm +++ b/lib/Object/Remote/Connection.pm @@ -4,7 +4,10 @@ use Object::Remote::Future; use Object::Remote::Null; use Object::Remote::Handle; use Object::Remote::CodeContainer; +use Object::Remote::GlobProxy; +use Object::Remote::GlobContainer; use Object::Remote; +use Symbol; use IO::Handle; use Module::Runtime qw(use_module); use Scalar::Util qw(weaken blessed refaddr); @@ -18,29 +21,29 @@ has send_to_fh => ( trigger => sub { $_[1]->autoflush(1) }, ); -has receive_from_fh => ( +has read_channel => ( is => 'ro', required => 1, trigger => sub { - my ($self, $fh) = @_; + my ($self, $ch) = @_; weaken($self); - Object::Remote->current_loop - ->watch_io( - handle => $fh, - on_read_ready => sub { $self->_receive_data_from($fh) } - ); + $ch->on_line_call(sub { $self->_receive(@_) }); + $ch->on_close_call(sub { $self->on_close->done(@_) }); }, ); -has on_close => (is => 'rw', default => sub { CPS::Future->new }); +has on_close => ( + is => 'ro', default => sub { CPS::Future->new }, + trigger => sub { + my ($self, $f) = @_; + weaken($self); + $f->on_done(sub { + $self->_fail_outstanding("Connection lost: ".($f->get)[0]); + }); + } +); has child_pid => (is => 'ro'); -has ready_future => (is => 'lazy'); - -sub _build_ready_future { CPS::Future->new } - -has _receive_data_buffer => (is => 'ro', default => sub { my $x = ''; \$x }); - has local_objects_by_id => ( is => 'ro', default => sub { {} }, coerce => sub { +{ %{$_[0]} } }, # shallow clone on the way in @@ -53,6 +56,14 @@ has remote_objects_by_id => ( has outstanding_futures => (is => 'ro', default => sub { {} }); +sub _fail_outstanding { + my ($self, $error) = @_; + my $outstanding = $self->outstanding_futures; + $_->fail($error) for values %$outstanding; + %$outstanding = (); + return; +} + has _json => ( is => 'lazy', handles => { @@ -81,6 +92,18 @@ sub _build__json { my $code_container = $self->_id_to_remote_object(@_); sub { $code_container->call(@_) }; } + )->filter_json_single_key_object( + __scalar_ref__ => sub { + my $value = shift; + return \$value; + } + )->filter_json_single_key_object( + __glob_ref__ => sub { + my $glob_container = $self->_id_to_remote_object(@_); + my $handle = Symbol::gensym; + tie *$handle, 'Object::Remote::GlobProxy', $glob_container; + return $handle; + } ); } @@ -150,11 +173,6 @@ sub register_remote { return $remote; } -sub await_ready { - my ($self) = @_; - await_future($self->ready_future); -} - sub send_free { my ($self, $id) = @_; delete $self->remote_objects_by_id->{$id}; @@ -165,12 +183,16 @@ sub send { my ($self, $type, @call) = @_; my $future = CPS::Future->new; + my $remote = $self->remote_objects_by_id->{$call[0]}; unshift @call, $type => $self->_local_object_to_id($future); my $outstanding = $self->outstanding_futures; $outstanding->{$future} = $future; - $future->on_ready(sub { delete $outstanding->{$future} }); + $future->on_ready(sub { + undef($remote); + delete $outstanding->{$future} + }); $self->_send(\@call); @@ -188,8 +210,6 @@ sub send_discard { sub _send { my ($self, $to_send) = @_; - $self->await_ready; - print { $self->send_to_fh } $self->_serialize($to_send)."\n"; } @@ -232,6 +252,12 @@ sub _deobjectify { Object::Remote::CodeContainer->new(code => $data) ); return +{ __remote_code__ => $id }; + } elsif ($ref eq 'SCALAR') { + return +{ __scalar_ref__ => $$data }; + } elsif ($ref eq 'GLOB') { + return +{ __glob_ref__ => $self->_local_object_to_id( + Object::Remote::GlobContainer->new(handle => $data) + ) }; } else { die "Can't collapse reftype $ref"; } @@ -239,36 +265,6 @@ sub _deobjectify { return $data; # plain scalar } -sub _receive_data_from { - my ($self, $fh) = @_; - my $rb = $self->_receive_data_buffer; - my $ready = $self->ready_future->is_ready; - my $len = sysread($fh, $$rb, 1024, length($$rb)); - my $err = defined($len) ? '' : ": $!"; - if (defined($len) and $len > 0) { - while ($$rb =~ s/^(.*)\n//) { - if ($ready) { - $self->_receive($1); - } else { - my $line = $1; - die "New remote container did not send Shere - got ${line}" - unless $line eq "Shere"; - $self->ready_future->done; - } - } - } else { - Object::Remote->current_loop - ->unwatch_io( - handle => $self->receive_from_fh, - on_read_ready => 1 - ); - my $outstanding = $self->outstanding_futures; - $_->fail("Connection lost${err}") for values %$outstanding; - %$outstanding = (); - $self->on_close->done(); - } -} - sub _receive { my ($self, $flat) = @_; warn "$$ <<< $flat\n" if $DEBUG; @@ -322,14 +318,14 @@ sub _invoke { return; } -sub DEMOLISH { - my ($self, $gd) = @_; - return if $gd; - Object::Remote->current_loop - ->unwatch_io( - handle => $self->receive_from_fh, - on_read_ready => 1 - ); -} - 1; + +=head1 NAME + +Object::Remote::Connection - An underlying connection for L + +=head1 LAME + +Shipping prioritised over writing this part up. Blame mst. + +=cut