Author: bdonlan
Date: 2004-07-20 21:18:15 -0400 (Tue, 20 Jul 2004)
New Revision: 322
Modified:
branches/new-poe-client/main/client/lib/Haver/Client/POE.pm
Log:
* /branches/new-poe-client/client/lib/Haver/Client/POE.pm:
@args is now $args, an arrayref. The old messages use events now.
Also moved some code around.
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:56:10 UTC (rev 321)
+++ branches/new-poe-client/main/client/lib/Haver/Client/POE.pm 2004-07-21
01:18:15 UTC (rev 322)
@@ -153,6 +153,9 @@
die "STUB";
}
+# Internal: _init_event_type($type)
+# Prepares to register events of type $type
+
sub _init_event_type {
my $self = shift;
$self->{handlers}{shift} = {
@@ -161,6 +164,44 @@
}
}
+# Internal: _init_wants
+# Sets up default handlers for wants
+
+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);
+ }
+ $self->register_handler($self, 'want', '_default',
+ sub {
+ my ($handled, $type, $evname, $args) = @_;
+ my $name = $args->[0];
+ $self->send_raw('CANT', $name);
+ $handled = 1;
+ }
+ );
+}
+
+# Internal: _init_smsg
+# Sets up default handlers for server messages
+
+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);
+ }
+}
+
+
+
=head2 setoptions(option => value [, ...])
Sets one or more options to the given value. The following options are
available:
@@ -183,64 +224,6 @@
die "STUB";
}
-### DISPATCH
-
-=head2 register($Z<>event1 => $handler [,...])
-
-Registers code references to handle the given messages. When a matching
-message is dispatched, it will be sent to all handlers registered for that
-event.
-
-=cut
-
-sub register { die "STUB" }
-
-=head2 unregister($Z<>handler [,...])
-
-Unregisters the given handler from receiving messages.
-
-=cut
-
-sub unregister { die "STUB" }
-
-# Internal: dispatch_ref($event, $args)
-# dispatches $event to clients, with $args
-
-sub dispatch_ref {
- die "STUB";
-}
-
-# Internal: dispatch($event, @args)
-# calls dispatch_ref($event, [EMAIL PROTECTED])
-
-sub _dispatch {
- die "STUB";
-}
-
-# Internal: _event_dispatch($type, $event, @args)
-# dispatches event $event
-
-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);
- }
-}
-
### SESSION MANAGEMENT
=head2 B<connect(Host => $Z<>host, [Port => $Z<>port])
@@ -410,41 +393,22 @@
The handler prototype is as follows:
sub handler {
- my ($handled, $type, $event, @args) = @_;
+ my ($handled, $type, $name, $args) = @_;
# ...
- return @args; # To pass the event
$handled = 1; # To handle the event
}
+$type is the type of event, $name is the event name, and $args is an array ref
+of arguments for 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]
+be called. Any changes to the contents of $args will be passed on.
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)
@@ -496,139 +460,162 @@
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);
- }
-}
+# Internal: _event_dispatch($type, $event, @args)
+# dispatches event $event
-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);
+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;
+ $handler->($handled, $type, $event, [EMAIL PROTECTED]);
+ return if $handled;
+ }
+ if ($event ne '_default') {
+ $self->_event_dispatch($type, '_default', $event, @args);
+ }
}
+
+
1;
__END__
-=head1 MESSAGES
+=head2 TYPES OF EVENTS
-Message callbacks are called with the first argument being the message
-name, the second argument being a hash reference containing context
-information sent by the server, and the remaining arguments being
-event-specific arguments.
+=head3 want
- sub connect_fail {
- my ($name, $context, $enum, $estr) = @_;
+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.
+
+=head3 client
+
+Client events have the following prototype:
+
+ sub handler {
+ my ($handled, $type, $event, $_args) = @_;
+ my ($context, @evargs) = @$_args;
# ...
}
-Context fields are as follows:
+$context is a hash reference with the following arguments:
* IN - Indicates the channel set by S: IN
* ON - Indicated the UID set by S: ON
-In the following messages, the arguments given omit $name and $context.
+The contents of @evargs vary depending on the event name, and are documented
+below.
-=head2 connected(Z<>)
+=head4 connected(Z<>)
This event is sent when a connection is established (but before it is logged
in)
-=head2 connect_fail($Z<>enum, $Z<>estr)
+=head4 connect_fail($Z<>enum, $Z<>estr)
The connection could not be established. An error code is in $enum, and the
human-readable
version is in $estr
-=head2 disconnected($Z<>enum, $Z<>estr)
+=head4 disconnected($Z<>enum, $Z<>estr)
The connection has been lost. If the server closed the connection, $enum will
be 0 and $estr will
be meaningless. If the user closed the connection, and the server failed to
respond, $enum will be -1.
Otherwise, $enum will contain an error code, and $estr the human-readable
version.
-=head2 raw_in(@data)
+=head4 raw_in(@data)
The client has received @data from the Haver server. Mostly useful for
debugging.
-=head2 raw_out(@data)
+=head4 raw_out(@data)
The client has sent @data to the Haver server. Mostly useful for debugging.
-=head2 login_request(Z<>)
+=head4 login_request(Z<>)
The server is asking for a UID, and one was not provided in connect().
The authentication will not proceed until login() is invoked with the UID.
-=head2 auth_request(@Z<>methods)
+=head4 auth_request(@Z<>methods)
The server requests authentication using one of the listed methods. The
authentication will not proceed until authenticate() is invoked with a
suitable authentication handler.
-=head2 login(Z<>)
+=head4 login(Z<>)
The client has successfully logged in.
-=head2 close($Z<>etyp, $Z<>estr)
+=head4 close($Z<>etyp, $Z<>estr)
Z<XXX: Describe args>
Server is closing connection, and sent $etyp and $estr
-=head2 join(Z<>)
+=head4 join(Z<>)
$uid has joined $cid
-=head2 joined(Z<>)
+=head4 joined(Z<>)
The client has joined $cid.
-=head2 part(Z<>)
+=head4 part(Z<>)
$uid has left $cid.
-=head2 parted(Z<>)
+=head4 parted(Z<>)
The client has left $Z<>cid.
-=head2 msg($Z<>type, @Z<>msg)
+=head4 msg($Z<>type, @Z<>msg)
A public message with type $type and contents @msg was sent on channel $cid by
user $uid.
-=head2 pmsg($Z<>type, @Z<>text)
+=head4 pmsg($Z<>type, @Z<>text)
A private message with type $type and contents @msg was sent to you by user
$uid.
-=head2 users(@Z<>who)
+=head4 users(@Z<>who)
Channel $cid has the users listed in @who in it. Sent in response to message
users().
-=head2 bye($Z<>why)
+=head4 bye($Z<>why)
The server is disconnecting you due to the reason in $why
-=head2 chans(@Z<>channels)
+=head4 chans(@Z<>channels)
The server has the channels listed in @channels. Sent in response to message
chans()
-=head2 warn($Z<>err, $Z<>short, $Z<>long, @Z<>args)
+=head4 warn($Z<>err, $Z<>short, $Z<>long, @Z<>args)
The server has sent a non-fatal error message with code $err and arguments
@args. $short and $long have the
short and long human-readable forms, respectively.
-=head2 die($Z<>err, $Z<>short, $Z<>long, @Z<>args)
+=head4 die($Z<>err, $Z<>short, $Z<>long, @Z<>args)
The server has sent a fatal error message with code $err and arguments @args.
$short and $long have the
short and long human-readable forms, respectively. The connection will be
closed shortly.
-=head2 quit($Z<>why)
+=head4 quit($Z<>why)
UID $uid has disconnected due to the reason in $why.
