summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorYorhel <git@yorhel.nl>2012-02-16 18:35:23 +0100
committerYorhel <git@yorhel.nl>2012-02-16 18:35:23 +0100
commitc28ba46badb247c02088d7456bcc182b4501abc1 (patch)
tree7a80664b58724361be9127acd56e5f4526569ebc
parentb689af6c792a4e9a243d6260a2718f49e98b9411 (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.pm52
-rwxr-xr-xtest.pl29
2 files changed, 60 insertions, 21 deletions
diff --git a/Tanja.pm b/Tanja.pm
index 1062cda..d62a30d 100644
--- a/Tanja.pm
+++ b/Tanja.pm
@@ -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
diff --git a/test.pl b/test.pl
index a5aea3c..54884ba 100755
--- a/test.pl
+++ b/test.pl
@@ -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;
}