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->([tuple] or ())
# TODO: Some way to indicate that the session isn't interested in replies anymore?
sub send {
	my($s, $t, $cb) = @_;
	my $ret = Tanja::ReturnPath->_new($cb);
	for my $reg (grep Tanja::match($_->[0], $t), values %{$s->{pat}}) {
		AnyEvent::postpone {
			$reg->[1]->($t, $ret);
		}
	}
}


sub _register {
	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, $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 ], callback
#   Returns: $id, for use with unreg()
# Callback:
#   Args: [ tuple ], $return_path
sub reg {
	my($s, $pat, $cb) = @_;
	my $id;
	$id = $s->{server}->_register($pat, sub { $s->{pat}{$id} && $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, $cb) = @_;
	my $id;
	$id = $s->reg($pat, 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} = {};
}


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