summaryrefslogtreecommitdiff
path: root/Tanja.pm
blob: 1062cda1a935a69a28a1b69debbbc27b084cd87e (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
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
	for my $reg (grep Tanja::match($_->[0], $t), values %{$s->{pat}}) {
		AnyEvent::postpone {
			$reg->[2]->($t, undef);
		}
	}
}


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;
	$id = $s->{server}->_register($pat, $reply, 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, $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