Started on a simple Perl implementation (using AnyEvent)

Note that I'm not even actually using AnyEvent functionality at the
moment. But no doubt I'm going to need it anyway.

1 files changed, 143 insertions, 0 deletions

diff --git a/Tanja.pm b/Tanja.pm
new file mode 100644
index 0000000..6827cd8
--- /dev/null
+++ b/Tanja.pm
@@ -0,0 +1,143 @@
+# Note: this implementation isn't really asynchronous for communication between
+# local sessions. Not sure yet whether this is a problem. (Can be fixed easily
+# by using single-fire idle events to dispatch tuples. Comes at a performance
+# cost, though).
+
+package Tanja;
+
+use strict;
+use warnings;
+
+# Args: [ pattern ], [ tuple ]
+# Returns: a true value on match, a false value otherwise
+# TODO: this match() implementation is for experimental purposes only, it
+# should actually follow some established semantics to interoperate properly.
+# undef is used as wildcard (in either the tuple or the pattern).
+sub match {
+	my($p, $t) = @_;
+	return 0 if @$p > @$t;
+	for my $i (keys @$p) {
+		next if !defined $p->[$i] or !defined $t->[$i];
+		return 0 if $p->[$i] ne $t->[$i];
+	}
+	return 1;
+}
+
+
+package Tanja::Server;
+
+use strict;
+use warnings;
+use AnyEvent;
+
+
+# Create a new server (representing a "network")
+sub new {
+	return bless({
+		lastid => 1,
+		pat => {},
+	}, shift);
+}
+
+
+# Create a new session
+sub session {
+	return Tanja::Session->new(shift);
+}
+
+
+# Link with another server via an AnyEvent::Handle stream
+sub link {
+}
+
+
+# Send a tuple to the network.
+# Arguments: [ tuple ], $return_cb
+sub send {
+	my($s, $t, $cb) = @_;
+	# TODO: fix return path
+	$_->[2]->($t, undef) for(grep Tanja::match($_->[0], $t), values %{$s->{pat}});
+}
+
+
+sub _register {
+	my($s, $pat, $reply, $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->{lastid} = $id;
+	return $id;
+}
+
+
+sub _unregister {
+	my($s, $id) = @_;
+	delete $s->{pat}{$id};
+}
+
+
+package Tanja::Session;
+
+use strict;
+use warnings;
+use AnyEvent;
+
+
+# Create a new session (usually called by $serv->session)
+sub new {
+	my($own, $serv) = @_;
+	return bless({
+		server => $serv,
+		pat => {},
+	}, $own);
+}
+
+
+# Register for a pattern
+#   Args: [ pattern ], willreply, callback
+#   Returns: $id, for use with unreg()
+# Callback:
+#   Args: [ tuple ], $return_path
+#   Returns: (ignored)
+sub reg {
+	my($s, $pat, $reply, $cb) = @_;
+	my $id = $s->{server}->_register($pat, $reply, $cb);
+	$s->{pat}{$id} = 1;
+	return $id;
+}
+
+
+# Unregister a single pattern
+sub unreg {
+	my($s, $id) = @_;
+	$s->{server}->_unregister($id);
+	delete $s->{pat}{$id};
+}
+
+
+# For convenience. Same as ->reg(), but unregisters automatically after one call.
+sub reg_once {
+	my($s, $pat, $reply, $cb) = @_;
+	my $id;
+	$id = $s->reg($pat, $reply, sub { $s->unreg($id); $cb->(@_) });
+	return $id;
+}
+
+
+sub send {
+	my $s = shift;
+	$s->{server}->send(@_);
+}
+
+
+# "Close" the session (simply unregisters all its patterns)
+sub close {
+	my $s = shift;
+	$s->{server}->_unregister($_) for (keys %{$s->{pat}});
+	$s->{pat} = {};
+}
+
+1;
+# vim:noet:sw=4:ts=4
+