diff options
author | Yorhel <git@yorhel.nl> | 2012-02-16 18:35:23 +0100 |
---|---|---|
committer | Yorhel <git@yorhel.nl> | 2012-02-16 18:35:23 +0100 |
commit | c28ba46badb247c02088d7456bcc182b4501abc1 (patch) | |
tree | 7a80664b58724361be9127acd56e5f4526569ebc | |
parent | b689af6c792a4e9a243d6260a2718f49e98b9411 (diff) |
Remove 'reply' argument + added return-path functionality
The 'reply' thing is more typing overhead than it is worth. Especially
since the return-path functionality uses Perl's GC to automatically
close the return-path when no sessions have a reference to the object
anymore. A session can simply not read the second argument of the
tuple-callback to close the return path. (This does mean that the path
will stay open for as long as the function is running, but that doesn't
matter anyway in a single-threaded application.)
-rw-r--r-- | Tanja.pm | 52 | ||||
-rwxr-xr-x | test.pl | 29 |
2 files changed, 60 insertions, 21 deletions
@@ -47,24 +47,25 @@ sub link { # Send a tuple to the network. -# Arguments: [ tuple ], $return_cb +# Arguments: [ tuple ], $return_cb->([tuple] or ()) +# TODO: Some way to indicate that the session isn't interested in replies anymore? sub send { my($s, $t, $cb) = @_; - # TODO: fix return path + my $ret = Tanja::ReturnPath->_new($cb); for my $reg (grep Tanja::match($_->[0], $t), values %{$s->{pat}}) { AnyEvent::postpone { - $reg->[2]->($t, undef); + $reg->[1]->($t, $ret); } } } sub _register { - my($s, $pat, $reply, $cb) = @_; + my($s, $pat, $cb) = @_; my $id = $s->{lastid}; # Explicitely wrap around long before 2^31, to avoid having Perl turn the ID into a float. ++$id >= 1<<30 and $id = 1 while $s->{pat}{$id}; - $s->{pat}{$id} = [ $pat, $reply, $cb ]; + $s->{pat}{$id} = [ $pat, $cb ]; $s->{lastid} = $id; return $id; } @@ -94,15 +95,14 @@ sub new { # Register for a pattern -# Args: [ pattern ], willreply, callback +# Args: [ pattern ], callback # Returns: $id, for use with unreg() # Callback: # Args: [ tuple ], $return_path -# Returns: (ignored) sub reg { - my($s, $pat, $reply, $cb) = @_; + my($s, $pat, $cb) = @_; my $id; - $id = $s->{server}->_register($pat, $reply, sub { $s->{pat}{$id} && $cb->(@_) }); + $id = $s->{server}->_register($pat, sub { $s->{pat}{$id} && $cb->(@_) }); $s->{pat}{$id} = 1; return $id; } @@ -118,9 +118,9 @@ sub unreg { # For convenience. Same as ->reg(), but unregisters automatically after one call. sub reg_once { - my($s, $pat, $reply, $cb) = @_; + my($s, $pat, $cb) = @_; my $id; - $id = $s->reg($pat, $reply, sub { $s->unreg($id); $cb->(@_) }); + $id = $s->reg($pat, sub { $s->unreg($id); $cb->(@_) }); return $id; } @@ -138,6 +138,36 @@ sub close { $s->{pat} = {}; } + +package Tanja::ReturnPath; + +use strict; +use warnings; +use AnyEvent; + +sub _new { + my($own, $cb) = @_; + return bless \$cb, $own; +} + +sub null { + my $cb = shift; + return !$$cb; +} + +sub reply { + my($cb, $t) = @_; + $$cb && AnyEvent::postpone { $$cb->($t); }; +} + +sub DESTROY { + my $cb = shift; + my $c = $$cb; + $c && AnyEvent::postpone { $c->() }; + undef $$cb; +} + 1; + # vim:noet:sw=4:ts=4 @@ -30,9 +30,10 @@ ok !Tanja::match([2], [1]); my $done = AnyEvent->condvar; my $n = 0; my $n2 = 0; - $ses->reg([], 0, sub { + $ses->reg([], sub { my($t, $r) = @_; - is $r, undef; + isa_ok $r, 'Tanja::ReturnPath'; + ok $r->null; is_deeply $t, [$n]; ok $n <= 5; if(++$n == 5) { @@ -40,9 +41,10 @@ ok !Tanja::match([2], [1]); $done->send; } }); - $ses->reg_once([undef], 0, sub { + $ses->reg_once([undef], sub { my($t, $r) = @_; - is $r, undef; + isa_ok $r, 'Tanja::ReturnPath'; + ok $r->null; is_deeply $t, [0]; $n2++; }); @@ -55,26 +57,33 @@ ok !Tanja::match([2], [1]); } -# Simple double-session test +# Simple double-session test with return-path { my $serv = Tanja::Server->new; my $a = $serv->session; my $b = $serv->session; my $done = AnyEvent->condvar; - $a->reg(["msg"], 0, sub { + $a->reg(["msg"], sub { my($t, $r) = @_; - is $r, undef; + isa_ok $r, 'Tanja::ReturnPath'; + ok !$r->null; + $r->reply(['b', 9]); is_deeply $t, ["msg", 'a']; $a->send(["b"]); }); - $b->reg(["b"], 0, sub { + $b->reg(["b"], sub { my($t, $r) = @_; - is $r, undef; + isa_ok $r, 'Tanja::ReturnPath'; + ok $r->null; is_deeply $t, ["b"]; $done->send; }); - $b->send(["msg", 'a']); + my $n = 0; + $b->send(["msg", 'a'], sub { + !$n++ ? is_deeply $_[0], ['b', 9] : ok !@_; + }); $done->recv; + is $n, 2; } |