Author: bdonlan
Date: 2004-07-20 20:41:17 -0400 (Tue, 20 Jul 2004)
New Revision: 320
Modified:
branches/new-poe-client/main/client/lib/Haver/Client/POE.pm
Log:
* main/client/lib/Haver/Client/POE.pm: Redid event APIs, partial implementation.
Modified: branches/new-poe-client/main/client/lib/Haver/Client/POE.pm
===================================================================
--- branches/new-poe-client/main/client/lib/Haver/Client/POE.pm 2004-07-19
01:01:57 UTC (rev 319)
+++ branches/new-poe-client/main/client/lib/Haver/Client/POE.pm 2004-07-21
00:41:17 UTC (rev 320)
@@ -21,19 +21,19 @@
# self => {
# [persistent data]
# options => { key => value },
-# wants => {
-# want => {
-# hhash => {
-# stringified $handler => $index_of_handler
-# },
-# harray => [
-# $handler
-# ],
-# },
-# }, # wants =>
# handlers => {
-# [same as wants]
-# },
+# type => {
+# event name => {
+# reverse => {
+# stringified $subref => index
+# },
+# forward => [
+# $subref,
+# ...
+# ]
+# } # event name =>
+# } # type =>
+# }, # handlers =>
# connection => {
# [connection data]
# UID => $uid,
@@ -120,27 +120,159 @@
$ehash = {qw{
_start _start
_default _default
- }), %$ehash};
+ }, %$ehash};
return $self->SUPER::_object_states($ehash);
}
### SETUP
-=head2 new($Z<>alias [, option => value ...])
+=head2 new([option => value ...])
-Creates a new Haver::Client::POE session with alias $alias, and optionally
-sets one or more options (see C<setoptions>)
+Creates a new Haver::Client::POE session, and optionally sets one or more
+options (see C<setoptions>)
=cut
sub new {
- die "STUB";
+ my ($class, %options) = @_;
+ $class = ref $class || $class;
+
+ my $self = {
+ options => {
+ version => "Haver::Client::POE/$VERSION",
+ },
+ handlers => {
+ },
+ };
+ bless $self, $class;
+ $self->_init_wants;
+ $self->_init_msgs;
}
sub _start {
die "STUB";
}
+sub _init_event_type {
+ my $self = shift;
+ $self->{handlers}{shift} = {
+ hhash => {},
+ byname => {},
+ }
+}
+
+=head1 HANDLERS
+
+Handlers are subroutines called to handle some event from the server. Any
+number of handlers may be registered to an event, and they will be called
+in reverse order of registration until one indicates that it has handled the
+event.
+
+The handler prototype is as follows:
+
+ sub handler {
+ my ($type, $event, @args) = @_;
+ # ...
+ return @args; # To pass the event
+ return undef; # To handle the event
+ }
+
+If the handler returns a list, it is used for the @args of the next handler in
+the chain. If it returns undef, the chain is terminated.
+
+=head2 TYPES OF EVENTS
+
+=head3 want
+
+Events of type 'want' are sent when the server sends a S: WANT message. The
+first argument of the S: WANT is the event name, the rest are used as
+arguments for the first handler.
+
+The default action, should all handlers pass the event, is to send a
+C: CANT $event to the server.
+
+=head3 smsg
+
+Events of type 'smsg' are sent whenever a command is received from the server.
+The command name is used for the event name, and the arguments are passed for
+the first handler's @args.
+
+Note that adding a handler with $type of smsg, and $event of 'WANT' may
+prevent handlers of $type want from being called.
+
+=head2 METHODS FOR EVENT MANIPULATION
+
+=head3 register_handler($Z<>type, $Z<>event, $Z<>handler)
+
+Register a handler $handler for an event of type $type, name $event. If such
+a handler already exists, does nothing.
+
+=cut
+
+sub register_handler {
+ my ($self, $type, $event, $handler) = @_;
+ my $htype = $self->{handlers}{$type}
+ or croak "Unknown event type $type";
+ my $hevent = $htype->{$event};
+ if (!$hevent) {
+ $hevent = $htype->{$event} = {
+ forward => {},
+ reverse => {},
+ };
+ }
+ return if (exists $hevent->{reverse}{$handler});
+ my $index = @{$hevent->{forward}};
+ push @{$hevent->{forward}}, $handler;
+ $hevent->{reverse}{$handler} = $index;
+}
+
+=head3 unregister_handler($Z<>type, $Z<>event, $Z<>handler)
+
+Unregisters a handler previously registered by passing the same arguments
+to register_handler. If such a handler does not exist, does nothing.
+
+=cut
+
+sub unregister_handler {
+ my ($self, $type, $event, $handler) = @_;
+ my $htype = $self->{handlers}{$type}
+ or croak "Unknown event type $type";
+ my $hevent = $self->{handlers}{$type}{$event} or return;
+ my $index = $hevent->{reverse}{$handler} or return;
+ # Remove the item
+ splice @{$hevent->{forward}}, $index, 1;
+ # and renumber the ones afterward
+ my $len = @{$hevent->{forward}};
+ for (; $index < $len; $index++) {
+ my $handler = $hevent->{forward}[$index];
+ $hevent->{reverse}{$handler} = $index;
+ }
+ # and delete the reverse mapping
+ delete $hevent->{reverse}{$handler};
+}
+
+sub _init_wants {
+ my $self = shift;
+ my %wants = {
+ # TODO ...
+ };
+ $self->_init_event_type('wants');
+ for (my ($event, $handler) = each %wants) {
+ $self->register_handler($self, 'want', $event, $handler);
+ }
+}
+
+sub _init_smsg {
+ my $self = shift;
+ my %smsgs = {
+ # TODO ...
+ };
+ $self->_init_event_type('smsg');
+ for (my ($event, $handler) = each %smsgs) {
+ $self->register_handler($self, 'smsg', $event, $handler);
+ }
+}
+
=head1 MESSAGES
=head2 setoptions(option => value [, ...])
@@ -178,7 +310,7 @@
Unregisters the given handler from receiving messages.
-=head2 register_want($Z<>wantname => sub { ... } [,...])
+=head2 register_handler($Z<>wantname => sub { ... } [,...])
Registers handlers to be called if the given command is requested from the
server. The most recently registered handler is called first, with its
