[haver-commits] r857 - trunk/perl/client/lib/Haver/Client

[haver]

Author: bdonlan
Date: 2005-07-10 20:09:48 -0400 (Sun, 10 Jul 2005)
New Revision: 857

Modified:
   trunk/perl/client/lib/Haver/Client/POE.pm
Log:
Error handling

Modified: trunk/perl/client/lib/Haver/Client/POE.pm
===================================================================
--- trunk/perl/client/lib/Haver/Client/POE.pm   2005-07-10 23:49:58 UTC (rev 
856)
+++ trunk/perl/client/lib/Haver/Client/POE.pm   2005-07-11 00:09:48 UTC (rev 
857)
@@ -58,6 +58,7 @@
 use warnings;
 use Carp;
 use Data::Dumper;
+use Regexp::Shellish;
 
 use constant {
     S_IDLE   => 0, # not connected, not connecting
@@ -75,6 +76,32 @@
 
 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(), @_);
 }
@@ -140,9 +167,12 @@
                 _ev_FROM
                 _ev_PING
                 _ev_BYE
+                _ev_FAIL
                 __dispatch
                 register
                 unregister
+                _cleanup
+                _err
             }
         ]],
         heap => $heap,
@@ -187,7 +217,9 @@
 }
 
 sub _conn_fail {
-    die "XXX: conn fail";
+    my $heap = $_[HEAP];
+    _dispatch('connect_fail', @_[ARG0..ARG2]);
+    _call('_cleanup');
 }
 
 sub _conn_ok {
@@ -198,7 +230,7 @@
         Handle => $sock,
         Filter => new Haver::Protocol::Filter,
         InputEvent => '_input',
-        # ErrorEvent => ...
+        ErrorEvent => '_err',
         # FlushedEvent => ...
     );
     $heap->{wheel}->put( ['HAVER', '$pkg/$version'] );
@@ -215,6 +247,11 @@
     $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
@@ -226,11 +263,17 @@
     # XXX
     my $heap = $_[HEAP];
     $heap->{state} = S_IDLE;
-    delete $heap->{wheel};
+    _call('_cleanup');
+}
+
+sub _cleanup {
+    my $heap = $_[HEAP];
     if ($heap->{pending}) {
         my @opts = %{delete $heap->{pending}};
         $poe_kernel->yield('connect', @opts);
     }
+    delete $heap->{wheel};
+    delete $heap->{name};
 }
 
 =head2 send_raw(@args)
@@ -323,7 +366,12 @@
 =cut
 
 sub destroy {
-       die "STUB";
+       my ($kernel, $heap) = @_;
+    _dispatch('destroyed');
+    delete $heap->{pending};
+    delete $heap->{reg};
+    _call('disconnect');
+    $kernel->remove_alias($heap->{alias});
 }
 
 ## server-response stuff
@@ -383,6 +431,14 @@
     die "bye $type $detail\n";
 }
 
+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.