Skip to content

Commit

Permalink
Add callback handling+test
Browse files Browse the repository at this point in the history 
The callback handling is very synchronous, defying AnyEvent. But at
least it works.
  • Loading branch information
Max Maischein committed Nov 21, 2011
1 parent 0fd655b commit 9089ce6
Show file tree
Hide file tree
Showing 2 changed files with 204 additions and 7 deletions.
74 changes: 67 additions & 7 deletions lib/NodeJs/RemoteObject.pm
View file
@@ -1,6 +1,6 @@
package NodeJs::RemoteObject;
use strict;
use Scalar::Util qw(weaken blessed);
use Scalar::Util qw(weaken blessed refaddr);
use AnyEvent;
use AnyEvent::Handle;
use NodeJs;
Expand Down Expand Up @@ -52,17 +52,22 @@ sub new {
$args{ shutdown } = 1
unless exists $args{ shutdown };
};
$args{ fh } ||= AnyEvent::Handle->new(
connect => [ $args{ address }, $args{ port } ],
);
$args{ queue } ||= [];
$args{ stats } ||= {};
$args{ functions } = {}; # cache
$args{ constants } = {}; # cache
$args{ callbacks } = {}; # active callbacks
$args{ instance } ||= 'NodeJs::RemoteObject::Instance'; # at least until I factor things out

bless \%args => $class;
my $self = bless \%args => $class;
$args{ fh } ||= AnyEvent::Handle->new(
connect => [ $args{ address }, $args{ port } ],
#on_read => sub {
# warn "Reading from socket without explicit fetch";
# $_[0]->push_read( json => sub {$self->unwrap($_[1])} );
#},
);
$self
};

