Author: bdonlan
Date: 2004-07-04 18:53:47 -0400 (Sun, 04 Jul 2004)
New Revision: 293
Removed:
trunk/main/client/lib/POE/
Modified:
trunk/clients/haver-gtk/bin/haver-gtk.pl
trunk/clients/haver-gtk/lib/Haver/UI/Gtk/Page/Channel.pm
trunk/clients/haver-gtk/lib/Haver/UI/Gtk/Page/Chat.pm
trunk/clients/haver-gtk/lib/Haver/UI/Gtk/Page/Query.pm
trunk/main/client/lib/Haver/Client/POE.pm
Log:
* main/client/lib/Haver/Client/POE.pm - Updated for new S: OF syntax. This
breaks backwards compatibility.
* main/client/lib/POE - Removed wrapper for old clients, as API has changed.
* clients/haver-gtk/bin/haver-gtk.pl,
clients/haver-gtk/lib/Haver/UI/Gtk/Page/Query.pm,
clients/haver-gtk/lib/Haver/UI/Gtk/Page/Chat.pm,
clients/haver-gtk/lib/Haver/UI/Gtk/Page/Channel.pm - Updated to new
Haver::Client::POE API.
Modified: trunk/clients/haver-gtk/bin/haver-gtk.pl
===================================================================
--- trunk/clients/haver-gtk/bin/haver-gtk.pl 2004-07-04 22:05:32 UTC (rev
292)
+++ trunk/clients/haver-gtk/bin/haver-gtk.pl 2004-07-04 22:53:47 UTC (rev
293)
@@ -182,7 +182,7 @@
sub _start {
my ( $kernel, $session, $heap ) = @_[ KERNEL, SESSION, HEAP ];
- Haver::Client::POE->new("haver", version => "haver-gtk/$VERSION");
+ Haver::Client::POE->new("haver", version => "haver-gtk/$VERSION", debug
=> 99);
$kernel->post("haver", "register", "all");
# Create the main window
@@ -393,11 +393,10 @@
}
sub haver_pmsg {
- my ($kernel, $args) = @_[KERNEL,ARG0];
- my $who = $args->[1];
+ my ($kernel, $args, $who) = @_[KERNEL,ARG0,ARG2];
if (!$queries{$who}) {
my $page = get_query_page("$who");
- $page->process_pmsg($args);
+ $page->process_pmsg($args, $who);
}
}
Modified: trunk/clients/haver-gtk/lib/Haver/UI/Gtk/Page/Channel.pm
===================================================================
--- trunk/clients/haver-gtk/lib/Haver/UI/Gtk/Page/Channel.pm 2004-07-04
22:05:32 UTC (rev 292)
+++ trunk/clients/haver-gtk/lib/Haver/UI/Gtk/Page/Channel.pm 2004-07-04
22:53:47 UTC (rev 293)
@@ -120,7 +120,7 @@
$self->print_page("You're not on this channel.");
return;
}
- $poe_kernel->post('haver', 'msg', $type, $self->{channel}, $text);
+ $poe_kernel->post('haver', 'msg', $self->{channel}, $type, $text);
}
sub add_ulist ($@) {
@@ -213,35 +213,33 @@
}
sub _join {
- my ($self, $kernel, $args, $chan) = @_[OBJECT,KERNEL,ARG0,ARG1];
+ my ($self, $kernel, $chan, $who) = @_[OBJECT,KERNEL,ARG1,ARG2];
if ($chan eq $self->{channel}) {
- my $who = $args->[0];
$self->add_ulist($who);
$self->print_page("$who has joined $chan.");
}
}
sub _part {
- my ($self, $kernel, $args, $chan) = @_[OBJECT,KERNEL,ARG0,ARG1];
+ my ($self, $kernel, $chan, $who) = @_[OBJECT,KERNEL,ARG1,ARG2];
if ($chan eq $self->{channel}) {
- my $who = $args->[0];
$self->del_ulist($who);
$self->print_page("$who has left $chan.");
}
}
sub _quit {
- my ($self, $kernel, $args) = @_[OBJECT,KERNEL,ARG0];
- my ($who, $why) = @$args;
+ my ($self, $kernel, $args, $who) = @_[OBJECT,KERNEL,ARG1];
+ my $why = $args->[0];
if ($self->del_ulist($who)) {
$self->print_page("$who has quit: $why.");
}
}
sub _msg {
- my ($self, $kernel, $args, $chan) = @_[OBJECT,KERNEL,ARG0,ARG1];
+ my ($self, $kernel, $args, $chan, $uid) = @_[OBJECT,KERNEL,ARG0..ARG2];
if ($chan eq $self->{channel}) {
- $self->_display_msg($args);
+ $self->_display_msg($uid, $args);
}
}
Modified: trunk/clients/haver-gtk/lib/Haver/UI/Gtk/Page/Chat.pm
===================================================================
--- trunk/clients/haver-gtk/lib/Haver/UI/Gtk/Page/Chat.pm 2004-07-04
22:05:32 UTC (rev 292)
+++ trunk/clients/haver-gtk/lib/Haver/UI/Gtk/Page/Chat.pm 2004-07-04
22:53:47 UTC (rev 293)
@@ -27,9 +27,9 @@
use base 'Haver::UI::Gtk::Page::Text';
sub _display_msg {
- my ($self, $args) = @_;
+ my ($self, $who, $args) = @_;
# This assumes the parent has already checked that we should display it
- my ($type, $who, $text) = @$args;
+ my ($type, $text) = @$args;
my $prefix;
my @lines = split "\n", $text;
if ($type eq q{"}) {
Modified: trunk/clients/haver-gtk/lib/Haver/UI/Gtk/Page/Query.pm
===================================================================
--- trunk/clients/haver-gtk/lib/Haver/UI/Gtk/Page/Query.pm 2004-07-04
22:05:32 UTC (rev 292)
+++ trunk/clients/haver-gtk/lib/Haver/UI/Gtk/Page/Query.pm 2004-07-04
22:53:47 UTC (rev 293)
@@ -77,8 +77,8 @@
sub send_msg ($$$) {
my ($self, $type, $text) = @_;
- $poe_kernel->post('haver', 'pmsg', $type, $self->{UID}, $text);
- $self->_display_msg([$type, $main::globals{UID}, $text]);
+ $poe_kernel->post('haver', 'pmsg', $self->{UID}, $type, $text);
+ $self->_display_msg($main::globals{UID}, [$type, $text]);
}
sub close {
@@ -86,10 +86,9 @@
}
sub process_pmsg {
- my ($self, $args) = @_;
- my ($type, $who, $text) = @$args;
+ my ($self, $args, $who) = @_;
return unless $who eq $self->{UID};
- $self->_display_msg($args);
+ $self->_display_msg($who, $args);
}
sub get_uid {
@@ -99,13 +98,13 @@
### EVENTS
sub _pmsg {
- my ($self, $kernel, $args) = @_[OBJECT,KERNEL,ARG0];
- $self->process_pmsg($args);
+ my ($self, $kernel, $args, $who) = @_[OBJECT,KERNEL,ARG0,ARG2];
+ $self->process_pmsg($args, $who);
}
sub _quit {
- my ($self, $kernel, $args) = @_[OBJECT,KERNEL,ARG0];
- my ($who, $why) = @$args;
+ my ($self, $kernel, $args, $who) = @_[OBJECT,KERNEL,ARG0,ARG1];
+ my $why = $args->[0];
return unless $who eq $self->{UID};
$self->print_page("$who has quit: $why");
}
Modified: trunk/main/client/lib/Haver/Client/POE.pm
===================================================================
--- trunk/main/client/lib/Haver/Client/POE.pm 2004-07-04 22:05:32 UTC (rev
292)
+++ trunk/main/client/lib/Haver/Client/POE.pm 2004-07-04 22:53:47 UTC (rev
293)
@@ -87,6 +87,7 @@
connected
connectfail
+ net_in
input
send_raw
send
@@ -114,6 +115,7 @@
event_PING
event_CLOSE
event_IN
+ event_OF
event_JOIN
event_PART
@@ -207,7 +209,7 @@
sub dispatch_ref {
my ($kernel, $self, $event, $args) = @_[KERNEL,OBJECT,ARG0,ARG1];
- $kernel->yield('_dispatch', $event, $args, $self->{scope});
+ $kernel->yield('_dispatch', $event, $args, $self->{IN}, $self->{OF});
}
sub dispatch {
@@ -288,7 +290,7 @@
Handle => $handle,
Driver => POE::Driver::SysRW->new(),
Filter => POE::Filter::Haver->new(),
- InputEvent => 'input',
+ InputEvent => 'net_in',
FlushedEvent => 'flushed',
ErrorEvent => 'net_error'
);
@@ -311,11 +313,16 @@
### IO
+sub net_in {
+ my ($kernel, $self, $event) = @_[KERNEL,OBJECT,ARG0];
+ _dprint 1, "S: ", join("\t", @$event), "\n";
+ _call('dispatch', 'raw_in', @$event);
+ goto &input;
+}
+
sub input {
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
$self->{scope};
_call("event_$ename", @$event);
}
@@ -453,17 +460,25 @@
}
sub event_JOIN {
- my ($kernel, $self, $uid) = @_[KERNEL,OBJECT,ARG0,ARG1];
- _call('dispatch', ($uid eq '.' ||
- $uid eq $self->{UID}) ? 'joined' : 'join',
- $uid);
+ my ($kernel, $self) = @_[KERNEL,OBJECT,ARG0,ARG1];
+ my $event = 'join';
+ if (!defined($self->{OF}) ||
+ $self->{OF} eq '.' ||
+ $self->{OF} eq $self->{UID}) {
+ $event = 'joined';
+ }
+ _call('dispatch', $event);
}
sub event_PART {
- my ($kernel, $self, $uid) = @_[KERNEL,OBJECT,ARG0,ARG1];
- _call('dispatch', ($uid eq '.' ||
- $uid eq $self->{UID}) ? 'parted' : 'part',
- $uid);
+ my ($kernel, $self) = @_[KERNEL,OBJECT,ARG0,ARG1];
+ my $event = 'part';
+ if (!defined($self->{OF}) ||
+ $self->{OF} eq '.' ||
+ $self->{OF} eq $self->{UID}) {
+ $event = 'parted';
+ }
+ _call('dispatch', $event);
}
my %autorespond = (
@@ -481,17 +496,16 @@
);
sub event_MSG {
- my ($kernel, $self, $uid, $type, @text) = @_[KERNEL,OBJECT,ARG0..$#_];
+ my ($kernel, $self, $type, @text) = @_[KERNEL,OBJECT,ARG0..$#_];
if ($self->{autorespond}->{$type} && exists $autorespond{$type}) {
- $autorespond{$type}->(@_[0..ARG0-1], $uid, @text);
+ $autorespond{$type}->(@_[0..ARG0-1], @text);
+ return if ($self->{supress_auto});
}
- # I can't help but feel that argument order of msg and pmsg
- # should better match reality.... (dylan)
- if ($self->{scope}) {
- _call('dispatch', 'msg', $type, $uid, @text);
+ if ($self->{IN}) {
+ _call('dispatch', 'msg', $type, @text);
} else {
- _call('dispatch', 'pmsg', $type, $uid, @text);
+ _call('dispatch', 'pmsg', $type, @text);
}
}
@@ -540,13 +554,21 @@
}
sub event_IN {
- my ($kernel, $self, $scope, @cmd) = @_[KERNEL,OBJECT,ARG0..$#_];
- my $save = $self->{scope};
- $self->{scope} = $scope;
+ my ($kernel, $self, $cid, @cmd) = @_[KERNEL,OBJECT,ARG0..$#_];
+ my $save = $self->{IN};
+ $self->{IN} = $cid;
_call('input', [EMAIL PROTECTED]);
- $self->{scope} = $save;
+ $self->{IN} = $save;
}
+sub event_OF {
+ my ($kernel, $self, $uid, @cmd) = @_[KERNEL,OBJECT,ARG0..$#_];
+ my $save = $self->{OF};
+ $self->{OF} = $uid;
+ _call('input', [EMAIL PROTECTED]);
+ $self->{OF} = $save;
+}
+
### CLIENT EVENTS
=head2 login($Z<>pass)
@@ -601,25 +623,25 @@
$kernel->yield('send', 'MAKE', $cid);
}
-=head2 B<msg($Z<>type, $Z<>channel, $Z<>text)>
+=head2 B<msg($Z<>channel, $Z<>type, $Z<>text)>
Sends a message with specified type and text to $channel.
=cut
sub msg {
- my ($kernel, $self, $type, $where, $message) =
@_[KERNEL,OBJECT,ARG0..ARG2];
+ my ($kernel, $self, $where, $type, $message) =
@_[KERNEL,OBJECT,ARG0..ARG2];
$kernel->yield('send', 'IN', $where, 'MSG', $type, $message);
}
-=head2 B<pmsg($Z<>type, $Z<>uid, $Z<>text)>
+=head2 B<pmsg($Z<>uid, $Z<>type, $Z<>text)>
Sends a private message with specified type and text to $uid.
=cut
sub pmsg {
- my ($kernel, $self, $type, $where, $message) =
@_[KERNEL,OBJECT,ARG0..ARG2];
+ my ($kernel, $self, $where, $type, $message) =
@_[KERNEL,OBJECT,ARG0..ARG2];
$kernel->yield('send', 'TO', $where, 'MSG', $type, $message);
}
@@ -714,11 +736,12 @@
=head1 EVENTS
-Event callbacks are called with the frist argument being the event arguments
and
-the second argument being the scope set by IN (or undef if not set). Example:
+Event callbacks are called with the frist argument being the event arguments,
+the second argument being the channel set by IN (or undef if not set), and the
+thirs argument being the UID set by OF. Example:
sub haver_connect_fail {
- my ($args, $scope) = @_[ARG0,ARG1];
+ my ($args, $cid, $uid) = @_[ARG0..ARG2];
my ($enum, $estr) = @$args;
# ...
}
@@ -765,33 +788,33 @@
Server is closing connection, and sent $etyp and $estr
-=head2 haver_join($Z<>uid)
+=head2 haver_join(Z<>)
-$uid has joined $scope
+$uid has joined $cid
-=head2 haver_joined($Z<>uid)
+=head2 haver_joined(Z<>)
-The client has joined $scope.
+The client has joined $cid.
-=head2 haver_part($Z<>cid, $Z<>uid)
+=head2 haver_part(Z<>)
$uid has left $cid.
-=head2 haver_parted($Z<>cid)
+=head2 haver_parted(Z<>)
The client has left $Z<>cid.
-=head2 haver_msg($Z<>type, $Z<>cid, $Z<>uid, $Z<>text)
+=head2 haver_msg($Z<>type, @Z<>msg)
-A public message with type $type and contents $text was sent on channel $cid
by user $uid.
+A public message with type $type and contents @msg was sent on channel $cid by
user $uid.
-=head2 haver_pmsg($Z<>type, $z<>uid, $Z<>text)
+=head2 haver_pmsg($Z<>type, @Z<>text)
-A private message with type $type and contents $text was sent to you by user
$uid.
+A private message with type $type and contents @msg was sent to you by user
$uid.
-=head2 haver_users($Z<>where, @Z<>who)
+=head2 haver_users(@Z<>who)
-Channel $where has the users listed in @who in it. Sent in response to message
users().
+Channel $cid has the users listed in @who in it. Sent in response to message
users().
=head2 haver_bye($Z<>why)
@@ -811,7 +834,7 @@
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 haver_quit($Z<>uid, $Z<>why)
+=head2 haver_quit($Z<>why)
UID $uid has disconnected due to the reason in $why.
