Author: dylan
Date: 2006-01-20 11:47:19 -0500 (Fri, 20 Jan 2006)
New Revision: 963
Added:
trunk/perl/server/lib/Haver/Server/Entity/Agent.pm
Modified:
trunk/
trunk/perl/server/lib/Haver/Server.pm
trunk/perl/server/lib/Haver/Server/Entity.pm
trunk/perl/server/lib/Haver/Server/Entity/Avatar.pm
trunk/perl/server/lib/Haver/Server/Entity/Channel.pm
trunk/perl/server/lib/Haver/Server/Talker.pm
trunk/perl/server/lib/Haver/Server/Wheel/Attr.pm
trunk/perl/server/lib/Haver/Server/Wheel/Auth.pm
trunk/perl/server/lib/Haver/Server/Wheel/Login.pm
trunk/perl/server/lib/Haver/Server/Wheel/Main.pm
Log:
Added support for agents, somewhat.
Property changes on: trunk
___________________________________________________________________
Name: svk:merge
- 1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/havercurs-objc:43089
1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/local/trunk:11166
1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/local/trunk-merge-10131:11178
1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/winch/trunk:43192
27e50396-46e3-0310-8b22-ae223a1f35ce:/local:212
e9404bb1-7af0-0310-a7ff-e22194cd388b:/haver/local:2387
edfcd8bd-4ce7-0310-a97e-bb1efd40edf3:/local:238
+ 1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/havercurs-objc:43089
1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/local/trunk:11166
1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/local/trunk-merge-10131:11178
1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/winch/trunk:43192
27e50396-46e3-0310-8b22-ae223a1f35ce:/local:212
e9404bb1-7af0-0310-a7ff-e22194cd388b:/haver/local:2455
edfcd8bd-4ce7-0310-a97e-bb1efd40edf3:/local:238
Added: trunk/perl/server/lib/Haver/Server/Entity/Agent.pm
===================================================================
--- trunk/perl/server/lib/Haver/Server/Entity/Agent.pm 2006-01-09 21:19:13 UTC
(rev 962)
+++ trunk/perl/server/lib/Haver/Server/Entity/Agent.pm 2006-01-20 16:47:19 UTC
(rev 963)
@@ -0,0 +1,20 @@
+# vim: set ts=4 sw=4 noexpandtab si ai sta tw=100:
+# This module is copyrighted, see end of file for details.
+package Haver::Server::Entity::Agent;
+use strict;
+use warnings;
+use Haver::Server::Entity::User -base;
+
+
+sub send {
+ my ($self, $lobby, $msg) = @_;
+ my $cmd = shift @$msg;
+
+ if ($cmd eq 'FROM' and $msg->[1] ne $self->name) {
+ my $user = shift @$msg;
+ my $target = $lobby->lookup('user', $user);
+ $target->send($lobby, ['FROM', $self->name, @$msg]);
+ }
+}
+
+1;
Modified: trunk/perl/server/lib/Haver/Server/Entity/Avatar.pm
===================================================================
--- trunk/perl/server/lib/Haver/Server/Entity/Avatar.pm 2006-01-09 21:19:13 UTC
(rev 962)
+++ trunk/perl/server/lib/Haver/Server/Entity/Avatar.pm 2006-01-20 16:47:19 UTC
(rev 963)
@@ -9,7 +9,6 @@
field -weak => 'wheel';
-field sid => undef;
field _access => {};
field passcode => undef;
field full_address => '0.0.0.0';
@@ -36,14 +35,9 @@
}
}
-sub call {
- my $self = shift;
- $POE::Kernel::poe_kernel->call($self->sid, @_);
-}
+sub send {
+ my ($self, $lobby, $msg) = @_;
-sub put {
- my ($self, $msg) = @_;
-
if (my $w = $self->wheel) {
$w->put($msg);
return 1;
Modified: trunk/perl/server/lib/Haver/Server/Entity/Channel.pm
===================================================================
--- trunk/perl/server/lib/Haver/Server/Entity/Channel.pm 2006-01-09
21:19:13 UTC (rev 962)
+++ trunk/perl/server/lib/Haver/Server/Entity/Channel.pm 2006-01-20
16:47:19 UTC (rev 963)
@@ -40,11 +40,11 @@
);
}
-sub put {
- my ($self, $msg) = @_;
+sub send {
+ my ($self, $lobby, $msg) = @_;
foreach my $user ($self->list('user')) {
- $user->put($msg);
+ $user->send($lobby, $msg);
}
}
@@ -60,6 +60,11 @@
}
sub get {
+ carp "get() is depercated";
+ lookup(@_);
+}
+
+sub lookup {
my ($self, $ns, $name) = @_;
$name = lc $name;
Modified: trunk/perl/server/lib/Haver/Server/Entity.pm
===================================================================
--- trunk/perl/server/lib/Haver/Server/Entity.pm 2006-01-09 21:19:13 UTC
(rev 962)
+++ trunk/perl/server/lib/Haver/Server/Entity.pm 2006-01-20 16:47:19 UTC
(rev 963)
@@ -8,7 +8,7 @@
field attr => {};
stub 'namespace';
-stub 'put';
+stub 'send';
stub 'info';
sub initialize {
Modified: trunk/perl/server/lib/Haver/Server/Talker.pm
===================================================================
--- trunk/perl/server/lib/Haver/Server/Talker.pm 2006-01-09 21:19:13 UTC
(rev 962)
+++ trunk/perl/server/lib/Haver/Server/Talker.pm 2006-01-20 16:47:19 UTC
(rev 963)
@@ -162,7 +162,7 @@
$user->part($chan);
foreach my $u ($chan->list('user')) {
unless ($seen{ $u->name }++) {
- $u->put(['QUIT', $user->name,
@why]);
+ $u->send($lobby, ['QUIT',
$user->name, @why]);
}
}
}
Modified: trunk/perl/server/lib/Haver/Server/Wheel/Attr.pm
===================================================================
--- trunk/perl/server/lib/Haver/Server/Wheel/Attr.pm 2006-01-09 21:19:13 UTC
(rev 962)
+++ trunk/perl/server/lib/Haver/Server/Wheel/Attr.pm 2006-01-20 16:47:19 UTC
(rev 963)
@@ -32,7 +32,7 @@
}
my $entity = $lobby->get($ns, $name);
- $heap->{client}->put(['ATTR:GOT', $key, $entity->{attr}{$key} || '']);
+ $heap->{client}->put(['ATTR:VAL', $ns, $name, $key,
$entity->{attr}{$key} || '']);
}
sub msg_ATTR_SET {
Modified: trunk/perl/server/lib/Haver/Server/Wheel/Auth.pm
===================================================================
--- trunk/perl/server/lib/Haver/Server/Wheel/Auth.pm 2006-01-09 21:19:13 UTC
(rev 962)
+++ trunk/perl/server/lib/Haver/Server/Wheel/Auth.pm 2006-01-20 16:47:19 UTC
(rev 963)
@@ -39,6 +39,8 @@
keys %{ $config->digests },
]
);
+ } else {
+ call('shutdown', 'bork', "I don't speak french!");
}
}
Modified: trunk/perl/server/lib/Haver/Server/Wheel/Login.pm
===================================================================
--- trunk/perl/server/lib/Haver/Server/Wheel/Login.pm 2006-01-09 21:19:13 UTC
(rev 962)
+++ trunk/perl/server/lib/Haver/Server/Wheel/Login.pm 2006-01-20 16:47:19 UTC
(rev 963)
@@ -103,7 +103,6 @@
$user->wheel($heap->{client});
- $user->sid($_[SESSION]->ID);
$user->version($heap->{version});
$user->address($heap->{address});
$lobby->add($user);
Modified: trunk/perl/server/lib/Haver/Server/Wheel/Main.pm
===================================================================
--- trunk/perl/server/lib/Haver/Server/Wheel/Main.pm 2006-01-09 21:19:13 UTC
(rev 962)
+++ trunk/perl/server/lib/Haver/Server/Wheel/Main.pm 2006-01-20 16:47:19 UTC
(rev 963)
@@ -50,7 +50,7 @@
my $lobby = $heap->{lobby};
my ($name) = @$args;
my $user = $heap->{user};
- my $chan = $lobby->get('channel', $name);
+ my $chan = $lobby->lookup('channel', $name);
unless (is_valid_name($name)) {
call('fail', "invalid.name", $name);
@@ -66,7 +66,7 @@
}
$user->join($chan);
- $chan->put(['JOIN', $chan->name, $user->name]);
+ $chan->send($lobby, ['JOIN', $chan->name, $user->name]);
}
sub msg_OPEN {
@@ -107,14 +107,14 @@
call('fail', 'unknown.channel', $name);
return;
}
- my $chan = $lobby->get('channel', $name);
+ my $chan = $lobby->lookup('channel', $name);
if ($chan->owner ne $user->name) {
call('fail', 'not-owner', $chan->owner, $user->name);
return;
}
$lobby->remove('channel', $name);
- $chan->put(['CLOSE', $name]);
+ $chan->send($lobby, ['CLOSE', $name]);
if (not $chan->contains('user', $user->name)) {
$heap->{client}->put(['CLOSE', $name]);
}
@@ -128,7 +128,7 @@
my $lobby = $heap->{lobby};
my ($name) = @$args;
my $user = $heap->{user};
- my $chan = $lobby->get('channel', $name);
+ my $chan = $lobby->lookup('channel', $name);
unless (is_valid_name($name)) {
call('fail', 'invalid.name', $name);
@@ -143,7 +143,7 @@
return;
}
- $chan->put(['PART', $chan->name, $user->name]);
+ $chan->send($lobby, ['PART', $chan->name, $user->name]);
$user->part($chan);
}
@@ -153,7 +153,7 @@
my $lobby = $heap->{lobby};
my ($name, $type) = (shift @$args, shift @$args);
my $user = $heap->{user};
- my $targ = $lobby->get('user', $name);
+ my $targ = $lobby->lookup('user', $name);
unless (is_valid_name($name)) {
@@ -170,7 +170,7 @@
}
- $targ->put(['FROM', $user->name, $type, @$args]);
+ $targ->send($lobby, ['FROM', $user->name, $type, @$args]);
}
sub msg_IN {
@@ -178,7 +178,7 @@
my $lobby = $heap->{lobby};
my ($name, $type) = (shift @$args, shift @$args);
my $user = $heap->{user};
- my $chan = $lobby->get('channel', $name);
+ my $chan = $lobby->lookup('channel', $name);
unless (is_valid_name($name)) {
@@ -194,7 +194,7 @@
return;
}
- $chan->put(['IN', $chan->name, $user->name, $type, @$args]);
+ $chan->send($lobby, ['IN', $chan->name, $user->name, $type, @$args]);
}
sub msg_LIST {
@@ -214,7 +214,7 @@
call('fail', 'unknown.namespace', $ns);
return;
}
- my $chan = $lobby->get('channel', $name);
+ my $chan = $lobby->lookup('channel', $name);
my @items = $chan->list($ns);
$heap->{client}->put(['LIST', $name, $ns, map { $_->name } @items]);
}
@@ -237,7 +237,7 @@
return;
}
- my $entity = $lobby->get($ns, $name);
+ my $entity = $lobby->lookup($ns, $name);
$heap->{client}->put(['INFO', $ns, $name, $entity->info]);
Modified: trunk/perl/server/lib/Haver/Server.pm
===================================================================
--- trunk/perl/server/lib/Haver/Server.pm 2006-01-09 21:19:13 UTC (rev
962)
+++ trunk/perl/server/lib/Haver/Server.pm 2006-01-20 16:47:19 UTC (rev
963)
@@ -24,6 +24,7 @@
use Haver::Server::Listener;
use Haver::Server::Talker;
use Haver::Server::Entity::User;
+use Haver::Server::Entity::Agent;
use Haver::Server::Entity::Channel;
use Haver::Server::Entity::Lobby;
use Haver::Server::Config;
@@ -71,6 +72,8 @@
# Fetch the lobby
Log('debug', "Fetching &lobby");
my $lobby = $store->fetch('lobby', '&lobby');
+ my $echo = new Haver::Server::Entity::Agent (name => '&echo');
+ $lobby->add($echo);
Log('debug', "Channels: ", join(", ", $lobby->names('channel')));
