updated Net-IRC module to what ASM uses (modified version)

4 files changed, 78 insertions, 66 deletions

diff --git a/Net/IRC.pm b/Net/IRC.pm
index f41fc18..9e39458 100644
--- a/Net/IRC.pm
+++ b/Net/IRC.pm
@@ -22,7 +22,7 @@ use Net::IRC::Connection;
 use Net::IRC::EventQueue;
 use IO::Select;
 use Carp;
-use Data::Dumper;
+
 
 # grab the drop-in replacement for time() from Time::HiRes, if it's available
 BEGIN {
@@ -33,8 +33,7 @@ BEGIN {
 use strict;
 use vars qw($VERSION);
 
-$VERSION = "0.76";
-print $VERSION . "\n";
+$VERSION = "0.80";
 
 sub new {
   my $proto = shift;
@@ -49,8 +48,6 @@ sub new {
     '_read'             => IO::Select->new(),
     '_timeout'          => 1,
     '_write'            => IO::Select->new(),
-    '_cansend'          => 1,
-    '_sb'		=> 0,
   };
   
   bless $self, $proto;
@@ -68,20 +65,6 @@ sub schedulequeue {
   return $self->{_schedulequeue};
 }
 
-sub cansend {
-  my $self = shift;
-  return $self->{_cansend};
-}
-
-sub setcansend {
-  my $self = shift;
-  my $bool = shift;
-  if ($bool == 1) {
-    $self->{_sb} = 0;
-  }
-  return $self->{_cansend}=$bool;
-}
-
 # Front end to addfh(), below. Sets it to read by default.
 # Takes at least 1 arg:  an object to add to the select loop.
 #           (optional)   a flag string to pass to addfh() (see below)
@@ -142,22 +125,12 @@ sub do_one_loop {
 
   $time = time();             # no use calling time() all the time.
 
-  if ( (!$self->outputqueue->is_empty) && ($self->cansend) ) {
+  if(!$self->outputqueue->is_empty) {
     my $outputevent = undef;
-#    my $sentbytes = 0;
     while(defined($outputevent = $self->outputqueue->head)
-          && $self->cansend) {
-      my $ltosend = length($outputevent->content->{args}->[1]);
-      if ($ltosend + $self->{_sb} > 1480 ) {
-#        $sock->send("PING :s\r\n");
-        $outputevent->content->{coderef}->(($outputevent->content->{args}->[0], "PING :s"));
-        $self->setcansend(0);
-      }
-      else {
-        $outputevent = $self->outputqueue->dequeue();
-        $outputevent->content->{coderef}->(@{$outputevent->content->{args}});
-        $self->{_sb} += 2 + $ltosend;
-      }
+          && $outputevent->time <= $time) {
+      $outputevent = $self->outputqueue->dequeue();
+      $outputevent->content->{coderef}->(@{$outputevent->content->{args}});
     }
     $nexttimer = $self->outputqueue->head->time if !$self->outputqueue->is_empty();
   }
@@ -305,7 +278,17 @@ __END__
 
 =head1 NAME
 
-Net::IRC - Perl interface to the Internet Relay Chat protocol
+Net::IRC - DEAD SINCE 2004 Perl interface to the Internet Relay Chat protocol
+
+=head1 USE THESE INSTEAD
+
+This module has been abandoned and is no longer developed. This release serves
+only to warn current and future users about this and to direct them to supported
+and actively-developed libraries for connecting Perl to IRC. Most new users will
+want to use L<Bot::BasicBot>, whereas more advanced users will appreciate the
+flexibility offered by L<POE::Component::IRC>. We understand that porting code
+to a new framework can be difficult. Please stop by #perl on irc.freenode.net
+and we'll be happy to help you out with bringing your bots into the modern era.
 
 =head1 SYNOPSIS
 
@@ -320,6 +303,11 @@ Net::IRC - Perl interface to the Internet Relay Chat protocol
 
 =head1 DESCRIPTION
 
+This module has been abandoned and deprecated since 2004. The original authors
+have moved onto L<POE::Component::IRC> and more modern techniques. This
+distribution is not maintained and only uploaded to present successively louder
+"don't use this" warnings to those unaware.
+
 Welcome to Net::IRC, a work in progress. First intended to be a quick tool
 for writing an IRC script in Perl, Net::IRC has grown into a comprehensive
 Perl implementation of the IRC protocol (RFC 1459), developed by several
diff --git a/Net/IRC/Connection.pm b/Net/IRC/Connection.pm
index 6fd97fc..6918bda 100644
--- a/Net/IRC/Connection.pm
+++ b/Net/IRC/Connection.pm
@@ -21,6 +21,7 @@ use IO::Socket;
 use IO::Socket::INET;
 use Symbol;
 use Carp;
+use Data::Dumper;
 
 # all this junk below just to conditionally load a module
 # sometimes even perl is braindead...
@@ -78,6 +79,8 @@ sub new {
     _pacing     =>  0,       # no pacing by default
     _ssl	=>  0,       # no ssl by default
     _format     => { 'default' => "[%f:%t]  %m  <%d>", },
+    _rx         =>  0,
+    _tx         =>  0,
   };
   
   bless $self, $proto;
@@ -477,10 +480,6 @@ sub handler {
   print STDERR "Trying to handle event '$ev'.\n" if $self->{_debug};
   
   my $handler = undef;
-  #FIXME WHY IS THIS NECESSARY
-  if (!defined($ev)) {
-    return $self->_default($event, @_);
-  }
   if (exists $self->{_handler}->{$ev}) {
     $handler = $self->{_handler}->{$ev};
   } elsif (exists $_udef{$ev}) {
@@ -847,6 +846,7 @@ sub parse {
       and
       (length($self->{_frag}) + length($line)) > 0)  {
     # grab any remnant from the last go and split into lines
+    $self->{_rx} += length($line);
     my $chunk = $self->{_frag} . $line;
     @lines = split /\012/, $chunk;
     
@@ -870,12 +870,9 @@ sub parse {
    
    print STDERR "<<< $line\n" if $self->{_debug};
    
+   $::lastline = $line; #this is so __WARN__ can print the last line received on IRC.
    # Like the RFC says: "respond as quickly as possible..."
-   if ($line =~ /^:(\S+) PONG (.*)/i) {
-     $self->parent->setcansend(1);
-     next;
-     #return;
-   } elsif ($line =~ /^PING/) {
+   if ($line =~ /^PING/) {
      $ev = (Net::IRC::Event->new( "ping",
                                   $self->server,
                                   $self->nick,
@@ -916,7 +913,13 @@ sub parse {
      $type = lc $type;
      # This should be fairly intuitive... (cperl-mode sucks, though)
      
-     if (defined $line and index($line, "\001") >= 0) {
+     # The order of this was changed by AfterDeath because a \x01 in a geco fucked shit up
+     if ($type eq "join" or $type eq "part" or
+              $type eq "mode" or $type eq "topic" or
+              $type eq "kick") {
+       $itype = "channel";
+     } elsif (defined $line and index($line, "\001") == 0) { #originally >=0. Hopefully this will fuck less shit up.
+#       print Dumper($from, $type, \@stuff, $line);
        $itype = "ctcp";
        unless ($type eq "notice") {
          $type = (($stuff[0] =~ tr/\#\&//) ? "public" : "msg");
@@ -925,16 +928,12 @@ sub parse {
        $itype = $type = (($stuff[0] =~ tr/\#\&//) ? "public" : "msg");
      } elsif ($type eq "notice") {
        $itype = "notice";
-     } elsif ($type eq "join" or $type eq "part" or
-              $type eq "mode" or $type eq "topic" or
-              $type eq "kick") {
-       $itype = "channel";
      } elsif ($type eq "nick") {
        $itype = "nick";
      } else {
        $itype = "other";
      }
-     
+
      # This goes through the list of ignored addresses for this message
      # type and drops out of the sub if it's from an ignored hostmask.
      
@@ -1000,12 +999,24 @@ sub parse {
                                   '',
                                   $type,
                                   $line);  
-     } elsif ($type eq "account") {
+     } elsif ($type eq "account") { #these next 3 event hooks added by AfterDeath
        $ev = Net::IRC::Event->new($type,
                                   $from,
                                   '',
                                   $type,
                                   @stuff);
+     } elsif ($type eq "cap") {
+       $ev = Net::IRC::Event->new($type,
+                                  $from,
+                                  '',
+                                  $type,
+                                  @stuff);
+     } elsif ($type eq "pong") {
+       $ev = Net::IRC::Event->new($type,
+                                  $from,
+                                  $self->{nick},
+                                  'server',
+                                  $stuff[1]);
      } else {
        carp "Unknown event type: $type";
      }
@@ -1055,7 +1066,7 @@ sub parse {
      $ev = 'done';
      $self->disconnect( 'error', ($line =~ /(.*)/) );
      
-   } 
+   }
    
    if ($ev) {
      
@@ -1397,6 +1408,7 @@ sub sl_real {
     $self->handler("sockerror");
     return;
   }
+  $self->{_tx} += (length($line) + 2);
   return $rv;
 }
 
@@ -1598,10 +1610,6 @@ sub _default {
     croak "You EEEEEDIOT!!! Not enough args to _default()!";
   }
   
-  #FIXME WHY IS THIS NECESSARY
-  if (!defined($event->type)) {
-    return 1;
-  }
   # Reply to PING from server as quickly as possible.
   if ($event->type eq "ping") {
     $self->sl("PONG " . (CORE::join ' ', $event->args));
@@ -1612,8 +1620,6 @@ sub _default {
     unless (keys %{$self->parent->{_connhash}} > 0) {
       die "No active connections left, exiting...\n";
     }
-  } elsif ($event->type eq "pong") {
-    $self->setcansend(1);
   }
   
   return 1;
diff --git a/Net/IRC/Event.pm b/Net/IRC/Event.pm
index 7839ecb..8b01028 100644
--- a/Net/IRC/Event.pm
+++ b/Net/IRC/Event.pm
@@ -189,6 +189,16 @@ sub userhost {
     return $self->{'userhost'};
 }
 
+#added by AfterDeath. Use this to reply to channel messages in channel, but private messages to the nick that sent it.
+sub replyto {
+    my $self = shift;
+    if ($self->{to}->[0] =~ /^#/) {
+      return $self->{to}->[0];
+    } else {
+      return $self->{nick};
+    }
+}
+
 # Simple sub for translating server numerics to their appropriate names.
 # Takes one arg:  the number to be translated.
 sub trans {
@@ -266,6 +276,7 @@ sub trans {
 	   259 => "adminemail",
 	   261 => "tracelog",
 	   262 => "endoftrace",  # 1997-11-24 -- archon
+           263 => "rpl_tryagain",
 	   265 => "n_local",     # 1997-10-16 -- tkil
 	   266 => "n_global",    # 1997-10-16 -- tkil
 	   271 => "silelist",		# Undernet Extension, Kajetan@Hinner.com, 17/10/98
@@ -305,6 +316,7 @@ sub trans {
 	   322 => "list",
 	   323 => "listend",
 	   324 => "channelmodeis",
+           328 => "channelurlis",
 	   329 => "channelcreate",  # 1997-11-24 -- archon
 	   331 => "notopic",
 	   332 => "topic",
@@ -353,6 +365,7 @@ sub trans {
 	   393 => "users",
 	   394 => "endofusers",
 	   395 => "nousers",
+           396 => "hosthidden",
 
 	   401 => "nosuchnick",
 	   402 => "nosuchserver",
@@ -451,6 +464,10 @@ sub trans {
            641 => "rpl_dumprpl",        # UnrealIrcd, Hendrik Frenzel
            642 => "rpl_eodump",         # UnrealIrcd, Hendrik Frenzel
 
+           716 => "rpl_ignored",
+
+           728 => "quietlist",
+           729 => "quietlistend",
            999 => "numericerror",           # Bahamut IRCD
            'pong' => "pong",
 	  );
diff --git a/Net/IRC/EventQueue/Entry.pm b/Net/IRC/EventQueue/Entry.pm
index 4d75bd8..94a3802 100644
--- a/Net/IRC/EventQueue/Entry.pm
+++ b/Net/IRC/EventQueue/Entry.pm
@@ -1,39 +1,40 @@
 package Net::IRC::EventQueue::Entry;
-
+                                                                                                                                     
 use strict;
-
+                                                                                                                                     
 my $id = 0;
-
+                                                                                                                                     
 sub new {
   my $class = shift;
   my $time = shift;
   my $content = shift;
-
+                                                                                                                                     
   my $self = {
     'time'  => $time,
     'content' => $content,
     'id'    => "$time:" . $id++,
   };
-
+                                                                                                                                     
   bless $self, $class;
   return $self;
 }
-
+                                                                                                                                     
 sub id {
   my $self = shift;
   return $self->{'id'};
 }
-
+                                                                                                                                     
 sub time {
   my $self = shift;
   $self->{'time'} = $_[0] if @_;
   return $self->{'time'};
 }
-
+                                                                                                                                     
 sub content {
   my $self = shift;
   $self->{'content'} = $_[0] if @_;
   return $self->{'content'};
 }
-
+                                                                                                                                     
 1;
+