Author: dylan
Date: 2005-05-24 04:43:02 -0400 (Tue, 24 May 2005)
New Revision: 729
Modified:
trunk/
trunk/main/server/lib/Haver/Server/Avatar.pm
trunk/main/server/lib/Haver/Server/Talker.pm
Log:
[EMAIL PROTECTED]: dylan | 2005-05-24 04:42:56 -0400
IN works. Server does not send QUIT.
Minimal error checking.
Property changes on: trunk
___________________________________________________________________
Name: svk:merge
- 1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/local/trunk:11166
1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/local/trunk-merge-10131:11178
27e50396-46e3-0310-8b22-ae223a1f35ce:/local:212
e9404bb1-7af0-0310-a7ff-e22194cd388b:/haver/local:1005
edfcd8bd-4ce7-0310-a97e-bb1efd40edf3:/local:238
+ 1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/local/trunk:11166
1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/local/trunk-merge-10131:11178
27e50396-46e3-0310-8b22-ae223a1f35ce:/local:212
e9404bb1-7af0-0310-a7ff-e22194cd388b:/haver/local:1025
edfcd8bd-4ce7-0310-a97e-bb1efd40edf3:/local:238
Modified: trunk/main/server/lib/Haver/Server/Avatar.pm
===================================================================
--- trunk/main/server/lib/Haver/Server/Avatar.pm 2005-05-24 02:57:33 UTC
(rev 728)
+++ trunk/main/server/lib/Haver/Server/Avatar.pm 2005-05-24 08:43:02 UTC
(rev 729)
@@ -5,9 +5,20 @@
our $VERSION = 0.07;
-field 'sid' => undef;
+
+field -weak => 'wheel';
field _access => {};
+
+sub put {
+ if (my $w = $self->wheel) {
+ $w->put([EMAIL PROTECTED]);
+ return 1;
+ } else {
+ return undef;
+ }
+}
+
sub grant {
my ($where, $what, $level) = @_;
Modified: trunk/main/server/lib/Haver/Server/Talker.pm
===================================================================
--- trunk/main/server/lib/Haver/Server/Talker.pm 2005-05-24 02:57:33 UTC
(rev 728)
+++ trunk/main/server/lib/Haver/Server/Talker.pm 2005-05-24 08:43:02 UTC
(rev 729)
@@ -123,14 +123,16 @@
Log('info', "Shutting down talker for $heap->{address}:$heap->{port}");
$heap->{shutdown} = 1;
- my $user = delete $heap->{user};
unless ($heap->{error}) {
eval {
$heap->{client}->put(['BYE', @why]);
};
- warn "Error: ", $@ if $@;
- }
- $Lobby->remove($user->namespace, $user->name);
+ Log('error', $@) if $@;
+ }
+
+ if (my $user = $heap->{user}) {
+ $Lobby->remove($user->namespace, $user->name);
+ }
$kernel->alarm_remove_all();
}
@@ -143,17 +145,6 @@
}
}
-
-
-
-
-
-
-
-
-
-
-
sub msg_HAVER {
my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
my ($version) = @$args;
@@ -175,13 +166,14 @@
} else {
my $user = new Haver::Server::Entity::User (
name => $name,
+ wheel => $heap->{client}, # weak reference!
);
$Lobby->add($user);
$heap->{user} = $user;
$kernel->state('msg_ODENT');
$heap->{client}->put(['HELLO', $name]);
$kernel->state('msg_IDENT');
- foreach (qw( TO BYE )) {
+ foreach (qw( TO BYE IN )) {
$kernel->state("msg_$_", __PACKAGE__);
}
}
@@ -189,9 +181,43 @@
sub msg_TO {
my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
- my ($name) = shift @$args;
+ my ($name, $type) = (shift @$args, shift @$args);
my $user = $heap->{user};
+ my $targ = $Lobby->fetch('user', $name);
+
+ unless ($targ) {
+ $kernel->yield('fail', 'unknown.user');
+ return;
+ }
+ unless (defined $type) {
+ $kernel->yield('fail', 'missing.type');
+ return;
+ }
+
+
+ $targ->put('FROM', $user->name, $type, @$args);
+}
+
+sub msg_IN {
+ my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
+ my ($name, $type) = (shift @$args, shift @$args);
+ my $user = $heap->{user};
+ my $chan = $Lobby->fetch('channel', $name);
+
+ unless ($chan) {
+ $kernel->yield('fail', 'unknown.user');
+ return;
+ }
+ unless (defined $type) {
+ $kernel->yield('fail', 'missing.type');
+ return;
+ }
+
+ $name = $chan->name;
+ foreach my $targ ($chan->contents('user')) {
+ $targ->put('IN', $name, $user->name, $type, @$args);
+ }
}
sub msg_BYE {
