Author: dylan
Date: 2004-10-25 17:57:05 -0400 (Mon, 25 Oct 2004)
New Revision: 407
Added:
trunk/main/server/lib/Haver/Server/Avatar.pm
trunk/main/server/lib/Haver/Server/Broadcaster.pm
trunk/main/server/lib/Haver/Server/Commands.pm
trunk/main/server/lib/Haver/Server/Commands/
trunk/main/server/lib/Haver/Server/Listener.pm
trunk/main/server/lib/Haver/Server/Plugin.pm
trunk/main/server/lib/Haver/Server/Plugin/
Removed:
trunk/main/server/lib/Haver/Server/Object/Hammer.pm
trunk/main/server/lib/Haver/Server/POE.pm
trunk/main/server/lib/Haver/Server/POE/Broadcaster.pm
trunk/main/server/lib/Haver/Server/POE/Connection.pm
trunk/main/server/lib/Haver/Server/POE/Listener.pm
Modified:
trunk/main/server/lib/
trunk/main/server/lib/Haver/Server/Registry.pm
Log:
Merging haver-server-cleanup into trunk
because of a very strange svk bug that is preventing me
from making a copy of it on my laptop.
The server currently WILL NOT FUNCTION.
If you need a functional haver server, please see revision 401.
This is temporary and in the future should happen.
SVK seems to dislike mirroring branches, 'tis all.
Property changes on: trunk/main/server/lib
___________________________________________________________________
Name: svn:ignore
+ *.foo
Copied: trunk/main/server/lib/Haver/Server/Avatar.pm (from rev 406,
branches/haver-server-cleanup/lib/Haver/Server/Avatar.pm)
Property changes on: trunk/main/server/lib/Haver/Server/Avatar.pm
___________________________________________________________________
Name: svn:eol-style
+ native
Copied: trunk/main/server/lib/Haver/Server/Broadcaster.pm (from rev 406,
branches/haver-server-cleanup/lib/Haver/Server/Broadcaster.pm)
Property changes on: trunk/main/server/lib/Haver/Server/Broadcaster.pm
___________________________________________________________________
Name: svn:eol-style
+ native
Copied: trunk/main/server/lib/Haver/Server/Commands (from rev 406,
branches/haver-server-cleanup/lib/Haver/Server/Commands)
Copied: trunk/main/server/lib/Haver/Server/Commands.pm (from rev 406,
branches/haver-server-cleanup/lib/Haver/Server/Commands.pm)
Copied: trunk/main/server/lib/Haver/Server/Listener.pm (from rev 406,
branches/haver-server-cleanup/lib/Haver/Server/Listener.pm)
Property changes on: trunk/main/server/lib/Haver/Server/Listener.pm
___________________________________________________________________
Name: svn:eol-style
+ native
Deleted: trunk/main/server/lib/Haver/Server/Object/Hammer.pm
===================================================================
--- trunk/main/server/lib/Haver/Server/Object/Hammer.pm 2004-10-25 21:37:30 UTC
(rev 406)
+++ trunk/main/server/lib/Haver/Server/Object/Hammer.pm 2004-10-25 21:57:05 UTC
(rev 407)
@@ -1,117 +0,0 @@
-# Haver::Server::Object::Hammer - OO Hammer object thing.
-#
-# Copyright (C) 2004 Dylan William Hardison
-#
-# This module is free software; you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation; either version 2 of the License, or
-# (at your option) any later version.
-#
-# This module is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this module; if not, write to the Free Software
-# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-package Haver::Server::Object::Hammer;
-use strict;
-use warnings;
-use Carp;
-
-
-use Haver::Server::Object;
-use base qw( Haver::Server::Object::Grantable );
-
-our $VERSION = '0.04';
-our $AUTOLOAD;
-
-
-sub namespace { 'hammer' }
-
-sub initialize {
- my ($me) = shift;
-
- $me->SUPER::initialize(@_);
- $me->{user} or croak "Need user object!";
-
- $me->{home} ||= 'object/limbo';
- $me->{owner} ||= 'object/nobody';
-}
-
-sub has {
- my ($me, @keys) = @_;
-
- return $me->SUPER::has(@keys) || $me->{user}->has(@keys);
-}
-
-sub get {
- my ($me, @keys) = @_;
- my @values;
-
- foreach my $k (@keys) {
- push(@values, $me->SUPER::get($k) || $me->{user}->get($k));
- }
-
- return @values;
-}
-
-
-BEGIN {
- no strict 'refs';
- foreach my $sub (qw( home owner user )) {
- *{$sub} = sub {
- my ($me, $val) = @_;
- if (@_ == 2) {
- return $me->{$sub} = $val;
- } else {
- return $me->{$sub};
- }
- };
- }
-}
-
-
-
-#sub AUTOLOAD {
-# my $me = shift;
-# my $method = (split("::", $AUTOLOAD))[-1];
-#
-# $me->{user}->$method(@_);
-#}
-
-1;
-__END__
-=head1 NAME
-
-Haver::Server::Object::Hammer - Object representation of a user.
-
-=head1 SYNOPSIS
-
- use Haver::Server::Object::Hammer;
- my %opts = (); # No options at this time...
- my $uid = 'rob';
- a
- my $user = new Haver::Server::Object::Hammer($uid, %opts);
-
- $user->uid eq $uid; # True
- $user->set(nick => "Roberto");
- $user->set(away => "Roberto isn't here.");
- $user->get('nick') eq 'Roberto'; # True
- my ($nick, $away) = $user->get('nick', 'away'); # Obvious...
- my $array_ref = $user->get('nick', 'away'); # Like above, but a arrayref.
-
- $user->unset('nick', 'away'); # unset one or more items.
-
- my @fields = $user->keys; # Returns all fields.
-
- $user->add_cid($cid);
- $user->remove_cid($cid);
-
-=head1 DESCRIPTION
-
-This module is a representation of a user. It's rather pointless, but it gives
-you a warm fuzzy feeling. In the future, it might store the users in a
database or something.
-
-
Deleted: trunk/main/server/lib/Haver/Server/POE/Broadcaster.pm
===================================================================
--- trunk/main/server/lib/Haver/Server/POE/Broadcaster.pm 2004-10-25
21:37:30 UTC (rev 406)
+++ trunk/main/server/lib/Haver/Server/POE/Broadcaster.pm 2004-10-25
21:57:05 UTC (rev 407)
@@ -1,71 +0,0 @@
-# vim: set ft=perl ts=4 sw=4:
-# Haver::Server::POE::Broadcaster - description
-#
-# Copyright (C) 2004 Dylan William Hardison.
-#
-# This module is free software; you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation; either version 2 of the License, or
-# (at your option) any later version.
-#
-# This module is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this module; if not, write to the Free Software
-# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-package Haver::Server::POE::Broadcaster;
-use strict;
-use warnings;
-use POE;
-
-our $VERSION = 0.01;
-use Haver::Preprocessor;
-use Haver::Server::Registry qw( $Registry );
-
-use constant CHUNK => 10;
-
-sub create {
- my ($this) = @_;
-
- POE::Session->create(
- package_states => [
- $this => [qw(
- _start
- _stop
- send
- )],
- ],
- );
-}
-
-sub _start {
- my ($kernel, $heap) = @_[KERNEL, HEAP];
-
- $kernel->alias_set('Broadcaster');
-}
-
-sub send {
- my ($kernel, $heap, $target, $msg) = @_[KERNEL, HEAP, ARG0, ARG1];
- # ASSERT: ref($target) eq 'ARRAY' and ref($msg) eq 'ARRAY';
- my $n = @$target;
- my $end = $n > CHUNK ? CHUNK : $n;
- my @targ = splice(@$target, 0, $end);
-
- foreach my $t (@targ) {
- my $u = ref $t ? $t : $Registry->fetch('user', $t);
- eval { $u->wheel->put($msg) };
- warn $@ if $@;
- }
-
- if (@$target) {
- $kernel->yield('send', $target, $msg);
- }
-}
-
-sub _stop { }
-
-1;
-
Deleted: trunk/main/server/lib/Haver/Server/POE/Connection.pm
===================================================================
--- trunk/main/server/lib/Haver/Server/POE/Connection.pm 2004-10-25
21:37:30 UTC (rev 406)
+++ trunk/main/server/lib/Haver/Server/POE/Connection.pm 2004-10-25
21:57:05 UTC (rev 407)
@@ -1,366 +0,0 @@
-# Haver::Server::POE::Connection,
-# this creates a session, which represents the user...
-#
-# Copyright (C) 2003 Dylan William Hardison.
-#
-# This module is free software; you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation; either version 2 of the License, or
-# (at your option) any later version.
-#
-# This module is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this module; if not, write to the Free Software
-# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-
-# TODO, write POD. Soon.
-package Haver::Server::POE::Connection;
-use strict;
-use Carp qw(croak confess carp cluck);
-
-use POE qw(
- Wheel::ReadWrite
- Driver::SysRW
- Preprocessor
- Filter::Haver
-);
-
-use Haver::Protocol;
-use Haver::Server::POE::Commands;
-use Haver::Server::Registry qw( $Registry );
-use Haver::Formats qw( :duration );
-
-use Scalar::Util ();
-use Digest::SHA1 qw( sha1_base64 );
-our $RELOAD = 1;
-
-sub create {
- my ($class) = shift;
- # ASSERT: (@_ == 1 and ref($_[0]) eq 'HASH') or ((@_ % 2) == 0);
- my $opts = @_ == 1 ? $_[0] : { @_ };
-
- my $commands = 'Haver::Server::POE::Commands';
-
- POE::Session->create(
- package_states => [
- $class => {
- # POE states
- _start => '_start',
- _stop => '_stop',
- _default => '_default',
-
-
- # Wheel states
- socket_input => 'socket_input',
- socket_error => 'socket_error',
- socket_flush => 'socket_flush',
-
- # Utility states
- want => 'on_want',
- cleanup => 'on_cleanup',
- 'shutdown' => 'on_shutdown',
- 'fail' => 'on_fail',
- 'oops' => 'on_oops',
- 'accept' => 'on_accept',
- auth => 'on_auth',
- unknown_cmd => 'on_unknown_cmd',
- close => 'on_close',
- },
- $commands => $commands->commands,
- ],
- heap => {},
- args => [ $opts ],
- );
-}
-
-sub _start {
- my ($heap, $session, $kernel, $opt) = @_[ HEAP, SESSION, KERNEL,
ARG0];
- my ($address, $socket, $port) = ($opt->{address}, $opt->{sock},
$opt->{port});
- $address = Socket::inet_ntoa($address);
-
- $kernel->post('Logger', 'note', 'Socket Birth');
- $kernel->post('Logger', 'note', "Connection from ${address}:$port");
-
-
- ## breaks ssl.
- #binmode $socket, ":utf8";
- my $client = new POE::Wheel::ReadWrite(
- Handle => $socket,
- Driver => new POE::Driver::SysRW,
- Filter => new POE::Filter::Haver,
- InputEvent => 'socket_input',
- FlushedEvent => 'socket_flush',
- ErrorEvent => 'socket_error',
- );
-
-
- my $timer = $kernel->alarm_set(
- 'shutdown',
- time + 60 * 60,
- 'TIMEOUT',
- );
-
- %$heap = (
- address => $address,
- port => $port,
- timer => $timer,
- client => $client,
- sock => $socket,
- shutdown => 0,
- plonk => 0,
- want => undef,
- want_data => undef, # called if CANT $WANT...
- user => undef,
- uid => undef,
- );
-}
-sub _stop {
- my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION];
-
- my ($address, $port) = @$heap{qw(address port)};
- $kernel->call('Logger', 'note', 'Socket Death');
- $kernel->call('Logger', 'note', "Lost connection from
${address}:$port");
-}
-sub _default {
- my ($kernel, $heap, $event, $args) = @_[KERNEL, HEAP, ARG0, ARG1];
-
-
- if ($event =~ s/^cmd_//) {
- my $cmd = "cmd_$event";
- if (my $code = Haver::Server::POE::Commands->can($cmd)) {
- $kernel->state($cmd, 'Haver::Server::POE::Commands');
- @_[ARG0 .. $#_] = @{ $_[ARG1] };
- goto &$code;
- } else {
- $kernel->call($_[SESSION], 'unknown_cmd', $event,
$_[ARG1][0]);
- }
- }
- $kernel->post('Logger', 'error', "Unknown event: $event");
-
- return 0;
-}
-
-sub socket_input {
- my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
-
- my @copy = @$args;
- foreach (@copy) {
- next unless defined;
- #my @foo = split(//, $_);
- #foreach my $c (@foo) {
- #$c = ord($c);
- #$c = "[$c]";
- #}
- #$_ = join('', @foo);
- s/\e/<ESC>/g;
- s/\r/<CR>/g;
- s/\n/<LF>/g;
- s/\t/<TAB>/g;
- }
- my $raw = join("\t", map { defined $_ ? $_ : '' } @copy);
- $kernel->post('Logger', 'raw', $raw);
-
- return if $heap->{plonk};
- return if $heap->{shutdown};
-
- my $want = 0;
- my $cmd = shift @$args;
-
- if ($heap->{want} and $cmd ne 'CANT') {
- if ($cmd eq $heap->{want}) {
- $want = 1;
- $heap->{want} = undef;
- } else {
- $kernel->yield('oops', 'WANT', [$heap->{want}, $cmd]);
- return;
- }
- }
-
- if ($heap->{user} or $want or $cmd eq 'CANT' or $cmd eq 'HAVER') {
- $heap->{scope} = {};
- $kernel->yield("cmd_$cmd", $args);
- } else {
- $heap->{client} = undef;
- $kernel->yield('cleanup', 'SPEEDY');
- }
-}
-
-sub socket_flush {
- my ($kernel, $heap) = @_[KERNEL, HEAP];
-
- if ($heap->{shutdown}) {
- $kernel->yield('close');
- }
-}
-
-
-sub socket_error {
- my ($kernel, $heap, $operation, $errnum, $errstr) = @_[KERNEL, HEAP,
ARG0..ARG3];
-
- $kernel->post('Logger', 'error',
- "Socket generated $operation error ${errnum}: $errstr");
-
-
- $kernel->yield('close');
- $kernel->yield('cleanup', 'DISCON');
-}
-
-sub on_close {
- my ($kernel, $heap) = @_[KERNEL, HEAP];
-
- $kernel->post('Logger', 'note', "Closing client connection: "
- . fileno($heap->{client}[0]));
- $kernel->post('Logger', 'note', "Socket: $heap->{sock}");
-
- my $sock = delete $heap->{sock};
- #close $sock;
- #untie $sock;
- $heap->{client} = undef;
- #close $sock if $t;
- #untie *$sock;
-}
-
-sub on_unknown_cmd {
- my ($kernel, $heap, $event, $args) = @_[KERNEL, HEAP, ARG0, ARG1];
-
-
- $heap->{client}->put(['FAIL', $event, 'unknown.command']);
-}
-
-sub on_shutdown {
- my ($kernel, $heap, $session, @args) = @_[KERNEL, HEAP, SESSION, ARG0
.. $#_];
- return if $heap->{shutdown};
-
- eval { $heap->{client}->put(['BYE', @args]) };
- $heap->{shutdown} = 1;
- $kernel->yield('cleanup', @args);
-}
-
-sub on_want {
- my ($kernel, $heap, $want, %opts) = @_[KERNEL, HEAP, ARG0 .. $#_];
-
- #$want =~ s/\W//g;
- #$want = uc $want;
-
- $kernel->post('Logger', 'note', "Want: $want");
- unless ($heap->{client}) {
- my ($file, $line) = @_[CALLER_FILE,CALLER_LINE];
- $kernel->post('Logger', 'error', "on_want called with undefined
socket at $file line $line!");
- return;
- }
- $heap->{want} = $want;
-
- foreach my $key (keys %opts) {
- $heap->{want_data}{$key} = $opts{$key};
- }
-
- my @args = $opts{args} ? @{$opts{args}} : ();
- $heap->{client}->put(['WANT', $want, @args]);
-}
-
-sub on_cleanup {
- my ($kernel, $heap, @args) = @_[KERNEL, HEAP, ARG0 .. $#_];
-
- if (!$heap->{cleanup}) {
- $kernel->call('Logger', 'note', 'Shutting down client
session.');
- my $user = $heap->{user};
- my $uid = $heap->{uid};
- $heap->{cleanup} = 1;
- $heap->{plonk} = 1;
- $heap->{user} = undef;
- $heap->{uid} = undef;
-
- $kernel->alarm_remove_all();
- if ($uid) {
- $Registry->remove('user', $uid);
- my @users = ();
- foreach my $chan ($user->list_vals('channel')) {
- $user->remove($chan);
- $chan->remove($user);
- push(@users, $chan->list_ids('user'));
- }
- my %users = map { ($_ => $_) } @users;
- delete $users{$uid};
- my $msg = ['QUIT', $uid, @args];
- $kernel->post('Broadcaster', 'send', [ keys %users ],
$msg);
- }
- if ($user) {
- $user->save if $user->has('_reg');
- }
- } else {
- $kernel->post('Logger', 'error', "Trying to run cleanup more
than once! @args");
- }
-}
-
-sub on_oops {
- my ($kernel, $heap, $err, $data) = @_[KERNEL, HEAP, ARG0 .. $#_];
-
- if (not defined $data) {
- $data = [];
- }
-
- if (not ref $data) {
- $data = [$data];
- }
-
- eval { $heap->{client}->put(['OOPS', $err, @$data]) };
- $kernel->yield('shutdown', 'OOPS');
-}
-sub on_fail {
- my ($kernel, $heap, $cmd, $err, $data) = @_[KERNEL, HEAP, ARG0 .. $#_];
-
- if (not defined $data) {
- $data = [];
- }
-
- if (not ref $data) {
- $data = [$data];
- }
-
- $kernel->post('Logger', 'fail', "failing $heap->{uid} with $cmd -
$err");
- eval { $heap->{client}->put(['FAIL', $cmd, $err, @$data]) };
-}
-
-sub on_accept {
- my ($kernel, $heap, $uid, $user) = @_[KERNEL, HEAP, ARG0, ARG1];
-
- $kernel->alarm_remove(delete $heap->{timer});
-
-
- $Registry->add($user);
- $heap->{user} = $user;
- $heap->{uid} = $uid;
- my $addr = join('.', (split(/\./, $heap->{address}))[0,1,2]) . '.*';
- my $login_time = time;
- $user->set(
- IP => $addr,
- Login => sub {
- format_duration(time - $login_time);
- },
- _last => time,
- Idle => sub {
- my ($u) = @_;
- format_duration(time - $u->get('_last'));
- },
- '.IP' => $heap->{address},
- );
- delete $heap->{want_data};
- $heap->{login} = 1;
- $heap->{client}->put(['ACCEPT', $uid]);
-}
-
-sub on_auth {
- my ($kernel, $heap, $uid, $user) = @_[KERNEL, HEAP, ARG0, ARG1];
-
- $kernel->yield('want', 'AUTH',
- args => ['PASS', 'FAKE'],
- uid => $uid,
- user => $user,
- );
-}
-
-1;
Deleted: trunk/main/server/lib/Haver/Server/POE/Listener.pm
===================================================================
--- trunk/main/server/lib/Haver/Server/POE/Listener.pm 2004-10-25 21:37:30 UTC
(rev 406)
+++ trunk/main/server/lib/Haver/Server/POE/Listener.pm 2004-10-25 21:57:05 UTC
(rev 407)
@@ -1,166 +0,0 @@
-# Haver::Server::POE::Listener,
-# this creates a session that listens for connections,
-# and when something connects, it spawns
-# a Haver::Server::Connection session.
-#
-# Copyright (C) 2003 Dylan William Hardison.
-#
-# This module is free software; you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation; either version 2 of the License, or
-# (at your option) any later version.
-#
-# This module is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this module; if not, write to the Free Software
-# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-
-# TODO, write POD. Soon.
-package Haver::Server::POE::Listener;
-use strict;
-use warnings;
-use Carp;
-use POE qw(
- Wheel::SocketFactory
-);
-
-use Haver::Preprocessor;
-use Haver::Server::POE::Connection;
-
-sub create {
- my $class = shift;
- # ASSERT: (@_ == 1 and ref($_[0]) eq 'HASH') or ((@_ % 2) == 0);
- my $opts = @_ == 1 ? $_[0] : { @_ };
-
- POE::Session->create(
- package_states =>
- [
- $class => [qw(
- _start
- _stop
- socket_birth
- socket_fail
- listen
- shutdown
- )],
- ],
- heap => $opts,
- );
-}
-
-sub _start {
- my ($kernel, $heap) = @_[KERNEL, HEAP];
-
-
- # DEBUG(session): "Listener starts.";
- $heap->{conn} = {};
- $heap->{kids} = {};
- $kernel->alias_set('Listener');
-
- my $ifaces = $heap->{interfaces};
- return unless $ifaces;
-
- foreach my $i (@$ifaces) {
- $kernel->yield('listen', $i);
- }
-
-}
-
-sub _stop {
- my ($kernel, $heap) = @_[KERNEL,HEAP];
- delete $heap->{listener};
- delete $heap->{session};
- #DEBUG(session): "Listener stops.";
-}
-
-sub _child {
- my ($kernel, $heap, $type, $kid) = @_[KERNEL, HEAP, ARG0, ARG1];
-
- if ($type eq 'create' or $type eq 'gain') {
- $heap->{kids}{$kid->ID} = 1;
- } elsif ($type eq 'lose') {
- delete $heap->{kids}{$kid->ID};
- } else {
- die "I don't know how I got here!\n";
- }
-}
-
-sub listen {
- my ($kernel, $heap, $iface) = @_[KERNEL, HEAP, ARG0, ARG1];
-
- my $s = '';
- if ($iface->{ssl}) {
- $s = ' (ssl!)';
- }
-
- $kernel->post('Logger', 'note', "Listening on port $iface->{port}.$s");
-
- my $wheel = POE::Wheel::SocketFactory->new(
- BindPort => $iface->{port},
- Reuse => 1,
- SuccessEvent => 'socket_birth',
- FailureEvent => 'socket_fail',
- );
- $heap->{conn}{$wheel->ID} = {
- wheel => $wheel,
- host => $iface->{host},
- port => $iface->{port},
- ssl => $iface->{ssl},
- };
-}
-
-
-
-sub socket_birth {
- my ($kernel, $heap, $socket, $address, $port, $wid) =
- @_[KERNEL, HEAP, ARG0, ARG1, ARG2, ARG3];
-
-
-
- if ($heap->{conn}{$wid}{ssl}) {
- # DEBUG: "Doing ssl";
- # BEGIN MAKE SSL
- use Symbol qw(gensym);
- use SslServer;
-
- my $old_socket = $socket;
- $socket = gensym();
- tie( *$socket,
- "SslServer",
- $old_socket,
- "./plain-rsa.pem",
- "./plain-cert.pem",
- ) or die $!;
- # CEASE MAKE SSL
- print "Filenos: ", $old_socket, ", ", tied(*$socket), "\n";
- $socket = \*$socket;
- }
-
- Haver::Server::POE::Connection->create(
- sock => $socket,
- address => $address,
- port => $port,
- );
-}
-
-sub socket_fail {
- my ($kernel, $heap, $operation, $errnum, $errstr, $wheel_id) =
@_[KERNEL, HEAP, ARG0..ARG3];
- delete $heap->{conn}{$wheel_id};
- $kernel->post('Logger', 'error', "Operation '$operation' failed:
$errstr ($errnum)");
-}
-
-sub shutdown {
- my ($kernel, $heap) = @_[KERNEL, HEAP];
- $kernel->alias_remove('Listener');
-
- foreach my $kid (keys %{ $heap->{kids} }) {
- $kernel->post($kid, 'shutdown');
- }
- %$heap = ();
-}
-
-1;
Deleted: trunk/main/server/lib/Haver/Server/POE.pm
===================================================================
--- trunk/main/server/lib/Haver/Server/POE.pm 2004-10-25 21:37:30 UTC (rev
406)
+++ trunk/main/server/lib/Haver/Server/POE.pm 2004-10-25 21:57:05 UTC (rev
407)
@@ -1,205 +0,0 @@
-# Haver::Server::POE - Haver server POE component
-#
-# Copyright (C) 2003-2004 Dylan William Hardison
-#
-# This module is free software; you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation; either version 2 of the License, or
-# (at your option) any later version.
-#
-# This module is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this module; if not, write to the Free Software
-# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-package Haver::Server::POE;
-use strict;
-use open ":utf8";
-
-
-use Data::Dumper;
-#use IO::Poll;
-use POE;
-
-use Haver::Preprocessor;
-use Haver::Config;
-
-use Haver::Server::POE::Listener;
-use Haver::Server::POE::Broadcaster;
-use Haver::Server::Registry;
-use Haver::Server::Object::Channel;
-use Haver::Server::Object::User;
-use Haver::Server::Object::POE;
-use Haver::Server::Object::Index;
-use Haver::Util::Logger;
-use Haver::Util::Reload;
-
-
-our $VERSION = 0.07;
-
-my %Default = (
- logger => {
- levels => {},
- },
- listener => {
- interfaces => [
- {
- port => 7070,
- },
- {
- port => 7072,
- ssl => 1,
- },
- ]
- },
- broadcaster => { },
- path => {
- storage => "./store",
- },
- channels => [qw(
- main
- lobby
- attic
- basement
- kitchen
- Creatures
- )],
-);
-
-sub boot {
- my ($this, $file) = @_;
-
- # ASSERT: defined $file;
- # DEBUG(session): "Booting ", __PACKAGE__;
-
- my $cfg = new Haver::Config (
- file => $file,
- default => \%Default,
- );
- $cfg->save;
-
- init Haver::Util::Reload;
- my $reg = instance Haver::Server::Registry;
-
- my @cids = (Haver::Server::Object::Channel->saved_ids, @{
$cfg->{channels} });
- foreach my $cid (@cids) {
- DEBUG: $cid;
- my $chan = Haver::Server::Object::Channel->new(id => $cid);
- $chan->load;
- $reg->add($chan);
- }
-
- if ($cfg->{path}{storage}) {
- $Haver::Server::Object::StorageDir = $cfg->{path}{storage};
- }
-
- $this->create(cfg => $cfg);
-}
-
-sub create {
- my ($class, %opt) = @_;
-
- POE::Session->create(
- package_states => [
- $class => [
- '_start',
- '_stop',
- 'interrupt',
- 'die',
- 'shutdown',
- ]
- ],
- heap => {
- cfg => $opt{cfg}
- },
- );
-}
-
-sub _start {
- my ($kernel, $heap) = @_[KERNEL, HEAP];
-
-
- # DEBUG(session): "Server starts.";
-
- create Haver::Util::Logger $heap->{cfg}{logger};
- create Haver::Server::POE::Listener $heap->{cfg}{listener};
- create Haver::Server::POE::Broadcaster $heap->{cfg}{broadcaster};
-
-
-
- $kernel->sig('INT' => 'intterrupt');
- $kernel->sig('DIE' => 'die');
-}
-sub _stop {
- # DEBUG(session): "Server stops.";
-}
-
-sub die {
- # DEBUG(session): "Got die!";
-}
-
-sub interrupt {
- print "Got INT\n";
- return 0;
-}
-sub shutdown {
-}
-
-
-1;
-__END__
-# Below is stub documentation for your module. You'd better edit it!
-
-=head1 NAME
-
-Haver::Server::POE - Haver chat server.
-
-=head1 SYNOPSIS
-
- use Haver::Server::POE;
-
-=head1 DESCRIPTION
-
- WRITEME
-
-=head2 EXPORT
-
-None by default.
-
-=head1 SEE ALSO
-
-Mention other useful documentation such as the documentation of
-related modules or operating system documentation (such as man pages
-in UNIX), or any relevant external documentation such as RFCs or
-standards.
-
-If you have a mailing list set up for your module, mention it here.
-
-If you have a web site set up for your module, mention it here.
-
-=head1 AUTHOR
-
-Dylan William Hardison, E<lt>[EMAIL PROTECTED]<gt>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (C) 2003-2004 by Dylan William Hardison
-
-This module is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2 of the License, or
-(at your option) any later version.
-
-This module is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with this module; if not, write to the Free Software
-Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-
-=cut
Copied: trunk/main/server/lib/Haver/Server/Plugin (from rev 406,
branches/haver-server-cleanup/lib/Haver/Server/Plugin)
Copied: trunk/main/server/lib/Haver/Server/Plugin.pm (from rev 406,
branches/haver-server-cleanup/lib/Haver/Server/Plugin.pm)
Modified: trunk/main/server/lib/Haver/Server/Registry.pm
===================================================================
--- trunk/main/server/lib/Haver/Server/Registry.pm 2004-10-25 21:37:30 UTC
(rev 406)
+++ trunk/main/server/lib/Haver/Server/Registry.pm 2004-10-25 21:57:05 UTC
(rev 407)
@@ -26,19 +26,20 @@
use POE;
use Carp;
-our $VERSION = 0.04;
-our $RELOAD = 1;
+our $VERSION = 0.04;
+our $RELOAD = 1;
+our @EXPORT_OK = qw( $Registry );
our $Registry;
-our @EXPORT_OK = qw( $Registry );
sub instance {
my $class = shift;
# don't warn about redefining a function.
- do {
+ {
no warnings;
- *instance = \&self;
- };
+ *old_instance = \&instance;
+ *instance = \&self;
+ }
return $Registry = $class->SUPER::new(@_);
}
