Author: dylan
Date: 2005-07-18 01:33:36 -0400 (Mon, 18 Jul 2005)
New Revision: 871
Removed:
trunk/perl/client/lib/Haver/Client/POE.pm
Modified:
trunk/
trunk/perl/client/lib/Haver/Client.pm
Log:
[EMAIL PROTECTED]: dylan | 2005-07-18 01:00:07 -0400
Updated Haver::Client::POE to use Haver::Session.
[EMAIL PROTECTED]: dylan | 2005-07-18 01:32:01 -0400
Documentation and code changes.
The name of the module has changed, and also it uses create() rather than
spawn()
now. The documentation is weaker, but I'll going to write it as I use it (as I
read the
source, actually). Other than the module name and the spawn -> create() thing,
nothing
else should break.
Please note that create() takes named arguments.
Property changes on: trunk
___________________________________________________________________
Name: svk:merge
- 1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/havercurs-objc:43089
1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/local/trunk:11166
1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/local/trunk-merge-10131:11178
27e50396-46e3-0310-8b22-ae223a1f35ce:/local:212
e9404bb1-7af0-0310-a7ff-e22194cd388b:/haver/local:1272
edfcd8bd-4ce7-0310-a97e-bb1efd40edf3:/local:238
+ 1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/havercurs-objc:43089
1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/local/trunk:11166
1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/local/trunk-merge-10131:11178
27e50396-46e3-0310-8b22-ae223a1f35ce:/local:212
e9404bb1-7af0-0310-a7ff-e22194cd388b:/haver/local:1277
edfcd8bd-4ce7-0310-a97e-bb1efd40edf3:/local:238
Deleted: trunk/perl/client/lib/Haver/Client/POE.pm
===================================================================
--- trunk/perl/client/lib/Haver/Client/POE.pm 2005-07-18 04:42:57 UTC (rev
870)
+++ trunk/perl/client/lib/Haver/Client/POE.pm 2005-07-18 05:33:36 UTC (rev
871)
@@ -1,625 +0,0 @@
-# vim: set ft=perl ts=4 sw=4:
-# Haver::Client::POE - POE component haver client.
-#
-# Copyright (C) 2004 Bryan Donlan, Dylan William Hardison.
-#
-# This module is free software; you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation; either version 2 of the License, or
-# (at your option) any later version.
-#
-# This module is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this module; if not, write to the Free Software
-# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-
-# heap fields:
-# heap => {
-# name => user name,
-# reg => {
-# event name => { session ID => 1 }
-# },
-# wheel => active wheel,
-# state => see below constants,
-# # for connect events sent while still shutting down
-# pending => { Host => host, Port => port, Name => name ] | nonexistent
-# }
-
-=head1 NAME
-
-Haver::Client::POE - POE Component for Haver clients.
-
-=head1 SYNOPSIS
-
- use Haver::Client::POE;
-
- my $conn = new Haver::Client::POE('haver');
- $conn->register(connected => \&on_connect);
- $conn->connect( Host => 'example.com',
- Port => 7070,
- Name => 'example');
-
-=head1 DESCRIPTION
-
-Haver::Client::POE is a POE component for writing Haver clients.
-Generally one will create a session with new(), register for all events with
-register(), and then send commands and receive events from the session.
-
-=head1 METHODS
-
-=cut
-
-package Haver::Client::POE;
-use strict;
-use warnings;
-use Carp;
-use Data::Dumper;
-use Regexp::Shellish;
-
-use constant {
- S_IDLE => 0, # not connected, not connecting
- S_CONN => 1, # establishing socket connection
- S_INIT => 2, # C: HAVER sent
- S_LOGIN => 3, # S: HAVER recieved, C: IDENT sent
- S_ONLINE => 4, # S: HELLO received
- S_DYING => 5, # C: BYE sent, socket still open
-};
-
-use POE qw(Wheel::ReadWrite
- Wheel::SocketFactory);
-
-use Haver::Protocol::Filter;
-
-our $VERSION = 0.06;
-
-our %failures = (
- 'invalid.name' => "The server rejected the name %1%.",
- 'reserved.name' => "The name %1% is reserved for internal use by the
server.",
- 'exists.user' => "The name %1% is in use.",
- 'unknown.user' => "The user %1% is not online.",
- 'unknown.channel' => "The channel %1% does not exist.",
- 'unknown.namespace' => "The namespace %1% does not exist. This is probably
an application bug.",
- 'invalid.type' => "The type of a message was invalid. This is almost
certainly an application error.",
- 'already.joined' => "Tried to join %1% when already in it.",
- 'already.parted' => "Tried to leave %1% when not in it.",
-);
-
-sub _format {
- my @args = @_;
- shift @args; # S: FAIL
- my $code = $args[0];
-
- if (!$failures{$code}) {
- return "Unknown error: " . join(' ', @args);
- }
-
- my $msg = $failures{$code};
- $msg = s{%(\d+)%}{$args[$1] || "MISSING ARGUMENT $1"}eg;
- return $msg;
-}
-
-sub _call {
- return POE::Kernel->call(POE::Kernel->get_active_session(), @_);
-}
-
-sub _dispatch {
- _call('__dispatch', @_);
-}
-
-sub _dprint {
- my ($level, @text) = @_;
- return unless POE::Kernel->get_active_session()->get_heap()->{debug} >=
$level;
- print STDERR @text;
-}
-
-sub _dprintf {
- my ($level, $fmt, @text) = @_;
- return unless POE::Kernel->get_active_session()->get_heap()->{debug} >=
$level;
- printf STDERR $fmt, @text;
-}
-
-### SETUP
-
-=head2 spawn($alias [, $Z<>resolver])
-
-Creates a new Haver::Client::POE session, and sets its alias to the given
-value. Optionally, $resolver may be passed in, which should be an alias for
-a session of POE::Component::Client::DNS, which will then be used for
-asynchronous DNS lookups.
-
-=cut
-
-sub spawn {
- my ($pkg, $alias, $resolver) = @_;
-
- my $heap = {
- reg => {},
- state => S_IDLE,
- alias => $alias,
- resolver => $resolver
- };
-
- POE::Session->create(
- package_states => [
- $pkg => [
- qw{
- _start
- _default
- connect
- _conn_fail
- _conn_ok
- _input
- disconnect
- send_raw
- send
- join
- part
- public
- private
- list
- destroy
- _ev_HAVER
- _ev_HELLO
- _ev_JOIN
- _ev_PART
- _ev_IN
- _ev_FROM
- _ev_PING
- _ev_BYE
- _ev_FAIL
- __dispatch
- register
- unregister
- _cleanup
- _err
- _force_down
- _dns_resp
- _do_connect
- }
- ]],
- heap => $heap,
- args => [$alias],
- );
-}
-
-sub _start {
- my ($kernel, $alias) = @_[KERNEL,ARG0];
- $kernel->alias_set($alias);
-}
-
-### SESSION MANAGEMENT
-
-=head2 connect(Host => $Z<>host, Name => $Z<>name, [Port => $Z<>port])
-
-Connects to the haver server. The Host option is mandatory, all others are
optional.
-If it is already connected, it will disconnect, then connect with the new
parameters.
-
-=cut
-
-sub connect {
- my ($kernel, $heap, %opts) = @_[KERNEL,HEAP,ARG0..$#_];
- $opts{Port} ||= 7575;
- # TODO: handle arg errors
- if ($heap->{state} == S_DYING) {
- $heap->{pending} = \%opts;
- return;
- } elsif ($heap->{state} != S_IDLE) {
- _call('disconnect');
- $heap->{pending} = \%opts;
- } else {
- $heap->{state} = S_CONN;
- $heap->{name} = $opts{Name};
- $heap->{port} = $opts{Port};
- if (!$heap->{resolver}) {
- _call('_do_connect', $opts{Host});
- } else {
- my $resp = $heap->{resolver}->resolve(
- host => $opts{Host},
- context => {},
- event => '_dns_resp',
- );
- if ($resp) {
- _call('_dns_resp', $resp);
- }
- }
- }
-}
-
-sub _do_connect {
- my ($heap, $addr) = @_[HEAP,ARG0];
- my $port = delete $heap->{port};
- if ($heap->{state} == S_DYING) {
- _call('_cleanup');
- return;
- }
- $heap->{wheel} = POE::Wheel::SocketFactory->new(
- RemoteAddress => $addr,
- RemotePort => $port,
- SuccessEvent => '_conn_ok',
- FailureEvent => '_conn_fail',
- );
-}
-
-BEGIN {
- eval {
- require List::Util;
- List::Util->import(qw(shuffle));
- };
- eval {
- shuffle();
- };
- if ($@) {
- *shuffle = sub { return @_; }
- }
-}
-
-sub _dns_resp {
- my ($heap, $packet) = @_[HEAP,ARG0];
- if ($packet->{response}) {
- my $resp = $packet->{response};
- my @answer = shuffle($resp->answer);
- foreach my $record (@answer) {
- if ($record->type eq 'A') {
- # XXX: ipv6 support
- $poe_kernel->yield('_do_connect', $record->address);
- return;
- }
- }
- # dns fail
- _dispatch('connect_fail', 'dns');
- _call('_cleanup');
- } else {
- _dispatch('connect_fail', 'dns', $packet->{error});
- }
-}
-
-sub _conn_fail {
- my $heap = $_[HEAP];
- _dispatch('connect_fail', @_[ARG0..ARG2]);
- _call('_cleanup');
-}
-
-sub _conn_ok {
- my ($kernel, $heap, $sock) = @_[KERNEL,HEAP,ARG0];
- if ($heap->{state} == S_DYING) {
- _call('_cleanup');
- return;
- }
- _dispatch('connected');
- $heap->{state} = S_INIT;
- $heap->{wheel} = new POE::Wheel::ReadWrite(
- Handle => $sock,
- Filter => new Haver::Protocol::Filter,
- InputEvent => '_input',
- ErrorEvent => '_err',
- );
- $heap->{wheel}->put( ['HAVER', '$pkg/$version'] );
- # XXX: timeout
-}
-
-sub _input {
- my ($kernel, $heap, $arg) = @_[KERNEL,HEAP,ARG0];
- return if (ref $arg ne 'ARRAY' || @$arg == 0);
- print STDERR "S: ", join "\t", @$arg;
- print STDERR "\n";
- _dispatch('raw_in', @$arg);
- my $cmd = $arg->[0];
- $kernel->yield("_ev_$cmd", @$arg);
-}
-
-sub _err {
- _dispatch('disconnected', @_[ARG0..ARG2]);
- _call('_cleanup');
-}
-
-=head2 disconnect(Z<>)
-
-Disconnects from the Haver server. If not already connected, does nothing.
This event
-may not complete immediately.
-
-=cut
-
-sub disconnect {
- my $heap = $_[HEAP];
- _call('send_raw', 'BYE');
- $heap->{state} = S_DYING;
- $poe_kernel->delay('_force_down', 5);
-}
-
-sub _force_down {
- my $heap = $_[HEAP];
- $heap->{state} = S_IDLE;
- _call('_cleanup');
-}
-
-sub _cleanup {
- my $heap = $_[HEAP];
- $poe_kernel->delay('_force_down');
- if ($heap->{pending}) {
- my @opts = %{delete $heap->{pending}};
- $poe_kernel->yield('connect', @opts);
- }
- delete $heap->{wheel};
- delete $heap->{name};
- $heap->{state} = S_IDLE;
-}
-
-=head2 send_raw(@args)
-
-Sends the arguments specified to the haver server. No checking is performed,
though escaping will be done.
-
-=cut
-
-sub send_raw {
- my ($heap, @args) = @_[HEAP,ARG0..$#_];
- if ($heap->{state} == S_IDLE || $heap->{state} == S_CONN ||
- $heap->{state} == S_DYING) {
- return;
- }
- print STDERR "C: ", join("\t", @args), "\n";
- $heap->{wheel}->put([EMAIL PROTECTED]);
-}
-
-=head2 send(@args)
-
-Sends the arguments specified to the Haver server. If authentication is not
-yet completed, it will be queued until authentication is completed.
-
-=cut
-
-sub send {
- my ($kernel, @args) = @_[KERNEL,ARG0..$#_];
- _call('send_raw', @args);
-}
-
-### CLIENT EVENTS
-
-=head2 join($Z<>channel)
-
-Attempts to join $channel
-
-=cut
-
-sub join {
- my $channel = $_[ARG0];
- _call('send', 'JOIN', $channel);
-}
-
-=head2 part($Z<>channel)
-
-Parts $Z<>channel
-
-=cut
-
-sub part {
- my $channel = $_[ARG0];
- _call('send', 'PART', $channel);
-}
-
-=head2 in($Z<>channel, $Z<>type, @Z<>args)
-
-Sends a message with specified type and arguments to $channel.
-
-=cut
-
-sub public {
- my ($kernel, $heap, $c, $t, @a) = @_[KERNEL,HEAP,ARG0..$#_];
- _call('send', 'IN', $c, $t, @a);
-}
-
-=head2 to($Z<>uid, $Z<>type, @Z<>args)
-
-Sends a private message with specified type and arguments to $uid.
-
-=cut
-
-sub private {
- my ($kernel, $heap, $d, $t, @a) = @_[KERNEL,HEAP,ARG0..$#_];
- _call('send', 'TO', $d, $t, @a);
-}
-
-=head2 list($Z<>channel [, $Z<>type])
-
-Ask the server which entities of $type are in $channel. If $type is not
-given, it defaults to 'user'.
-
-=cut
-
-sub list {
- my ($chan, $type) = @_[ARG0, ARG1];
- $type = defined $type || 'user';
- _call('send', 'LIST', $chan, $type);
-}
-
-=head2 destroy(Z<>)
-
-Disconnects from the Haver server, and destroys the session.
-
-=cut
-
-sub destroy {
- my ($kernel, $heap) = @_[KERNEL,HEAP];
- _dispatch('destroyed');
- delete $heap->{pending};
- my $reg = $heap->{reg};
- foreach my $ehash (values %$reg) {
- foreach my $id (keys %$ehash) {
- $poe_kernel->refcount_decrement($id, $ehash->{$id});
- }
- }
- $heap->{reg} = {};
- _call('disconnect');
- $kernel->alias_remove($heap->{alias});
-}
-
-## server-response stuff
-
-sub _ev_HAVER {
- my ($kernel, $heap) = @_[KERNEL,HEAP];
- return if ($heap->{state} != S_INIT); # should never happen, unless the
- # server is non-compliant
- $kernel->yield('send_raw', 'IDENT', $heap->{name});
- $heap->{state} = S_LOGIN;
-}
-
-sub _ev_HELLO {
- my $heap = $_[HEAP];
- $heap->{state} = S_ONLINE;
- _dispatch('ready');
-}
-
-sub _ev_JOIN {
- my ($heap, $chan, $name) = @_[HEAP,ARG1,ARG2];
- if ($name eq $heap->{name}) {
- _dispatch('ijoined', $chan);
- } else {
- _dispatch('join', $chan, $name);
- }
-}
-
-sub _ev_PART {
- my ($heap, $chan, $name) = @_[HEAP,ARG1,ARG2];
- if ($name eq $heap->{name}) {
- _dispatch('iparted', $chan);
- } else {
- _dispatch('part', $chan, $name);
- }
-}
-
-sub _ev_LIST {
- my ($heap, $chan, $ns, @things) = @_[HEAP,ARG1..$#_];
- return unless defined $ns;
- _dispatch('list', $chan, $ns, @things);
-}
-
-sub _ev_IN {
- _dispatch('public', @_[ARG1..$#_]);
-}
-
-sub _ev_FROM {
- _dispatch('private', @_[ARG1..$#_]);
-}
-
-sub _ev_PING {
- _call('send_raw', 'PONG', @_[ARG1..$#_]);
-}
-
-sub _ev_BYE {
- my ($type, $detail) = @_[ARG2,ARG3];
- _dispatch('bye', $detail);
- _call('_cleanup');
-}
-
-sub _ev_FAIL {
- my $msg = _format(@_[ARG0..$#_]);
- _dispatch('fail', $msg, @_[ARG0..$#_]);
- my $code = $_[ARG1];
- $code =~ tr/./_/;
- _dispatch("fail_$code", $msg, @_[ARG0..$#_]);
-}
-
-sub _default {
- my ( $kernel, $state, $event, $args, $self ) = @_[ KERNEL, STATE, ARG0,
ARG1, OBJECT ];
- $args ||= []; # Prevents uninitialized-value warnings.
- # DEBUG: "default: $state = $event. Args:\n", Dumper $args;
- return 0;
-}
-
-=head1 EVENTS
-
-docme
-
-=cut
-
-=head2 EVENT MANIPULATION FUNCTIONS
-
-=head3 register(@Z<>events)
-
-=cut
-
-sub register {
- my ($kernel, $heap, $session, @events) =
@_[KERNEL,HEAP,SENDER,ARG0..$#_];
- my $reg = $heap->{reg};
- my $id = $session->ID;
- foreach my $event (@events) {
- $event = uc $event;
- next if exists $reg->{$event}{$id};
- my $tag = '1' . $reg->{$event} . '\0' . $id . '\0' . rand;
- $reg->{$event}{$id} = $tag;
- $kernel->refcount_increment( $id, $tag );
- }
-}
-
-=head3 unregister(@Z<>events)
-
-
-=cut
-
-sub unregister {
- my ($kernel, $heap, $session, @events) =
@_[KERNEL,HEAP,SENDER,ARG0..$#_];
- my $reg = $heap->{reg};
- my $id = $session->ID;
- foreach my $event (@events) {
- $event = uc $event;
- my $tag;
- next unless $tag = delete $reg->{$event}{$id};
- $kernel->refcount_decrement( $id, $tag );
- }
-}
-
-
-sub __dispatch {
- my ($kernel, $heap, $evname, @args) = @_[KERNEL,HEAP,ARG0..$#_];
- $evname = uc $evname;
- my $reg = $heap->{reg};
- $reg->{$evname} ||= {};
- $reg->{ALL} ||= {};
- my %targ = (%{$reg->{$evname}}, %{$reg->{ALL}});
- my @ids = keys %targ;
-
- unshift @args, [$heap->{alias}];
-
- foreach my $id (@ids) {
- $kernel->post($id, "haver_$evname", @args);
- }
-}
-
-=head2 TYPES OF EVENTS
-
-docme
-
-=head1 SEE ALSO
-
-L<http://haverdev.org>
-
-=head1 AUTHOR
-
-Bryan Donlan, E<lt>[EMAIL PROTECTED]<gt> and
-Dylan William Hardison, E<lt>[EMAIL PROTECTED]<gt>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (C) 2004 by Bryan Donlan, Dylan William Hardison
-
-This library is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2 of the License, or
-(at your option) any later version.
-
-This library is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with this module; if not, write to the Free Software
-Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-
-
-=cut
-
-1;
Modified: trunk/perl/client/lib/Haver/Client.pm
===================================================================
--- trunk/perl/client/lib/Haver/Client.pm 2005-07-18 04:42:57 UTC (rev
870)
+++ trunk/perl/client/lib/Haver/Client.pm 2005-07-18 05:33:36 UTC (rev
871)
@@ -1,6 +1,7 @@
-# Haver::Client - POE Component for Haver clients.
+# vim: set ft=perl ts=4 sw=4:
+# Haver::Client::POE - POE component haver client.
#
-# Copyright (C) 2004 Bryan Donlan, Dylan William Hardison.
+# Copyright (C) 2004, 2005 Bryan Donlan, Dylan William Hardison.
#
# This module is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
@@ -15,47 +16,501 @@
# You should have received a copy of the GNU General Public License
# along with this module; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# heap fields:
+# heap => {
+# version => client version
+# name => user name,
+# reg => {
+# event name => { session ID => 1 }
+# },
+# wheel => active wheel,
+# state => see below constants,
+# # for connect events sent while still shutting down
+# pending => { Host => host, Port => port, Name => name ] | nonexistent
+# }
package Haver::Client;
use strict;
use warnings;
+use Data::Dumper;
+use Haver::Session -base;
-our $VERSION = 0.06;
+use constant {
+ S_IDLE => 0, # not connected, not connecting
+ S_CONN => 1, # establishing socket connection
+ S_INIT => 2, # C: HAVER sent
+ S_LOGIN => 3, # S: HAVER recieved, C: IDENT sent
+ S_ONLINE => 4, # S: HELLO received
+ S_DYING => 5, # C: BYE sent, socket still open
+};
+use POE qw(Wheel::ReadWrite
+ Wheel::SocketFactory);
+
+use Haver::Protocol::Filter;
+
+our $VERSION = 0.08;
+
+our %Failures = (
+ 'invalid.name' => "The server rejected the name %1%.",
+ 'reserved.name' => "The name %1% is reserved for internal use by the
server.",
+ 'exists.user' => "The name %1% is in use.",
+ 'unknown.user' => "The user %1% is not online.",
+ 'unknown.channel' => "The channel %1% does not exist.",
+ 'unknown.namespace' => "The namespace %1% does not exist. This is probably
an application bug.",
+ 'invalid.type' => "The type of a message was invalid. "
+ . "This is almost certainly an application error.",
+ 'already.joined' => "Tried to join %1% when already in it.",
+ 'already.parted' => "Tried to leave %1% when not in it.",
+);
+
+sub _format {
+ my @args;
+ (undef, @args) = @_;
+ my $code = $args[0];
+
+ if (!$Failures{$code}) {
+ return "Unknown error: " . join(' ', @args);
+ }
+
+ my $msg = $Failures{$code};
+ $msg =~ s{%(\d+)%}{$args[$1] || "MISSING ARGUMENT $1"}eg;
+ return $msg;
+}
+
+sub _call {
+ return POE::Kernel->call(POE::Kernel->get_active_session(), @_);
+}
+
+sub _dispatch {
+ _call('__dispatch', @_);
+}
+
+sub _dprint {
+ my ($level, @text) = @_;
+ return unless POE::Kernel->get_active_session()->get_heap()->{debug} >=
$level;
+ print STDERR @text;
+}
+
+sub _dprintf {
+ my ($level, $fmt, @text) = @_;
+ return unless POE::Kernel->get_active_session()->get_heap()->{debug} >=
$level;
+ printf STDERR $fmt, @text;
+}
+
+### SETUP
+
+sub states {
+ [qw{
+ _start _default
+ connect _conn_fail
+ _conn_ok _input disconnect
+ send_raw send join part
+ public private
+ list destroy
+ _ev_HAVER _ev_HELLO
+ _ev_JOIN _ev_PART
+ _ev_IN _ev_FROM
+ _ev_PING _ev_BYE
+ _ev_FAIL __dispatch
+ register unregister
+ _cleanup _err
+ _force_down _dns_resp
+ _do_connect
+ }]
+}
+
+sub _start {
+ my ($kernel, $heap, $opt) = @_[KERNEL, HEAP, ARG0];
+ croak "No alias" unless $opt->{alias};
+ $heap->{reg} = {};
+ $heap->{state} = S_IDLE;
+ $heap->{alias} = $opt->{alias};
+ $heap->{resolver} = $opt->{resolver};
+ $heap->{version} = $opt->{version} || "Haver::Client/$VERSION";
+
+ $kernel->alias_set($opt->{alias});
+}
+
+### SESSION MANAGEMENT
+
+sub connect {
+ my ($kernel, $heap, %opts) = @_[KERNEL,HEAP,ARG0..$#_];
+ $opts{Port} ||= 7575;
+ # TODO: handle arg errors
+ if ($heap->{state} == S_DYING) {
+ $heap->{pending} = \%opts;
+ return;
+ } elsif ($heap->{state} != S_IDLE) {
+ _call('disconnect');
+ $heap->{pending} = \%opts;
+ } else {
+ $heap->{state} = S_CONN;
+ $heap->{name} = $opts{Name};
+ $heap->{port} = $opts{Port};
+ if (!$heap->{resolver}) {
+ _call('_do_connect', $opts{Host});
+ } else {
+ my $resp = $heap->{resolver}->resolve(
+ host => $opts{Host},
+ context => {},
+ event => '_dns_resp',
+ );
+ if ($resp) {
+ _call('_dns_resp', $resp);
+ }
+ }
+ }
+}
+
+sub _do_connect {
+ my ($heap, $addr) = @_[HEAP,ARG0];
+ my $port = delete $heap->{port};
+ if ($heap->{state} == S_DYING) {
+ _call('_cleanup');
+ return;
+ }
+ $heap->{wheel} = POE::Wheel::SocketFactory->new(
+ RemoteAddress => $addr,
+ RemotePort => $port,
+ SuccessEvent => '_conn_ok',
+ FailureEvent => '_conn_fail',
+ );
+}
+
+BEGIN {
+ eval {
+ require List::Util;
+ List::Util->import(qw(shuffle));
+ };
+ eval {
+ shuffle();
+ };
+ if ($@) {
+ *shuffle = sub { return @_; }
+ }
+}
+
+sub _dns_resp {
+ my ($heap, $packet) = @_[HEAP,ARG0];
+ if ($packet->{response}) {
+ my $resp = $packet->{response};
+ my @answer = shuffle($resp->answer);
+ foreach my $record (@answer) {
+ if ($record->type eq 'A') {
+ # XXX: ipv6 support
+ $poe_kernel->yield('_do_connect', $record->address);
+ return;
+ }
+ }
+ # dns fail
+ _dispatch('connect_fail', 'dns');
+ _call('_cleanup');
+ } else {
+ _dispatch('connect_fail', 'dns', $packet->{error});
+ }
+}
+
+sub _conn_fail {
+ my $heap = $_[HEAP];
+ _dispatch('connect_fail', @_[ARG0..ARG2]);
+ _call('_cleanup');
+}
+
+sub _conn_ok {
+ my ($kernel, $heap, $sock) = @_[KERNEL,HEAP,ARG0];
+ if ($heap->{state} == S_DYING) {
+ _call('_cleanup');
+ return;
+ }
+ _dispatch('connected');
+ $heap->{state} = S_INIT;
+ $heap->{wheel} = new POE::Wheel::ReadWrite(
+ Handle => $sock,
+ Filter => new Haver::Protocol::Filter,
+ InputEvent => '_input',
+ ErrorEvent => '_err',
+ );
+ $heap->{wheel}->put( ['HAVER', $heap->{version}] );
+ # XXX: timeout
+}
+
+sub _input {
+ my ($kernel, $heap, $arg) = @_[KERNEL,HEAP,ARG0];
+ return if (ref $arg ne 'ARRAY' || @$arg == 0);
+ print STDERR "S: ", join "\t", @$arg;
+ print STDERR "\n";
+ _dispatch('raw_in', @$arg);
+ my $cmd = $arg->[0];
+ $kernel->yield("_ev_$cmd", @$arg);
+}
+
+sub _err {
+ _dispatch('disconnected', @_[ARG0..ARG2]);
+ _call('_cleanup');
+}
+
+
+sub disconnect {
+ my $heap = $_[HEAP];
+ _call('send_raw', 'BYE');
+ $heap->{state} = S_DYING;
+ $poe_kernel->delay('_force_down', 5);
+}
+
+sub _force_down {
+ my $heap = $_[HEAP];
+ $heap->{state} = S_IDLE;
+ _call('_cleanup');
+}
+
+sub _cleanup {
+ my $heap = $_[HEAP];
+ $poe_kernel->delay('_force_down');
+ if ($heap->{pending}) {
+ my @opts = %{delete $heap->{pending}};
+ $poe_kernel->yield('connect', @opts);
+ }
+ delete $heap->{wheel};
+ delete $heap->{name};
+ $heap->{state} = S_IDLE;
+}
+
+sub send_raw {
+ my ($heap, @args) = @_[HEAP,ARG0..$#_];
+ if ($heap->{state} == S_IDLE || $heap->{state} == S_CONN ||
+ $heap->{state} == S_DYING) {
+ return;
+ }
+ print STDERR "C: ", join("\t", @args), "\n";
+ $heap->{wheel}->put([EMAIL PROTECTED]);
+}
+
+sub send {
+ my ($kernel, @args) = @_[KERNEL,ARG0..$#_];
+ _call('send_raw', @args);
+}
+
+sub join {
+ my $channel = $_[ARG0];
+ _call('send', 'JOIN', $channel);
+}
+
+sub part {
+ my $channel = $_[ARG0];
+ _call('send', 'PART', $channel);
+}
+
+sub public {
+ my ($kernel, $heap, $c, $t, @a) = @_[KERNEL,HEAP,ARG0..$#_];
+ _call('send', 'IN', $c, $t, @a);
+}
+
+sub private {
+ my ($kernel, $heap, $d, $t, @a) = @_[KERNEL,HEAP,ARG0..$#_];
+ _call('send', 'TO', $d, $t, @a);
+}
+
+sub list {
+ my ($chan, $type) = @_[ARG0, ARG1];
+ $type = defined $type || 'user';
+ _call('send', 'LIST', $chan, $type);
+}
+
+sub destroy {
+ my ($kernel, $heap) = @_[KERNEL,HEAP];
+ _dispatch('destroyed');
+ delete $heap->{pending};
+ my $reg = $heap->{reg};
+ foreach my $ehash (values %$reg) {
+ foreach my $id (keys %$ehash) {
+ $poe_kernel->refcount_decrement($id, $ehash->{$id});
+ }
+ }
+ $heap->{reg} = {};
+ _call('disconnect');
+ $kernel->alias_remove($heap->{alias});
+}
+
+## server-response stuff
+
+sub _ev_HAVER {
+ my ($kernel, $heap) = @_[KERNEL,HEAP];
+ return if ($heap->{state} != S_INIT); # should never happen, unless the
+ # server is non-compliant
+ $kernel->yield('send_raw', 'IDENT', $heap->{name});
+ $heap->{state} = S_LOGIN;
+}
+
+sub _ev_HELLO {
+ my $heap = $_[HEAP];
+ $heap->{state} = S_ONLINE;
+ _dispatch('ready');
+}
+
+sub _ev_JOIN {
+ my ($heap, $chan, $name) = @_[HEAP,ARG1,ARG2];
+ if ($name eq $heap->{name}) {
+ _dispatch('ijoined', $chan);
+ } else {
+ _dispatch('join', $chan, $name);
+ }
+}
+
+sub _ev_PART {
+ my ($heap, $chan, $name) = @_[HEAP,ARG1,ARG2];
+ if ($name eq $heap->{name}) {
+ _dispatch('iparted', $chan);
+ } else {
+ _dispatch('part', $chan, $name);
+ }
+}
+
+sub _ev_LIST {
+ my ($heap, $chan, $ns, @things) = @_[HEAP,ARG1..$#_];
+ return unless defined $ns;
+ _dispatch('list', $chan, $ns, @things);
+}
+
+sub _ev_IN {
+ _dispatch('public', @_[ARG1..$#_]);
+}
+
+sub _ev_FROM {
+ _dispatch('private', @_[ARG1..$#_]);
+}
+
+sub _ev_PING {
+ _call('send_raw', 'PONG', @_[ARG1..$#_]);
+}
+
+sub _ev_BYE {
+ my ($type, $detail) = @_[ARG2,ARG3];
+ _dispatch('bye', $detail);
+ _call('_cleanup');
+}
+
+sub _ev_FAIL {
+ my $msg = _format(@_[ARG0..$#_]);
+ _dispatch('fail', $msg, @_[ARG0..$#_]);
+ my $code = $_[ARG1];
+ $code =~ tr/./_/;
+ _dispatch("fail_$code", $msg, @_[ARG0..$#_]);
+}
+
+sub _default {
+ my ( $kernel, $state, $event, $args, $self ) = @_[ KERNEL, STATE, ARG0,
ARG1, OBJECT ];
+ $args ||= []; # Prevents uninitialized-value warnings.
+ # DEBUG: "default: $state = $event. Args:\n", Dumper $args;
+ return 0;
+}
+
+sub register {
+ my ($kernel, $heap, $session, @events) =
@_[KERNEL,HEAP,SENDER,ARG0..$#_];
+ my $reg = $heap->{reg};
+ my $id = $session->ID;
+ foreach my $event (@events) {
+ $event = uc $event;
+ next if exists $reg->{$event}{$id};
+ my $tag = '1' . $reg->{$event} . '\0' . $id . '\0' . rand;
+ $reg->{$event}{$id} = $tag;
+ $kernel->refcount_increment( $id, $tag );
+ }
+}
+
+sub unregister {
+ my ($kernel, $heap, $session, @events) =
@_[KERNEL,HEAP,SENDER,ARG0..$#_];
+ my $reg = $heap->{reg};
+ my $id = $session->ID;
+ foreach my $event (@events) {
+ $event = uc $event;
+ my $tag;
+ next unless $tag = delete $reg->{$event}{$id};
+ $kernel->refcount_decrement( $id, $tag );
+ }
+}
+
+
+sub __dispatch {
+ my ($kernel, $heap, $evname, @args) = @_[KERNEL,HEAP,ARG0..$#_];
+ $evname = uc $evname;
+ my $reg = $heap->{reg};
+ $reg->{$evname} ||= {};
+ $reg->{ALL} ||= {};
+ my %targ = (%{$reg->{$evname}}, %{$reg->{ALL}});
+ my @ids = keys %targ;
+
+ unshift @args, [$heap->{alias}];
+
+ foreach my $id (@ids) {
+ $kernel->post($id, "haver_$evname", @args);
+ }
+}
+
1;
+
__END__
=head1 NAME
-Haver::Client - Namespace for client stuff.
+Haver::Client - POE component for haver clients.
=head1 SYNOPSIS
use Haver::Client;
+ create Haver::Client (
+ alias => 'haver',
+ resolver => $res, # A POE::Component::Client::DNS object
+ version => "WackyClient/1.20",
+ );
=head1 DESCRIPTION
-This module is nought but a place holder.
+FIXME
-=head1 SEE ALSO
+=head1 METHODS
-L<http://wiki.chani3.com/wiki/ProjectHaver/>
+There is only one method, create(), which is a class method.
+=head2 create(alias => $alias, resolver => $resolver, version => $version)
+
+This creates a new Haver::Client session. The only required parameter
+is $alias, which is how you'll talk to the client session using
L<POE::Kernel>'s post().
+
+If given, $resolver should be a L<POE::Component::Client::DNS> object.
+
+Finally, $version is what we will advertize as the client name and version
number to the
+server. It defaults to C<Haver::Client/0.08>.
+
+=head1 STATES
+
+
+
+=head1 BUGS
+
+None known. Bug reports are welcome. Please use our bug tracker at
+L<http://gna.org/bugs/?func=additem&group=haver>.
+
=head1 AUTHOR
-Bryan Donlan, E<lt>[EMAIL PROTECTED]<gt> and
-Dylan William Hardison, E<lt>[EMAIL PROTECTED]<gt>
+Bryan Donlan E<lt>[EMAIL PROTECTED]<gt>,
+Dylan William Hardison E<lt>[EMAIL PROTECTED]<gt>.
-=head1 COPYRIGHT AND LICENSE
+=head1 SEE ALSO
-Copyright (C) 2004 by Bryan Donlan, Dylan William Hardison
+L<http://www.haverdev.org/>.
-This library is free software; you can redistribute it and/or modify
+=head1 COPYRIGHT and LICENSE
+
+Copyright (C) 2004, 2005 by Bryan Donlan, Dylan William Hardison. All Rights
Reserved.
+
+This module is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
-This library is distributed in the hope that it will be useful,
+This module is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
@@ -64,5 +519,3 @@
along with this module; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-
-=cut
