use Object::Remote::GlobProxy;
use Object::Remote::GlobContainer;
use Object::Remote::Logging qw (:log :dlog);
+use Object::Remote::Tied;
use Object::Remote;
use Symbol;
use IO::Handle;
tie *$handle, 'Object::Remote::GlobProxy', $glob_container;
return $handle;
}
- );
+ )->filter_json_single_key_object(
+ __remote_tied_hash__ => sub {
+ my %tied_hash;
+ tie %tied_hash, 'Object::Remote::Tied', $self->_id_to_remote_object(@_);
+ return \%tied_hash;
+ }
+ )->filter_json_single_key_object(
+ __remote_tied_array__ => sub {
+ my @tied_array;
+ tie @tied_array, 'Object::Remote::Tied', $self->_id_to_remote_object(@_);
+ return \@tied_array;
+ }
+ );
}
BEGIN {
Dlog_debug { "creating a new connection from spec" };
foreach my $poss (do { our @Guess }) {
if (my $conn = $poss->($spec)) {
- #Dlog_debug { my $id = $conn->_id; "created connection $id for spec $_" } $spec;
return $conn->maybe::start::connect;
}
}
sub send_free {
my ($self, $id) = @_;
- Dlog_debug { "sending request to free object '$id' for connection $_" } $self->_id;
+ Dlog_trace { "sending request to free object '$id' for connection $_" } $self->_id;
delete $self->remote_objects_by_id->{$id};
$self->_send([ free => $id ]);
}
my $serialized = $self->_serialize($to_send)."\n";
Dlog_trace { my $l = length($serialized); "serialization is completed; sending '$l' characters of serialized data to $_" } $fh;
#TODO this is very risky for deadlocks unless it's set to non-blocking and then with out extra
- #logic it could easily do short-writes to the remote side
+ #logic it could easily do short-writes to the remote side - how about taking this entire buffer
+ #and having the run loop send it to the file handle so this doesn't block while the sending
+ #is happening?
my $ret = print $fh $serialized;
Dlog_trace { my $r = defined $ret ? $ret : 'undef'; "print() returned $r with $_" } $fh;
#TODO hrm reason print's return value was ignored?
return +{ __remote_object__ => $self->_local_object_to_id($data) };
} elsif (my $ref = ref($data)) {
if ($ref eq 'HASH') {
- return +{ map +($_ => $self->_deobjectify($data->{$_})), keys %$data };
+ my $tied_to = tied(%$data);
+ if(defined($tied_to)) {
+ return +{__remote_tied_hash__ => $self->_local_object_to_id($tied_to)};
+ } else {
+ return +{ map +($_ => $self->_deobjectify($data->{$_})), keys %$data };
+ }
} elsif ($ref eq 'ARRAY') {
- return [ map $self->_deobjectify($_), @$data ];
+ my $tied_to = tied(@$data);
+ if (defined($tied_to)) {
+ return +{__remote_tied_array__ => $self->_local_object_to_id($tied_to)};
+ } else {
+ return [ map $self->_deobjectify($_), @$data ];
+ }
} elsif ($ref eq 'CODE') {
my $id = $self->_local_object_to_id(
Object::Remote::CodeContainer->new(code => $data)
sub BUILD {
my ($self, $args) = @_;
- log_debug { "constructing remote handle" };
+ log_trace { "constructing remote handle" };
if ($self->id) {
log_trace { "disarming free for this handle" };
$self->disarm_free;
sub call {
my ($self, $method, @args) = @_;
my $w = wantarray;
- log_debug { my $def = defined $w ? 1 : 0; "call() has been invoked on a remote handle; wantarray: '$def'" };
+ log_trace { my $def = defined $w ? 1 : 0; "call() has been invoked on a remote handle; wantarray: '$def'" };
$method = "start::${method}" if (caller(0)||'') eq 'start';
future {
$self->connection->send(call => $self->id, $w, $method, @args)
#TODO if this works out non-blocking support
#will need to be integrated in a way that
#is compatible with Windows which has no
- #non-blocking support
+ #non-blocking support - see also ::ReadChannel
if (0) {
Dlog_warn { "setting file handle to be non-blocking: $_" } $fh;
use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK);
$read_count++;
$read->{$fh}();
last if $Loop_Entered;
-# $read->{$fh}() if $read->{$fh};
}
log_trace { "Writing to all ready filehandles" };
foreach my $fh (@$writeable) {
$write_count++;
$write->{$fh}();
last if $Loop_Entered;
-# $write->{$fh}() if $write->{$fh};
}
+
log_trace { "Read from $read_count filehandles; wrote to $write_count filehandles" };
my $timers = $self->_timers;
my $now = time();
#it's own localized is_running attribute - any adjustment to the
#is_running attribute outside of that future will not effect that
#future so each future winds up able to call run() and stop() at
-#will with out interfering with each other
+#will with out interfering with each other - how about having
+#run loop until the future becomes ready?
sub run {
my ($self) = @_;
log_trace { "Run loop: run() invoked" };
has _receive_data_buffer => (is => 'ro', default => sub { my $x = ''; \$x });
-#TODO confirmed this is the point of the hang - sysread() is invoked on a
-#socket inside the controller that blocks and deadlocks the entire system.
-#The remote nodes are all waiting to receive data at that point.
-#Validated this behavior exists in an unmodified Object::Remote from CPAN
-#by wrapping this sysread() with warns that have the pid in them and pounding
-#my local machine with System::Introspector via ssh and 7 remote perl instances
-#It looks like one of the futures is responding to an event regarding the ability
-#to read from a socket and every once in a while an ordering issue means that
-#there is no actual data to read from the socket
sub _receive_data_from {
my ($self, $fh) = @_;
Dlog_trace { "Preparing to read data from $_" } $fh;
- #use Carp qw(cluck); cluck();
my $rb = $self->_receive_data_buffer;
- #TODO is there a specific reason sysread() and syswrite() aren't
- #a part of ::MiniLoop? It's one spot to handle errors and other
- #logic involving filehandles
my $len = sysread($fh, $$rb, 32768, length($$rb));
my $err = defined($len) ? '' : ": $!";
if (defined($len) and $len > 0) {
with 'Object::Remote::Role::Connector';
+#TODO ugh breaks some of the stuff in System::Introspector::Util by
+#screwing with status value of child
BEGIN {
$SIG{CHLD} = sub {
my $kid;
#if no child_stderr file handle is specified then stderr
#of the child will be connected to stderr of the parent
has stderr => ( is => 'rw', default => sub { \*STDERR } );
+#has stderr => ( is => 'rw' );
sub _build_module_sender {
my ($hook) =
Dlog_trace { "got $len characters of stderr data for connection" };
print $given_stderr $buf or die "could not send stderr data: $!";
}
- }
+ }
);
}
# my $foreign_stdin,
# @{$self->final_perl_command},
# ) or die "Failed to run perl at '$_[0]': $!";
+#
+# Dlog_trace { "Connection to remote side successful; remote stdin and stdout: $_" } [ $foreign_stdin, $foreign_stdout ];
- Dlog_trace { "Connection to remote side successful; remote stdin and stdout: $_" } [ $foreign_stdin, $foreign_stdout ];
- return ($foreign_stdin, $foreign_stdout, $pid);
+
+ return ($foreign_stdin, $foreign_stdout, $pid);
}
#TODO open2() forks off a child and I have not been able to locate
--- /dev/null
+package Object::Remote::Tied;
+
+use strictures 1;
+
+#a proxied tied object just ties to the
+#proxy object that exists on the remote
+#side of the actual tied variable - when
+#creating the remote tied variable the proxy
+#is passed to the constructor
+
+sub TIEHASH {
+ return $_[1];
+}
+
+sub TIEARRAY {
+ return $_[1];
+}
+
+
+1;
+
projects / scpubgit/Object-Remote.git / commitdiff