Author: dylan
Date: 2005-05-08 20:34:04 -0400 (Sun, 08 May 2005)
New Revision: 676
Added:
trunk/main/core/lib/Haver/Base/
trunk/main/core/lib/Haver/Base/Session.pm
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/Listener.pm
trunk/main/server/lib/Haver/Server/Speaker.pm
Log:
Added Haver::Base::Session, for defining class-sessions.
Sort of like POE::Class on CPAN, but POE::Class says it is unstable.
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:945
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:947
edfcd8bd-4ce7-0310-a97e-bb1efd40edf3:/local:238
Added: trunk/main/core/lib/Haver/Base/Session.pm
===================================================================
--- trunk/main/core/lib/Haver/Base/Session.pm 2005-05-08 20:39:37 UTC (rev
675)
+++ trunk/main/core/lib/Haver/Base/Session.pm 2005-05-09 00:34:04 UTC (rev
676)
@@ -0,0 +1,46 @@
+# vim: set ts=4 sw=4 noexpandtab si ai sta tw=100:
+# This module is copyrighted, see end of file for details.
+package Haver::Base::Session;
+use Haver::Base '-Base';
+use POE::Session;
+
+our @EXPORT_BASE = qw(
+ OBJECT SESSION
+ KERNEL HEAP STATE
+ SENDER CALLER_FILE
+ CALLER_LINE ARG0
+ ARG1 ARG2 ARG3
+ ARG4 ARG5 ARG6
+ ARG7 ARG8 ARG9
+ state states
+);
+our $VERSION = 0.04;
+
+sub create {
+ my $this = shift;
+ my $what = ref $this ? 'object' : 'package';
+
+ create POE::Session (
+ "${what}_states" => [
+ $this => $this->declared_states,
+ ],
+ args => [ @_ ],
+ )
+}
+
+*state = \&states;
+*declared_states = \&_states;
+
+
+sub states (@) {
+ my $s = _states(scalar caller);
+ push @$s, @_;
+}
+
+
+# TODO: Inherit states.
+sub _states {
+ my ($package) = @_;
+ no strict 'refs';
+ return [EMAIL PROTECTED]('::', $package, '_STATES')};
+}
Modified: trunk/main/server/lib/Haver/Server/Avatar.pm
===================================================================
--- trunk/main/server/lib/Haver/Server/Avatar.pm 2005-05-08 20:39:37 UTC
(rev 675)
+++ trunk/main/server/lib/Haver/Server/Avatar.pm 2005-05-09 00:34:04 UTC
(rev 676)
@@ -1,7 +1,7 @@
# 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::Avatar;
-use Haver::Server::Base qw( -Base );
+use Haver::Base qw( -Base );
our $VERSION = 0.07;
Modified: trunk/main/server/lib/Haver/Server/Container.pm
===================================================================
--- trunk/main/server/lib/Haver/Server/Container.pm 2005-05-08 20:39:37 UTC
(rev 675)
+++ trunk/main/server/lib/Haver/Server/Container.pm 2005-05-09 00:34:04 UTC
(rev 676)
@@ -2,7 +2,7 @@
# This module is copyrighted, see end of file for details.
# This is a mixin class.
package Haver::Server::Container;
-use Haver::Server::Base '-Base';
+use Haver::Base '-Base';
our $VERSION = 0.04;
Modified: trunk/main/server/lib/Haver/Server/Entity.pm
===================================================================
--- trunk/main/server/lib/Haver/Server/Entity.pm 2005-05-08 20:39:37 UTC
(rev 675)
+++ trunk/main/server/lib/Haver/Server/Entity.pm 2005-05-09 00:34:04 UTC
(rev 676)
@@ -1,7 +1,7 @@
# 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;
-use Haver::Server::Base '-Base';
+use Haver::Base '-Base';
field -force => (id => '_default_');
field attr => {};
Modified: trunk/main/server/lib/Haver/Server/Listener.pm
===================================================================
--- trunk/main/server/lib/Haver/Server/Listener.pm 2005-05-08 20:39:37 UTC
(rev 675)
+++ trunk/main/server/lib/Haver/Server/Listener.pm 2005-05-09 00:34:04 UTC
(rev 676)
@@ -1,35 +1,20 @@
package Haver::Server::Listener;
-use Haver::Server::Base '-Base';
+use Haver::Base::Session '-Base';
use POE;
use POE::Wheel::SocketFactory;
-use Haver::Server::Speaker;
-sub create {
- my $class = shift;
- my %opts = @_;
- unless (exists $opt{acceptor}) {
- croak "Require parameter acceptor missing";
- }
+states qw(
+ _start
+ _stop
+ _child
+ socket_birth
+ socket_fail
+ listen
+ unlisten
+ shutdown
+);
- POE::Session->create(
- package_states => [
- $class => [qw(
- _start
- _stop
- socket_birth
- socket_fail
- listen
- unlisten
- shutdown
- )],
- ],
- heap => {
- acceptor => $opt{acceptor},
- },
- );
-}
-
sub _start {
my ($kernel, $heap) = @_[KERNEL, HEAP];
Modified: trunk/main/server/lib/Haver/Server/Speaker.pm
===================================================================
--- trunk/main/server/lib/Haver/Server/Speaker.pm 2005-05-08 20:39:37 UTC
(rev 675)
+++ trunk/main/server/lib/Haver/Server/Speaker.pm 2005-05-09 00:34:04 UTC
(rev 676)
@@ -1,20 +1,18 @@
package Haver::Server::Speaker;
-
-use Haver::Server::Session '-Base';
+use Haver::Base::Session '-Base';
use POE::Wheel::ReadWrite;
use POE::Driver::SysRW;
-
-map { state "_$_" => "on_$_" } qw( start stop default );
states qw(
+ _start _stop _default
input error flush
cleanup shutdown
fail oops
);
-sub on_start {
+sub _start {
my ($heap, $session, $kernel, $opt) = @_[ HEAP, SESSION, KERNEL,
ARG0];
my ($address, $socket, $port) = ($opt->{address}, delete $opt->{sock},
$opt->{port});
@@ -45,7 +43,7 @@
}
-sub on_stop {
+sub _stop {
my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION];
my ($address, $port) = @$heap{qw(address port)};
@@ -53,14 +51,14 @@
}
-sub on_ready {
+sub ready {
my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION];
$heap->{plugin}->unload('Haver::Server::Commands::Connection');
$heap->{plugin}->load('Haver::Server::Commands::Channel');
}
-sub on_default {
+sub default {
my ($kernel, $heap, $event, $args) = @_[KERNEL, HEAP, ARG0, ARG1];
my $cmd = $event;
@@ -72,7 +70,7 @@
return 0;
}
-sub on_input {
+sub input {
my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
my @copy = @$args;
@@ -104,7 +102,7 @@
}
-sub on_flush {
+sub flush {
my ($kernel, $heap) = @_[KERNEL, HEAP];
if ($heap->{shutdown}) {
@@ -113,7 +111,7 @@
}
-sub on_error {
+sub error {
my ($kernel, $heap, $operation, $errnum, $errstr) = @_[KERNEL, HEAP,
ARG0..ARG3];
$kernel->post('Logger', 'error',
@@ -124,7 +122,7 @@
}
-sub on_shutdown {
+sub shutdown {
my ($kernel, $heap, $session, @args) = @_[KERNEL, HEAP, SESSION, ARG0
.. $#_];
return if $heap->{shutdown};
@@ -136,12 +134,12 @@
$kernel->yield('cleanup', @args);
}
-sub on_cleanup {
+sub cleanup {
my ($kernel, $heap, @args) = @_[KERNEL, HEAP, ARG0 .. $#_];
}
-sub on_oops {
+sub oops {
my ($kernel, $heap, $err, $data) = @_[KERNEL, HEAP, ARG0 .. $#_];
if (not defined $data) {
@@ -156,7 +154,7 @@
$kernel->yield('shutdown', 'OOPS');
}
-sub on_fail {
+sub fail {
my ($kernel, $heap, $cmd, $err, $data) = @_[KERNEL, HEAP, ARG0 .. $#_];
if (not defined $data) {