sub queue { $_[0]->{queue} };
Expand Down Expand Up @@ -151,7 +156,7 @@ sub transform_arguments {
} elsif (ref and blessed $_ and $_->isa('NodeJs::RemoteObject')) {
$_ = { t => 's', v => undef } # ourselves
} elsif (ref and ref eq 'CODE') { # callback
my $cb = $self->bridge->make_callback($_);
my $cb = $self->make_callback($_);
$_ = { t => 'o', v => NodeJs::RemoteObject::Methods::id($cb) }
} else {
$_ = { t => 'v', v => $_ }
Expand All @@ -173,9 +178,11 @@ sub repl_API {
# to handle async events coming in
sub unwrap {
my ($self,$data) = @_;
#warn "Unwrapping " . Dumper $data;
if (my $events = delete $data->{events}) {
my @ev = @$events;
for my $ev (@ev) {
#warn "Dispatching " . Dumper $ev;
$self->{stats}->{callback}++;
($ev->{args}) = $self->link_ids($ev->{args});
$self->dispatch_callback($ev);
Expand Down Expand Up @@ -214,10 +221,12 @@ sub api_call {
# objects to/from their ids?!
my $js= $self->repl_API($function,@args );

# XXX Centralize exception and callback dispatch
if (defined wantarray) {
# When going async, we would want to turn this into a callback
my $res = $self->send_a($js)->recv;
if ($res->{status} eq 'ok') {
#warn "Got OK, preparing to unwrap " . Dumper $res->{result};
return $self->unwrap($res->{result});
} else {
# reraise the JS exception locally
Expand All @@ -232,6 +241,7 @@ sub api_call {
# reraise the JS exception locally
croak ((ref $self).": $res->{name}: $res->{error}");
};
#warn Dumper $res->{result};
$res= $self->unwrap($res->{result});
()
};
Expand Down Expand Up @@ -385,7 +395,57 @@ sub link_ids {
} @_
}

sub poll {}; # well - we are event / select() based, no need to poll
# Creates a callback stub in nodejs that sends an event to Perl
# Unfortunately, callbacks cannot be made synchronous in nodejs
# until nodejs-fibers (coroutines for nodejs) becomes mainstream
sub make_callback {
my ($self,$cb) = @_;
my $cbid = refaddr $cb;
my $res = $self->api_call('makeCatchEvent',$cbid);
croak "Couldn't create a callback"
if (! $res);

# Need to weaken the backlink of the constant-object
my $ref = ref $res;
bless $res, "$ref\::HashAccess";
weaken $res->{bridge};
bless $res => $ref;

$self->{callbacks}->{$cbid} = {
callback => $cb, jsproxy => $res, where => [caller(1)],
};
$res
};

sub dispatch_callback {
my ($self,$info) = @_;
my $cbid = $info->{cbid};
if (! $cbid) {
croak "Unknown callback fired with values @{ $info->{ args }}";
};
if (exists $self->{callbacks}->{$cbid} and my $cb = $self->{callbacks}->{$cbid}->{callback}) {
# Replace with goto &$cb ?
my @args = as_list $info->{args};
$cb->(@args);
} else {
#warn "Unknown callback id $cbid (created in @{$self->{removed_callbacks}->{$cbid}->{where}})";
}
};

sub poll {
# well - we should be event / select() based...
# XXX Make this event based by making the JS immediately write the JSON event
# XXX Immediately writing on the JS side will break the event-handler/function identity
my $self= $_[0];
$self->expr("1==1");
#$self->fh->push_write( json => {command => "ejs", args => ["1==1", undef]} );
#$self->fh->push_write( "\012" );
#$self->fh->unshift_read(json => sub {
# warn "Async callback/poll callback " . Dumper $_[1];
$self->unwrap($_[1]->{result});
# undef $self
#});
};

package # hide from CPAN
NodeJs::RemoteObject::Instance;
Expand Down
137 changes: 137 additions & 0 deletions t/01-callback.t
View file
@@ -0,0 +1,137 @@
#!perl -w
use strict;
use Test::More;
use File::Spec::Functions;

use NodeJs::RemoteObject 'as_list';

diag "--- Loading object functionality into repl\n";

for( map {canonpath $_} sort glob "nodejs-versions/nodejs-*/node*" ) {
$NodeJs::NODE_JS = $_
if -x
};

my $repl;
my $ok = eval {
$repl = NodeJs::RemoteObject->new(
#log => [qw[debug]],
#use_queue => 1,
launch => 1,
);
1;
};
if (! $ok) {
my $err = $@;
plan skip_all => "Couldn't connect to NodeJs: $@";
} else {
plan tests => 15;
};

sub genObj {
my ($repl) = @_;
my $obj = $repl->expr(<<JS)
(function() {
var res = {};
res.foo = "bar";
res.baz = "flirble";
return res
})()
JS
}

my $obj = genObj($repl);
isa_ok $obj, 'NodeJs::RemoteObject::Instance';

my $called = 0;
my @events;
$obj->{oncommand} = sub {
$called++;
push @events, @_;
};
ok 1, "Stored callback";
my $cb = $obj->{oncommand};
isa_ok $obj->{oncommand},
'NodeJs::RemoteObject::Instance',
"We can store a subroutine as a callback";
my $setup_roundtrips = $repl->{stats}->{roundtrip};

$cb->('from_perl');
is $called, 1, "We got called back on a direct call from Perl";

my $trigger_command = $repl->declare(<<'JS');
function(o,m) {
o.oncommand(m);
};
JS
$trigger_command->($obj,'from_js');
is $called, 2, "We got called indirectly by a callback in Javascript";
is_deeply \@events,
['from_perl','from_js'],
"We received the events in the order we expected";
@events = ();

my $trigger_command_multi = $repl->declare(<<'JS');
function(obj,m,n,o,p) {
obj.oncommand(m,n,o,p);
};
JS
$trigger_command_multi->($obj,'param1','param2','param3','param4');
is $called, 3, "We got called indirectly by a callback in Javascript";
is_deeply \@events,
['param1','param2','param3','param4'],
"We received the multiple arguments in the order we expected";

@events = ();
my $window = $repl->expr(<<'JS');
var window = require('timers');
window
JS
isa_ok $window, 'NodeJs::RemoteObject::Instance',
"We got a handle on window";

# Weirdly enough, .setTimeout cannot be passed around as bare function
# Maybe just like object methods in Perl

diag NodeJs::RemoteObject::Methods::id($obj);
my $timer_id = $window->setTimeout($trigger_command, 2000, $obj, 'from_timer');
$repl->poll;
is_deeply \@events,
[],
"Delayed events don't trigger immediately";

sleep 3;
my $continue;
my $w;
$repl->poll;
is_deeply \@events,
['from_timer'],
"Delayed triggers trigger eventually";

@events = ();
$timer_id = $window->setTimeout(sub {
push @events, 'in_perl'
}, 2000);

$repl->poll;
is_deeply \@events,
[],
"Delayed events don't trigger immediately (with Perl callback)";

sleep 3;
$repl->poll;
is_deeply \@events,
['in_perl'],
"Delayed triggers trigger eventually (with Perl callback)";

is $repl->{stats}->{callback}, 5, "We triggered 5 callbacks";

# ca. 3 roundtrips per callback:
# 1 for the callback itself ( ->poll() )
# 2 for fetching its arguments in the tests
# the rest is for ephemeral setup and destructors

cmp_ok $repl->{stats}->{roundtrip}-$setup_roundtrips,'<',30, 'We needed less than 30 roundtrips for the callbacks';

use Data::Dumper;
diag Dumper $repl->{stats};

0 comments on commit 9089ce6

Please sign in to comment.