Author: bdonlan
Date: 2004-06-29 15:17:06 -0400 (Tue, 29 Jun 2004)
New Revision: 280
Modified:
trunk/main/client/lib/Haver/Client/POE.pm
Log:
* main/client/lib/Haver/Client/POE.pm:
- Use POE::Session::EventSource for event broadcasting
- Retrofit for POE::Session::Inheritable
- Use $self instead of $heap
Modified: trunk/main/client/lib/Haver/Client/POE.pm
===================================================================
--- trunk/main/client/lib/Haver/Client/POE.pm 2004-06-29 19:14:28 UTC (rev
279)
+++ trunk/main/client/lib/Haver/Client/POE.pm 2004-06-29 19:17:06 UTC (rev
280)
@@ -53,7 +53,7 @@
use Haver::Formats::Error;
use Carp;
use Digest::SHA1 qw(sha1_base64);
-require Exporter;
+use base 'POE::Session::EventSource';
our $VERSION = 0.06;
@@ -73,93 +73,85 @@
printf STDERR $fmt, @text;
}
+sub _object_states {
+ my ($self, $ehash) = @_;
+ $ehash = {(map {$_ => $_} qw{
+ _start
+ setoptions
-### SETUP
+ dispatch
+ dispatch_ref
-=head2 new($Z<>alias [, option => value ...])
+ connect
+ connected
+ connectfail
-Creates a new Haver::Client::POE session with alias $alias, and optionally
-sets one or more options (see C<setoptions>)
+ input
+ send_raw
+ send
+ _flush_msgq
+ net_error
-=cut
+ destroy
+ disconnect
+ force_close
+ flushed
+ cleanup
-sub new {
- my ($class, $alias, @options) = @_;
- carp "Can't call ->new on a ".(ref $class)." instance" if ref $class;
- #carp "Haver::Client can't be subclassed" if ($class ne __PACKAGE__);
- ## This is stupid restriction.
- POE::Session->create(package_states =>
- [ __PACKAGE__,
- [qw{
- _start
- setoptions
+ login
+ join
+ part
+ msg
+ pmsg
+ users
+ make
+ chans
- register
- unregister
- dispatch
- dispatch_ref
+ event_WANT
+ event_ACCEPT
+ event_REJECT
+ event_PING
+ event_CLOSE
+ event_IN
+
+ event_JOIN
+ event_PART
+ event_MSG
+ event_USERS
+ event_BYE
+ event_QUIT
+ event_CHANS
+ event_WARN
+ event_DIE
- connect
- connected
- connectfail
+ _default
+ }), %$ehash};
+ return $self->SUPER::_object_states($ehash);
+}
- input
- send_raw
- send
- _flush_msgq
- net_error
+### SETUP
- destroy
- disconnect
- force_close
- flushed
- cleanup
- _stop
+=head2 new($Z<>alias [, option => value ...])
- login
- join
- part
- msg
- pmsg
- users
- make
- chans
+Creates a new Haver::Client::POE session with alias $alias, and optionally
+sets one or more options (see C<setoptions>)
- event_WANT
- event_ACCEPT
- event_REJECT
- event_PING
- event_CLOSE
- event_IN
-
- event_JOIN
- event_PART
- event_MSG
- event_USERS
- event_BYE
- event_QUIT
- event_CHANS
- event_WARN
- event_DIE
+=cut
- _default
-
- }]],
- args => [$alias, @options]
- );
+sub new {
+ my ($class, $alias, %options) = @_;
+ my $self = $class->SUPER::new(prefix => delete($options{prefix}) ||
'haver_', args => [$alias, %options]);
return 1;
}
sub _start {
- my ($kernel, $heap, $session, $alias, @args) =
@_[KERNEL,HEAP,SESSION,ARG0..$#_];
- $kernel->alias_set($alias);
- %$heap = (alias => $alias,
- registrations => {},
- scope => undef,
- debug => 0,
- autorespond => { 'PING?' => 1, 'TIME?' => 1 },
- version => "Haver::Client::POE/$VERSION",
- );
+ my ($kernel, $self, $session, $alias, @args) =
@_[KERNEL,OBJECT,SESSION,ARG0..$#_];
+ $self->{alias} = $alias;
+ $kernel->alias_set($self->{alias});
+ $self->{scope} = undef;
+ $self->{debug} = 0;
+ $self->{autorespond} = { 'PING?' => 1, 'TIME?' => 1 };
+ $self->{version} = "Haver::Client::POE/$VERSION";
if (@args) {
_call('setoptions', @args);
}
@@ -186,11 +178,11 @@
=cut
sub setoptions {
- my ($kernel, $heap, %args) = @_[KERNEL,HEAP,ARG0..$#_];
+ my ($kernel, $self, %args) = @_[KERNEL,OBJECT,ARG0..$#_];
my %setters = (
- debug => sub { $heap->{debug} = $_[0]; },
- autorespond => sub { $heap->{autorespond} = map { ($_ => 1) }
@_ },
- version => sub { $heap->{version} = $_[0]; },
+ debug => sub { $self->{debug} = $_[0]; },
+ autorespond => sub { $self->{autorespond} = map { ($_ => 1) }
@_ },
+ version => sub { $self->{version} = $_[0]; },
);
for (keys %args) {
$setters{$_}->($args{$_}) if exists $setters{$_};
@@ -205,39 +197,15 @@
the calling session as 'haver_eventname'. The special event name 'all' may be
specified to register for all
events. A given event will not be sent to any given session more than once.
-=cut
-
-sub register {
- my ($kernel, $heap, $sender, @events) =
@_[KERNEL,HEAP,SENDER,ARG0..$#_];
- for(@events) {
- if (!exists $heap->{registrations}->{$_}->{$sender->ID}) {
- $heap->{registrations}->{$_}->{$sender->ID} =
$heap->{alias} . "##$_";
- $kernel->refcount_increment($sender->ID, $heap->{alias}
. "##$_");
- }
- }
-}
-
=head2 unregister($Z<>event1 [,...])
Unregisters from the specified event. Events registered using 'all' must be
unregistered using 'all'.
=cut
-sub unregister {
- my ($kernel, $heap, $sender, @events) =
@_[KERNEL,HEAP,SENDER,ARG0..$#_];
- for(@events) {
- if (exists $heap->{registrations}->{$_}->{$sender->ID}) {
- delete $heap->{registrations}->{$_}->{$sender->ID};
- $kernel->refcount_decrement($sender->ID, $heap->{alias}
. "##$_");
- }
- }
-}
-
sub dispatch_ref {
- my ($kernel, $heap, $event, $args) = @_[KERNEL,HEAP,ARG0,ARG1];
- my %targets = (map { $_ => 1 }
(keys(%{$heap->{registrations}->{$event}}),
-
keys(%{$heap->{registrations}->{all}})));
- $kernel->post($_, "haver_$event", $args, $heap->{scope}) for keys
%targets;
+ my ($kernel, $self, $event, $args) = @_[KERNEL,OBJECT,ARG0,ARG1];
+ $kernel->yield('_dispatch', $event, $args, $self->{scope});
}
sub dispatch {
@@ -259,23 +227,23 @@
=cut
sub connect {
- my ($kernel, $heap, %args) = @_[KERNEL,HEAP,ARG0..$#_];
+ my ($kernel, $self, %args) = @_[KERNEL,OBJECT,ARG0..$#_];
# XXX: Better error reporting
croak "Missing required parameter Host" unless exists $args{Host};
- if (exists $heap->{conn}) {
- $kernel->yield('disconnect') unless exists
$heap->{pending_connection};
- $heap->{pending_connection} = [%args];
+ if (exists $self->{conn}) {
+ $kernel->yield('disconnect') unless exists
$self->{pending_connection};
+ $self->{pending_connection} = [%args];
return;
}
- $heap->{UID} = $args{UID};
- $heap->{PASS} = $args{Password};
- $heap->{Host} = $args{Host};
- undef $heap->{want};
- $heap->{enabled} = 1; # Set to 0 when graceful shutdown
begins, to block user input
- $heap->{accepted} = 0; # Set to 1 when login is successful
- $heap->{dead} = 0; # Set to 1 when the socket
fails, to drop messages
+ $self->{UID} = $args{UID};
+ $self->{PASS} = $args{Password};
+ $self->{Host} = $args{Host};
+ undef $self->{want};
+ $self->{enabled} = 1; # Set to 0 when graceful shutdown
begins, to block user input
+ $self->{accepted} = 0; # Set to 1 when login is successful
+ $self->{dead} = 0; # Set to 1 when the socket
fails, to drop messages
$args{Port} ||= 7070;
- $heap->{connect_wheel} =
+ $self->{connect_wheel} =
POE::Wheel::SocketFactory->new(
RemoteAddress => $args{Host},
RemotePort => $args{Port},
@@ -292,11 +260,11 @@
=cut
sub disconnect {
- my ($kernel, $heap) = @_[KERNEL, HEAP];
- $heap->{enabled} = 0;
- return if $heap->{closing};
- $heap->{closing} = 1;
- if ($heap->{want}) {
+ my ($kernel, $self) = @_[KERNEL, OBJECT];
+ $self->{enabled} = 0;
+ return if $self->{closing};
+ $self->{closing} = 1;
+ if ($self->{want}) {
$kernel->yield('cleanup');
} else {
$kernel->yield('send', 'QUIT');
@@ -305,15 +273,15 @@
}
sub connected {
- my ($kernel, $heap) = @_[KERNEL, HEAP];
+ my ($kernel, $self) = @_[KERNEL, OBJECT];
my ($handle, $id) = @_[ARG0,ARG3];
- if (!exists $heap->{connect_wheel} ||
- $heap->{connect_wheel}->ID() != $id){
+ if (!exists $self->{connect_wheel} ||
+ $self->{connect_wheel}->ID() != $id){
close $handle;
return;
}
binmode $handle, ':utf8';
- $heap->{conn} =
+ $self->{conn} =
POE::Wheel::ReadWrite->new(
Handle => $handle,
Driver => POE::Driver::SysRW->new(),
@@ -322,19 +290,19 @@
FlushedEvent => 'flushed',
ErrorEvent => 'net_error'
);
- delete $heap->{connect_wheel};
- $heap->{flushed} = 1;
+ delete $self->{connect_wheel};
+ $self->{flushed} = 1;
_call('dispatch', 'connected');
}
sub connectfail {
- my ($kernel, $heap, $enum, $estr) = @_[KERNEL,HEAP,ARG1,ARG2];
+ my ($kernel, $self, $enum, $estr) = @_[KERNEL,OBJECT,ARG1,ARG2];
_call('dispatch', 'connect_fail', $enum, $estr);
- delete $heap->{connect_wheel};
+ delete $self->{connect_wheel};
}
sub net_error {
- my ($kernel, $heap, $enum, $estr) = @_[KERNEL,HEAP,ARG1,ARG2];
+ my ($kernel, $self, $enum, $estr) = @_[KERNEL,OBJECT,ARG1,ARG2];
_call('dispatch', 'disconnected', $enum, $estr);
$kernel->yield('cleanup');
}
@@ -342,10 +310,10 @@
### IO
sub input {
- my ($kernel, $heap, $event) = @_[KERNEL,HEAP,ARG0];
- _dprint 1, "S: ", join("\t", @$event), "\n" unless defined
$heap->{scope};
+ my ($kernel, $self, $event) = @_[KERNEL,OBJECT,ARG0];
+ _dprint 1, "S: ", join("\t", @$event), "\n" unless defined
$self->{scope};
my $ename = shift @$event;
- _call('dispatch', 'raw_in', $ename, @$event) unless defined
$heap->{scope};
+ _call('dispatch', 'raw_in', $ename, @$event) unless defined
$self->{scope};
_call("event_$ename", @$event);
}
@@ -356,44 +324,44 @@
=cut
sub send_raw {
- my ($kernel, $heap, @message) = @_[KERNEL,HEAP,ARG0..$#_];
- return if ($heap->{dead});
- eval { $heap->{conn}->put([EMAIL PROTECTED]); };
+ my ($kernel, $self, @message) = @_[KERNEL,OBJECT,ARG0..$#_];
+ return if ($self->{dead});
+ eval { $self->{conn}->put([EMAIL PROTECTED]); };
if ($@) {
# Ack, lost connection unexpectedly!
# Hopefully we get net_error soon
- $heap->{dead} = 1;
+ $self->{dead} = 1;
return;
}
_dprint 1, "C: ", join("\t", map { defined($_) ? $_ : '~UNDEF~' }
@message), "\n";
_call('dispatch', 'raw_out', @message);
- $heap->{flushed} = 0;
+ $self->{flushed} = 0;
}
sub send {
- my ($kernel, $heap, @message) = @_[KERNEL,HEAP,ARG0..$#_];
+ my ($kernel, $self, @message) = @_[KERNEL,OBJECT,ARG0..$#_];
my $block = 0;
- if (!$heap->{enabled}) {
+ if (!$self->{enabled}) {
$block = 1;
- } elsif ($heap->{accepted} && !$heap->{want}) {
+ } elsif ($self->{accepted} && !$self->{want}) {
$block = 0;
- } elsif (!$heap->{want}) {
+ } elsif (!$self->{want}) {
# Before we get a S: ACCEPT we can't send anything not in
response to a S: WANT
$block = 1;
} elsif ($message[0] eq 'CANT') {
- $block = ($message[1] ne $heap->{want});
- } elsif ($message[0] ne $heap->{want}) {
+ $block = ($message[1] ne $self->{want});
+ } elsif ($message[0] ne $self->{want}) {
$block = 1;
}
if ($block) {
_dprint 1, "(blocked) C: ", join("\t", @message), "\n";
- push @{$heap->{messageq} ||= []}, [EMAIL PROTECTED];
+ push @{$self->{messageq} ||= []}, [EMAIL PROTECTED];
return;
}
- delete $heap->{want};
+ delete $self->{want};
$kernel->yield('send_raw', @message);
@@ -401,12 +369,12 @@
}
sub _flush_msgq {
- my ($kernel, $heap) = @_[KERNEL,HEAP];
- if (exists $heap->{messageq}) {
- for (@{$heap->{messageq}}) {
+ my ($kernel, $self) = @_[KERNEL,OBJECT];
+ if (exists $self->{messageq}) {
+ for (@{$self->{messageq}}) {
$kernel->yield('send', @$_);
}
- delete $heap->{messageq};
+ delete $self->{messageq};
}
}
@@ -417,12 +385,12 @@
# hmm, I reformatted this a bit so it is possible
# to easily edit in vim. :P (dylan)
sub event_WANT {
- my ($kernel, $heap, $wanted, @arg) = @_[KERNEL,HEAP,ARG0,ARG1];
+ my ($kernel, $self, $wanted, @arg) = @_[KERNEL,OBJECT,ARG0,ARG1];
$wanted = uc $wanted;
- $heap->{want} = $wanted;
+ $self->{want} = $wanted;
my %wants = (
IDENT => sub {
- $kernel->yield('send', 'IDENT', $heap->{UID}, 'user',
$heap->{version});
+ $kernel->yield('send', 'IDENT', $self->{UID}, 'user',
$self->{version});
},
AUTH => sub {
# XXX: More extensible AUTH system later too
@@ -433,12 +401,12 @@
return;
}
$kernel->yield('send', 'AUTH', 'pass');
- $heap->{auth} = 'pass';
+ $self->{auth} = 'pass';
},
'AUTH:PASS' => sub {
# XXX: Better support for namespaces
- if($heap->{PASS}) {
- $kernel->yield('login', $heap->{PASS});
+ if($self->{PASS}) {
+ $kernel->yield('login', $self->{PASS});
return;
}
$kernel->yield('dispatch', 'login_request');
@@ -452,73 +420,73 @@
}
sub event_ACCEPT {
- my ($kernel, $heap) = @_[KERNEL,HEAP];
- $heap->{logged_in} = 1;
- $heap->{accepted} = 1;
+ my ($kernel, $self) = @_[KERNEL,OBJECT];
+ $self->{logged_in} = 1;
+ $self->{accepted} = 1;
_call('dispatch', 'login');
$kernel->yield('_flush_msgq');
}
sub event_REJECT {
- my ($kernel, $heap, $uid, $err) = @_[KERNEL,HEAP,ARG0,ARG1];
+ my ($kernel, $self, $uid, $err) = @_[KERNEL,OBJECT,ARG0,ARG1];
my $e = new Haver::Formats::Error;
_call('dispatch', 'login_fail',
$err,
$e->get_short_desc($err),
$e->format( $e->get_long_desc($err), $uid )
);
- delete $heap->{UID};
- delete $heap->{PASS};
- $heap->{want} = 'UID';
+ delete $self->{UID};
+ delete $self->{PASS};
+ $self->{want} = 'UID';
}
sub event_PING {
- my ($kernel, $heap, @junk) = @_[KERNEL,HEAP,ARG0..$#_];
+ my ($kernel, $self, @junk) = @_[KERNEL,OBJECT,ARG0..$#_];
$kernel->yield('send', 'PONG', @junk);
}
sub event_CLOSE {
- my ($kernel, $heap, $etyp, $estr) = @_[KERNEL,HEAP,ARG0,ARG1];
+ my ($kernel, $self, $etyp, $estr) = @_[KERNEL,OBJECT,ARG0,ARG1];
_call('dispatch', 'close', $etyp, $estr);
}
sub event_JOIN {
- my ($kernel, $heap, $uid) = @_[KERNEL,HEAP,ARG0,ARG1];
+ my ($kernel, $self, $uid) = @_[KERNEL,OBJECT,ARG0,ARG1];
_call('dispatch', ($uid eq '.' ||
- $uid eq $heap->{UID}) ? 'joined' : 'join',
+ $uid eq $self->{UID}) ? 'joined' : 'join',
$uid);
}
sub event_PART {
- my ($kernel, $heap, $uid) = @_[KERNEL,HEAP,ARG0,ARG1];
+ my ($kernel, $self, $uid) = @_[KERNEL,OBJECT,ARG0,ARG1];
_call('dispatch', ($uid eq '.' ||
- $uid eq $heap->{UID}) ? 'parted' : 'part',
+ $uid eq $self->{UID}) ? 'parted' : 'part',
$uid);
}
my %autorespond = (
'PING?' => sub {
- my ($kernel, $heap, $who, @junk) = @_[KERNEL,HEAP,ARG0..$#_];
+ my ($kernel, $self, $who, @junk) = @_[KERNEL,OBJECT,ARG0..$#_];
if ([EMAIL PROTECTED]) {
@junk = (''); # This silences a warning elsewhere
}
$kernel->yield('pmsg', 'PING', $who, @junk);
},
'TIME?' => sub {
- my ($kernel, $heap, $who) = @_[KERNEL,HEAP,ARG0];
+ my ($kernel, $self, $who) = @_[KERNEL,OBJECT,ARG0];
$kernel->yield('pmsg', 'TIME', $who, format_datetime(time()));
},
);
sub event_MSG {
- my ($kernel, $heap, $uid, $type, @text) = @_[KERNEL,HEAP,ARG0..$#_];
- if ($heap->{autorespond}->{$type} && exists $autorespond{$type}) {
+ my ($kernel, $self, $uid, $type, @text) = @_[KERNEL,OBJECT,ARG0..$#_];
+ if ($self->{autorespond}->{$type} && exists $autorespond{$type}) {
$autorespond{$type}->(@_[0..ARG0-1], $uid, @text);
}
# I can't help but feel that argument order of msg and pmsg
# should better match reality.... (dylan)
- if ($heap->{scope}) {
+ if ($self->{scope}) {
_call('dispatch', 'msg', $type, $uid, @text);
} else {
_call('dispatch', 'pmsg', $type, $uid, @text);
@@ -527,23 +495,23 @@
}
sub event_USERS {
- my ($kernel, $heap, @who) = @_[KERNEL,HEAP,ARG0..$#_];
+ my ($kernel, $self, @who) = @_[KERNEL,OBJECT,ARG0..$#_];
_call('dispatch_ref', 'users', [EMAIL PROTECTED]);
}
sub event_BYE {
- my ($kernel, $heap, $why) = @_[KERNEL,HEAP,ARG0];
+ my ($kernel, $self, $why) = @_[KERNEL,OBJECT,ARG0];
_call('dispatch', 'bye', $why);
}
sub event_QUIT {
- my ($kernel, $heap, $who, $why) = @_[KERNEL,HEAP,ARG0,ARG1];
+ my ($kernel, $self, $who, $why) = @_[KERNEL,OBJECT,ARG0,ARG1];
_call('dispatch', 'quit', $who, $why);
}
sub event_CHANS {
- my ($kernel, $heap, @channels) = @_[KERNEL,HEAP,ARG0..$#_];
+ my ($kernel, $self, @channels) = @_[KERNEL,OBJECT,ARG0..$#_];
_call('dispatch', 'chans', @channels);
}
@@ -570,11 +538,11 @@
}
sub event_IN {
- my ($kernel, $heap, $scope, @cmd) = @_[KERNEL,HEAP,ARG0..$#_];
- my $save = $heap->{scope};
- $heap->{scope} = $scope;
+ my ($kernel, $self, $scope, @cmd) = @_[KERNEL,OBJECT,ARG0..$#_];
+ my $save = $self->{scope};
+ $self->{scope} = $scope;
_call('input', [EMAIL PROTECTED]);
- $heap->{scope} = $save;
+ $self->{scope} = $save;
}
### CLIENT EVENTS
@@ -587,11 +555,11 @@
=cut
sub login {
- my ($kernel, $heap, $pass) = @_[KERNEL,HEAP,ARG0,ARG1];
- $heap->{PASS} = $pass if $pass;
- if ($heap->{want} eq 'AUTH:PASS') {
- if (defined $heap->{PASS}) {
- $kernel->yield('send', 'AUTH:PASS',
sha1_base64($heap->{UID} . $heap->{PASS} . $heap->{Host}));
+ my ($kernel, $self, $pass) = @_[KERNEL,OBJECT,ARG0,ARG1];
+ $self->{PASS} = $pass if $pass;
+ if ($self->{want} eq 'AUTH:PASS') {
+ if (defined $self->{PASS}) {
+ $kernel->yield('send', 'AUTH:PASS',
sha1_base64($self->{UID} . $self->{PASS} . $self->{Host}));
} else {
$kernel->yield('send', 'CANT', 'AUTH:PASS');
}
@@ -605,7 +573,7 @@
=cut
sub join {
- my ($kernel, $heap, $where) = @_[KERNEL,HEAP,ARG0];
+ my ($kernel, $self, $where) = @_[KERNEL,OBJECT,ARG0];
$kernel->yield('send', 'JOIN', $where);
}
@@ -616,7 +584,7 @@
=cut
sub part {
- my ($kernel, $heap, $where) = @_[KERNEL,HEAP,ARG0];
+ my ($kernel, $self, $where) = @_[KERNEL,OBJECT,ARG0];
$kernel->yield('send', 'PART', $where);
}
@@ -627,7 +595,7 @@
=cut
sub make {
- my ($kernel, $heap, $cid) = @_[KERNEL,HEAP,ARG0];
+ my ($kernel, $self, $cid) = @_[KERNEL,OBJECT,ARG0];
$kernel->yield('send', 'MAKE', $cid);
}
@@ -638,7 +606,7 @@
=cut
sub msg {
- my ($kernel, $heap, $type, $where, $message) =
@_[KERNEL,HEAP,ARG0..ARG2];
+ my ($kernel, $self, $type, $where, $message) =
@_[KERNEL,OBJECT,ARG0..ARG2];
$kernel->yield('send', 'IN', $where, 'MSG', $type, $message);
}
@@ -649,7 +617,7 @@
=cut
sub pmsg {
- my ($kernel, $heap, $type, $where, $message) =
@_[KERNEL,HEAP,ARG0..ARG2];
+ my ($kernel, $self, $type, $where, $message) =
@_[KERNEL,OBJECT,ARG0..ARG2];
$kernel->yield('send', 'TO', $where, 'MSG', $type, $message);
}
@@ -660,7 +628,7 @@
=cut
sub users {
- my ($kernel, $heap, $where) = @_[KERNEL,HEAP,ARG0];
+ my ($kernel, $self, $where) = @_[KERNEL,OBJECT,ARG0];
$kernel->yield('send', 'IN', $where, 'USERS');
}
@@ -678,37 +646,37 @@
### SHUTDOWN
sub force_close {
- my ($kernel, $heap) = @_[KERNEL, HEAP];
- return if $heap->{closing} == 3;
- if ($heap->{closing} == 2 || $heap->{flushed}){ # Flushed or flush
timeout
+ my ($kernel, $self) = @_[KERNEL, OBJECT];
+ return if $self->{closing} == 3;
+ if ($self->{closing} == 2 || $self->{flushed}){ # Flushed or flush
timeout
$kernel->yield('cleanup');
_call('dispatch', 'disconnected', -1, 'Disconnected');
$kernel->delay('force_close');
- $heap->{closing} = 3;
+ $self->{closing} = 3;
return;
}
- $heap->{closing} = 2;
+ $self->{closing} = 2;
$kernel->delay('force_close', 5);
}
sub flushed {
- my ($kernel, $heap) = @_[KERNEL, HEAP];
- if (defined $heap->{closing} && $heap->{closing} == 2) {
+ my ($kernel, $self) = @_[KERNEL, OBJECT];
+ if (defined $self->{closing} && $self->{closing} == 2) {
$kernel->yield('force_close');
}
- $heap->{flushed} = 1;
+ $self->{flushed} = 1;
}
sub cleanup {
- my ($kernel, $heap) = @_[KERNEL, HEAP];
- delete $heap->{$_} for qw(conn flushed closing UID PASS want messageq
enabled accepted dead);
+ my ($kernel, $self) = @_[KERNEL, OBJECT];
+ delete $self->{$_} for qw(conn flushed closing UID PASS want messageq
enabled accepted dead);
$kernel->delay('force_close');
- if ($heap->{destroy_pending}) {
+ if ($self->{destroy_pending}) {
$kernel->yield('destroy');
- } elsif (exists $heap->{pending_connection}) {
- $kernel->yield('connect', @{$heap->{pending_connection}});
- delete $heap->{pending_connection};
+ } elsif (exists $self->{pending_connection}) {
+ $kernel->yield('connect', @{$self->{pending_connection}});
+ delete $self->{pending_connection};
}
}
@@ -721,29 +689,18 @@
=cut
sub destroy {
- my ($kernel, $heap) = @_[KERNEL, HEAP];
+ my ($kernel, $self) = @_[KERNEL, OBJECT];
_dprint 1, "Destroying.\n";
- if (exists $heap->{conn}){
- $heap->{destroy_pending} = 1;
+ if (exists $self->{conn}){
+ $self->{destroy_pending} = 1;
$kernel->yield('disconnect');
- return;
+ return;
}
- $kernel->alias_remove($heap->{alias});
+ $kernel->alias_remove($self->{alias});
}
-sub _stop {
- my ($kernel, $heap) = @_[KERNEL, HEAP];
- foreach my $evt (keys %{$heap->{registrations}}) {
- my $ehash = $heap->{registrations}->{$evt};
- foreach my $session (keys %$ehash) {
- my $refcount = $ehash->{$session};
- $kernel->refcount_decrement($session, $refcount);
- }
- }
-}
-
sub _default {
- my ( $kernel, $state, $event, $args, $heap ) = @_[ KERNEL, STATE, ARG0,
ARG1, HEAP ];
+ my ( $kernel, $state, $event, $args, $self ) = @_[ KERNEL, STATE, ARG0,
ARG1, OBJECT ];
$args ||= []; # Prevents uninitialized-value warnings.
DEBUG: "default: $state = $event. Args:\n";
DUMP: $args;
