Author: bdonlan
Date: 2004-07-20 20:56:10 -0400 (Tue, 20 Jul 2004)
New Revision: 321
Modified:
branches/new-poe-client/main/client/lib/Haver/Client/POE.pm
Log:
* client/lib/Haver/Client/POE.pm: Changed handler prototype again, hopefully
finished implementation of events.
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-21
00:41:17 UTC (rev 320)
+++ branches/new-poe-client/main/client/lib/Haver/Client/POE.pm 2004-07-21
00:56:10 UTC (rev 321)
@@ -161,120 +161,6 @@
}
}
-=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 [, ...])
Sets one or more options to the given value. The following options are
available:
@@ -305,75 +191,56 @@
message is dispatched, it will be sent to all handlers registered for that
event.
-=head2 unregister($Z<>handler [,...])
-
-Unregisters the given handler from receiving messages.
-
-
-=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
-arguments being the full command received (including WANT $wantname). Each
-handler must return undef if it has handled the want, or a list containing the
-arguments for the next handler. If the last handler does not return undef,
-CANT $wantname will be sent to the server.
-
=cut
-sub register_want { die "STUB" }
+sub register { die "STUB" }
-=head2 unregister_want($subrev [,...])
+=head2 unregister($Z<>handler [,...])
-Unregisters one or more handlers previously registered with register_want().
+Unregisters the given handler from receiving messages.
=cut
-sub unregister_want { die "STUB" }
+sub unregister { die "STUB" }
-=head2 register_smsg($Z<>msgname => sub { ... } [,...])
-
-Registers a handler for a server message. Calling semantics are the same
-as for register_want(), except unhandled messages are simply ignored.
-
-=cut
-
-sub register_smsg { die "STUB" }
-
-=head2 unregister_smsg($subref [,...])
-
-Unregisters one or more handlers previously registered with register_smsg().
-
-=cut
-
# Internal: dispatch_ref($event, $args)
# dispatches $event to clients, with $args
sub dispatch_ref {
- my ($kernel, $self, $event, $args) = @_[KERNEL,OBJECT,ARG0,ARG1];
- $kernel->yield('_dispatch', $event, $args, $self->{IN}, $self->{OF});
+ die "STUB";
}
# Internal: dispatch($event, @args)
# calls dispatch_ref($event, [EMAIL PROTECTED])
-sub dispatch {
- my @pre = @_[0..ARG0];
- my $payload = [EMAIL PROTECTED];
- @_ = (@pre, $payload);
- goto &dispatch_ref;
+sub _dispatch {
+ die "STUB";
}
-# Internal: dispatch_want($want, @args)
-# dispatches handlers for $want
+# Internal: _event_dispatch($type, $event, @args)
+# dispatches event $event
-sub dispatch_want { die "STUB" }
+sub _event_dispatch {
+ my ($self, $type, $event, @args) = @_;
+ my $etype = $self->{handlers}{$type}
+ or croak "Unknown event type $etype";
+ my $ev = $etype->{$event};
+ if (!$ev) {
+ if ($event eq '_default') {
+ return; # Nobody seems to be interested.
+ }
+ $self->_event_dispatch($type, '_default', $event, @args);
+ }
+ for my $handler (@{$ev->{forward}}) {
+ my $handled = 0;
+ @args = $handler->($handled, $type, $event, @args);
+ return if $handled;
+ }
+ if ($event ne '_default') {
+ $self->_event_dispatch($type, '_default', $event, @args);
+ }
+}
-# Internal: dispatch_smsg($smsg, @args)
-# dispatches handlers for $smsg
-
-sub dispatch_smsg { die "STUB" }
-
### SESSION MANAGEMENT
=head2 B<connect(Host => $Z<>host, [Port => $Z<>port])
@@ -533,6 +400,124 @@
return 0;
}
+=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 ($handled, $type, $event, @args) = @_;
+ # ...
+ return @args; # To pass the event
+ $handled = 1; # To handle the event
+ }
+
+If $handled is 0 when the handler returns, the next handler in the chain will
+be called, with the return value of the previous handler being used for its
[EMAIL PROTECTED]
+
+If no handler in a chain handles the event, an event with the same type and
+a name of '_default' will be generated, with the old event name prepended
+to @args. If no handler in the _default chain handles the event, it will be
+discarded.
+
+=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);
+ }
+}
+
1;
__END__
