summaryrefslogtreecommitdiff
path: root/Tanja.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Tanja.pm')
-rw-r--r--Tanja.pm52
1 files changed, 41 insertions, 11 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