Author: dylan
Date: 2005-05-23 21:44:00 -0400 (Mon, 23 May 2005)
New Revision: 723
Modified:
trunk/
trunk/main/server/lib/Haver/Server/Avatar.pm
trunk/main/server/lib/Haver/Server/Container.pm
trunk/main/server/lib/Haver/Server/Entity.pm
trunk/main/server/lib/Haver/Server/Entity/Lobby.pm
trunk/main/server/lib/Haver/Server/Listener.pm
trunk/main/server/lib/Haver/Server/Talker.pm
Log:
[EMAIL PROTECTED]: dylan | 2005-05-23 21:43:41 -0400
okay, had to fix some things. TO and IN were removed before I even commited
them. Login stuff works though.
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:995
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:1005
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 01:22:26 UTC
(rev 722)
+++ trunk/main/server/lib/Haver/Server/Avatar.pm 2005-05-24 01:44:00 UTC
(rev 723)
@@ -5,7 +5,7 @@
our $VERSION = 0.07;
-field 'wheel';
+field 'sid' => undef;
field _access => {};
sub grant {
Modified: trunk/main/server/lib/Haver/Server/Container.pm
===================================================================
--- trunk/main/server/lib/Haver/Server/Container.pm 2005-05-24 01:22:26 UTC
(rev 722)
+++ trunk/main/server/lib/Haver/Server/Container.pm 2005-05-24 01:44:00 UTC
(rev 723)
@@ -38,7 +38,7 @@
return delete $self->{_contents}{$ns}{$name};
}
-sub _contents {
+sub contents {
my ($ns) = @_;
my @values = ();
Modified: trunk/main/server/lib/Haver/Server/Entity/Lobby.pm
===================================================================
--- trunk/main/server/lib/Haver/Server/Entity/Lobby.pm 2005-05-24 01:22:26 UTC
(rev 722)
+++ trunk/main/server/lib/Haver/Server/Entity/Lobby.pm 2005-05-24 01:44:00 UTC
(rev 723)
@@ -1,14 +1,43 @@
# vim: set ts=4 sw=4 expandtab si ai sta tw=104:
# This module is copyrighted, see end of file for details.
package Haver::Server::Entity::Lobby;
-use Haver::Server::Entity qw( -Base );
-use Haver::Server::Container qw( -mixin );
+use Haver::Server::Entity::Channel -Base;
-our $VERSION = 0.12;
+our $VERSION = 0.20;
+our $Self;
+const name => '&lobby';
-const namespace => 'lobby';
-
sub can_contain {
my $object = shift;
- $object->namespace ne 'lobby';
+ $self != $object;
}
+
+sub fetch {
+ my ($ns, $name) = @_;
+
+ if ($ns eq 'channel' and $name eq '&lobby') {
+ return $self;
+ } else {
+ super ($ns, $name);
+ }
+}
+
+sub contains {
+ my ($ns, $name) = @_;
+
+ if ($ns eq 'channel' and $name eq '&lobby') {
+ return 1;
+ } else {
+ return super ($ns, $name);
+ }
+}
+
+
+sub contents {
+ my ($ns) = @_;
+ my $c = super($ns);
+ if ($ns eq 'channel') {
+ push @$c, $self;
+ }
+ wantarray ? @$c : $c;
+}
Modified: trunk/main/server/lib/Haver/Server/Entity.pm
===================================================================
--- trunk/main/server/lib/Haver/Server/Entity.pm 2005-05-24 01:22:26 UTC
(rev 722)
+++ trunk/main/server/lib/Haver/Server/Entity.pm 2005-05-24 01:44:00 UTC
(rev 723)
@@ -3,7 +3,7 @@
package Haver::Server::Entity;
use Haver::Base '-Base';
-field -force => (id => '_default_');
+field name => '&undef';
field attr => {};
stub 'namespace';
Modified: trunk/main/server/lib/Haver/Server/Listener.pm
===================================================================
--- trunk/main/server/lib/Haver/Server/Listener.pm 2005-05-24 01:22:26 UTC
(rev 722)
+++ trunk/main/server/lib/Haver/Server/Listener.pm 2005-05-24 01:44:00 UTC
(rev 723)
@@ -55,8 +55,8 @@
Log('notice', "Listening on port $port.");
my $wheel = POE::Wheel::SocketFactory->new(
+ #BindAddress => $addr,
BindPort => $port,
- #BindAddress => $addr,
Reuse => 1,
SuccessEvent => 'socket_birth',
FailureEvent => 'socket_fail',
Modified: trunk/main/server/lib/Haver/Server/Talker.pm
===================================================================
--- trunk/main/server/lib/Haver/Server/Talker.pm 2005-05-24 01:22:26 UTC
(rev 722)
+++ trunk/main/server/lib/Haver/Server/Talker.pm 2005-05-24 01:44:00 UTC
(rev 723)
@@ -1,19 +1,27 @@
package Haver::Server::Talker;
use Haver::Base::Session -base;
+use Haver::Base::Session -XXX, -dumper;
use strict;
use warnings;
use Haver::Server;
+use Haver::Server::Entity::Lobby;
+use Haver::Server::Entity::User;
use Haver::Protocol::Filter;
+
+
use POE::Wheel::ReadWrite;
use POE::Driver::SysRW;
+
+
our $VERSION = '0.08';
+our $Lobby = new Haver::Server::Entity::Lobby (name => '&lobby');
states qw(
_start _stop _default
input error flush
- bye shutdown
+ shutdown fail
msg_HAVER
);
@@ -55,11 +63,10 @@
if (not $heap->{version}) {
Log('warning', "Client issued unknown command ($cmd)
before HAVER.");
Log('warning', 'Probably a search engine...');
- delete $heap->{client};
- $kernel->yield('shutdown', 'borked');
+ $kernel->yield('shutdown');
} else {
Log('warning', "Client isseud unknown command $cmd");
- $heap->{client}->put(['FAIL', $cmd, 'unknown.cmd']);
+ $kernel->yield('fail', 'unknown.cmd');
}
}
@@ -77,43 +84,38 @@
my $event = 'msg_' . $cmd;
$event =~ s/:/_/g;
- Log('info', "Command: '$cmd' ('$event')");
+ Log('info', "Command: '$cmd'");
+ $heap->{cmd} = $cmd;
$kernel->call($_[SESSION], $event, $args, $cmd);
}
-sub msg_HAVER {
- my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
- my ($version) = @$args;
-
- Log('notice', 'Client is ' . $version);
- $heap->{client}->put(['HAVER',
"Haver::Server/$Haver::Server::VERSION"]);
- $heap->{version} = $version;
+sub fail {
+ my ($kernel, $heap, $err, @args) = @_[KERNEL, HEAP, ARG0 .. $#_];
+ $heap->{client}->put(['FAIL', $heap->{cmd}, $err, @args]);
}
-
sub error {
my ($kernel, $heap, $operation, $errnum, $errstr) = @_[KERNEL, HEAP,
ARG0..ARG3];
- my $type;
+ my @why;
if ($errnum == 0) {
- $type = 'closed';
+ @why = ('closed');
} else {
Log('error',
"Talker for $heap->{address}:$heap->{port}: ",
"Socket generated $operation error ${errnum}: $errstr");
- $type = 'error';
+ @why = ('error', $errstr);
}
-
+ $heap->{error} = 1;
delete $heap->{client};
- $heap->{error} = 1;
- $kernel->yield('shutdown', $type);
+ $kernel->yield('shutdown', @why);
}
sub shutdown {
- my ($kernel, $heap, $session, @pair) = @_[KERNEL, HEAP, SESSION, ARG0,
ARG1];
+ my ($kernel, $heap, $session, @why) = @_[KERNEL, HEAP, SESSION, ARG0,
ARG1];
if ($heap->{shutdown}) {
Log('critical', 'Race condition: shutdown called more than
once!');
@@ -121,21 +123,17 @@
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);
$kernel->alarm_remove_all();
- $kernel->yield('bye', @pair) if $heap->{client};
}
-
-sub bye {
- my ($kernel, $heap, @pair) = @_[KERNEL, HEAP, ARG0, ARG1];
-
- if ($heap->{client}) {
- $heap->{client}->put(['BYE', @pair]);
- } elsif (not $heap->{error}) {
- Log('error', "Bye called and then client wheel disappeared.");
- }
-}
-
sub flush {
my ($kernel, $heap) = @_[KERNEL, HEAP];
@@ -149,4 +147,58 @@
+
+
+
+
+
+
+
+sub msg_HAVER {
+ my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
+ my ($version) = @$args;
+
+ Log('notice', 'Client is ' . $version);
+ $heap->{client}->put(['HAVER',
"Haver::Server/$Haver::Server::VERSION"]);
+ $heap->{version} = $version;
+
+ $kernel->state('msg_IDENT', __PACKAGE__);
+ $kernel->state('msg_HAVER');
+}
+
+sub msg_IDENT {
+ my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
+ my ($name) = @$args;
+
+ if ($Lobby->contains('user', $name)) {
+ $kernel->yield('fail', 'exists.user', $name);
+ } else {
+ my $user = new Haver::Server::Entity::User (
+ name => $name,
+ );
+ $Lobby->add($user);
+ $heap->{user} = $user;
+ $kernel->state('msg_ODENT');
+ $heap->{client}->put(['HELLO', $name]);
+ $kernel->state('msg_IDENT');
+ foreach (qw( TO BYE )) {
+ $kernel->state("msg_$_", __PACKAGE__);
+ }
+ }
+}
+
+sub msg_TO {
+ my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
+ my ($name) = shift @$args;
+ my $user = $heap->{user};
+
+}
+
+sub msg_BYE {
+ my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
+ $kernel->yield('shutdown', 'bye', $args->[0]);
+}
+
+
+
1;
