Removed stray Dumper() in IRC.pm. Fixed serious bug in ISupport plugin.

bingos · Jul 5, 2006 · 977fa6c · 977fa6c
1 parent bf8ead4
commit 977fa6c
Show file tree

Hide file tree

Showing 3 changed files with 27 additions and 24 deletions.
diff --git a/Changes b/Changes
@@ -1,5 +1,9 @@
 Revision history for Perl extension POE::Component::IRC.
 
+4.95  Wed Jul 05 11:46:34 BST 2006
+    - Removed stray Dumper() in IRC.pm.
+    - Fixed serious bug in ISupport plugin.
+
 4.94  Sun Jul 02 10:01:45 BST 2006
     - Amended the DNS code to implement round-robin type 
       behaviour.

diff --git a/lib/POE/Component/IRC.pm b/lib/POE/Component/IRC.pm
@@ -27,13 +27,12 @@ use Carp;
 use Socket;
 use File::Basename ();
 use Symbol;
-use Data::Dumper;
 use vars qw($VERSION $REVISION $GOT_SSL $GOT_CLIENT_DNS);
 
 # Load the plugin stuff
 use POE::Component::IRC::Plugin qw( :ALL );
 
-$VERSION = '4.94';
+$VERSION = '4.95';
 $REVISION = do {my@r=(q$Revision$=~/\d+/g);sprintf"%d"."%04d"x$#r,@r};
 
 # BINGOS: I have bundled up all the stuff that needs changing for inherited classes
@@ -218,7 +217,7 @@ sub _configure {
     # This is a hack to make sure that the component doesn't die if no IRCServer is
     # specified as the result of being called from new() via spawn().
 
-    $spawned = $arg{'CALLED_FROM_SPAWN'} if exists $arg{'CALLED_FROM_SPAWN'};
+    $spawned = $arg{'CALLED_FROM_SPAWN'};
   }
 
   if ( $spawned and !$self->{NoDNS} and $GOT_CLIENT_DNS and !$self->{resolver} ) {
@@ -845,8 +844,6 @@ sub got_dns_response {
     push @{ $self->{res_addresses} }, $net_dns_answer->rdatastr;
   }
 
-  warn Dumper($self->{res_addresses});
-
   if ( my $address = shift @{ $self->{res_addresses} } ) {
     $self->{'server'} = $address;
     $kernel->yield("do_connect");

diff --git a/lib/POE/Component/IRC/Plugin/ISupport.pm b/lib/POE/Component/IRC/Plugin/ISupport.pm
@@ -5,7 +5,7 @@ use warnings;
 
 use POE::Component::IRC::Plugin qw(:ALL);
 
-our $VERSION = '0.51';
+our $VERSION = '0.52';
 
 sub new {
   return bless { }, shift;
@@ -37,26 +37,28 @@ sub S_001 {
 
 sub S_005 {
   my ($self,$irc,@args) = @_;
-
+  my @vals = @{ ${ $args[2] } };
+  pop @vals;
   my $support = $self->{server};
-  (my $spec = ${ $args[1] }) =~ s/:are (?:available|supported).*//;
+  #(my $spec = ${ $args[1] }) =~ s/:are (?:available|supported).*//;
 
-  for (split ' ', $spec) {
+  #for (split ' ', $spec) {
+  for (@vals) {
     if (/=/) {
       my ($key, $val) = split /=/, $_, 2;
 
       if ($key eq 'CASEMAPPING') {
         $support->{$key} = $val;
-        if ($val eq 'ascii') { }
-        elsif ($val eq 'rfc1459') {
-          $self->{server}->cmp(sub { (my $s = pop) =~ tr/A-Z[]\\^/a-z{}|~/; $s });
-        }
-        elsif ($val eq 'strict-rfc1459') {
-          $self->{server}->cmp(sub { (my $s = pop) =~ tr/A-Z[]\\/a-z{}|/; $s });
-        }
-        else {
-          #$irc->_send_event(IRCE_UNKCMAP, 0, [$val]);
-        }
+        #if ($val eq 'ascii') { }
+        #elsif ($val eq 'rfc1459') {
+        #  $self->{server}->cmp(sub { (my $s = pop) =~ tr/A-Z[]\\^/a-z{}|~/; $s });
+        #}
+        #elsif ($val eq 'strict-rfc1459') {
+        #  $self->{server}->cmp(sub { (my $s = pop) =~ tr/A-Z[]\\/a-z{}|/; $s });
+        #}
+        #else {
+        #  #$irc->_send_event(IRCE_UNKCMAP, 0, [$val]);
+        #}
       }
       elsif ($key eq 'CHANLIMIT') {
         while ($key =~ /([^:]+):(\d+),?/g) {
@@ -126,7 +128,7 @@ sub _default {
   # when we get a code higher than 005, we unload ourselves
   # (but we don't want to unregister the /support function)
 
-  return PCI_EAT_NONE if ( $self->{done_005} );
+  return PCI_EAT_NONE if $self->{done_005};
   if ($e =~ /^S_0*(\d+)/ and $1 > 5) {
     #$irc->plugin_unregister($self, SERVER => qw( 005 all ));
     $irc->_send_event(irc_isupport => $self);
@@ -137,15 +139,15 @@ sub _default {
 }
 
 sub isupport {
-  my ($self) = shift;
-  my ($value) = uc ( $_[0] ) || return undef;
+  my $self = shift;
+  my $value = uc ( $_[0] ) || return undef;
 
-  return $self->{server}->{$value} if ( defined ( $self->{server}->{$value} ) );
+  return $self->{server}->{$value} if defined $self->{server}->{$value};
   undef;
 }
 
 sub isupport_dump_keys {
-  my ($self) = shift;
+  my $self = shift;
 
   if ( scalar ( keys %{ $self->{server} } ) > 0 ) {
 	return keys %{ $self->{server} };