#! /usr/bin/perl -w


           ###################################################
           #                                                 #
           # UNIBOT v1.0.3                                   #
           # (C) 2013 Chaosje, email: chaosje@gmail.com      #
           #                                                 #
           # Generic IRC-bot kernel                          #
           #                                                 #
           # Tested networks:                                #
           # - Hybrid                                        #
           # - EFNet                                         #
           # - IRCNet                                        #
           # - UnderNet                                      #
           # - QuakeNet                                      #
           # - FreeNode                                      #
           #                                                 #
           # * Services compatible                           #
           # * Event-based                                   #
           # * Timed events                                  #
           # * Anti-Flood protection                         #
           # * Auto register/identify with NickServ          #
           # * Auto gain whois information on idle-time      #
           # * Auto join channels                            #
           #                                                 #
           ###################################################

package Server::irc;

use strict;
use Socket;
use POSIX qw(:sys_wait_h EAGAIN EBUSY);
use Time::HiRes qw ( usleep gettimeofday );

sub init {
  my $self = {

    port => 6667,                                  # Port on which to connect to server
    server => 'irc.myserver.com',                  # Server to connect to
    timeout => 1300,                               # Ping-Timeout (very dependent on server-config)
    servername =>'My Servername',                  # Server description
    nick => 'BotTest',                             # Name of your bot on the chat
    altnick => 'BotTest_',                         # Alternative nick if nick in use
    channels => [ '#mychan1', '#mychan2' ],        # All default channels to join
    ident => 'myident',                            # Bot ident
    desc => 'My 1337 bot',                         # Bot description
    nickserv => 'NickServ!NickServ\@myserver.com', # Used to identify NickServ (some Networks spoof NickServ to gain passwords)
    password => 'h4ckm3',                          # Used for NickServ if present
    quitmessage => "UniBot v1.0.3, 2013 Chaosje",  # Quit message
    version => 'UNIBot v1.0.3, 2013 Chaosje',      # Bot kernel version, you can change the version using $self->version for your own bot(s)

    # It's good policy not to let a bot have operator status, unless you are in a botwar ;)
    preventop => 1,                                # Bot may or may not be @ (disable for botwars)
    preventhalfop => 1,                            # Bot may or may not be %
    preventvoice => 0,                             # Bot may or may not be +

    timerdelay => 0.05,                            # seconds interval to check the timerlist
    inputdelay => 30000,                           # microseconds interval for input-checks from irc-server
    outputdelay => 0.6,                            # seconds interval to output to the irc-server (don't excess flood yourself!)
    gaindelay => 0.5,                              # seconds interval on idle-time to check the whois of the user-infolist

    antiflood => 1,                                # antiflood buffer, set to 0 to disable (disable for botwars)
    floodtimeout => 30,                            # seconds before flood is not seen as flood

    verbose => 1,                                  # show/hide Debug-mode, see all raw, except the following parameters.. (if 1 show them)
    verbosepong => 0,                              # show/hide the ping/pong event
    verboseevents => 1,                            # show/hide notifications of events being called
    verbosemotd => 1,                              # show/hide the MOTD
    verboseoutput => 1,                            # show/hide all output to the irc-server
    verbosewhois => 0,                             # show/hide all whois calls
    verboseprivmsg => 0,                           # show/hide the raw privmsg calls

    events => {},                                  # fill using $self->addevent('event',\&eventproc)
    timers => {},                                  # fill using $self->addtimer('name',repeat,seconds-interval(float),\&timerproc)

  };
  bless $self; return $self
}

###############################################################################
1;

sub start {
  my ($self) = @_;

  # Internal variables
  $self->{modes}={};
  $self->{me}=$self->{nick};
  $self->{chan}={};
  $self->{serverprop}={};
  $self->{buffer}=();
  $self->{buffertime}=gettimeofday();
  $self->{infotime}=gettimeofday();
  $self->{lastping}=gettimeofday();
  $self->{lasttimercheck}=gettimeofday();
  $self->{floodbuffer}={};

  # nickserv
  $self->{nickservtested}=0;
  $self->{nsfound}=0;
  if ($self->{nickserv} =~ /^(.+)?\!(.+)?\@(.+)$/) {
    $self->{nsnick}=$1;
    $self->{nsident}=$2;
    $self->{nshost}=$3
  }

  $self->{nicklist}={};   # all users found
  $self->{infolist}=[];   # which users still have to be added to the IAL.
  $self->{infolag}=0;     # did the info finish already before calling a new
  $self->{infoevents}={}; # when the bot does a whois

  # Set output to console
  select(STDOUT); binmode(STDOUT); $|=1;

  # Connect to server
  my $proto = getprotobyname('tcp');
  my $iaddr = inet_aton($self->{server});
  my $paddr = sockaddr_in($self->{port}, $iaddr);
  socket($self->{socket}, PF_INET, SOCK_STREAM, $proto) or die "Cannot create socket: $!";
  connect($self->{socket}, $paddr) or die "Cannot connect to server: $!";

  # Set autoflush on socket
  $self->{socket}->autoflush(1);
  my $handle=select($self->{socket}); $|=1; select($handle);

  my $sock=$self->{socket};

  # Set non blocking mode
  $sock->blocking(0);                                             # linux
  my $nonblocking = 1; ioctl($sock, 0x8004667e, \$nonblocking);   # windows

  # IRC handshake
  print $sock "PASS 112\r\n";
  if ($self->{verboseoutput}) { print "--> PASS 112\r\n" }
  print $sock "NICK $self->{nick}\r\n";
  if ($self->{verboseoutput}) { print "--> NICK $self->{nick}\r\n" }
  print $sock "USER $self->{ident} $self->{ident} $self->{ident} \:$self->{desc}\r\n\r\n";
  if ($self->{verboseoutput}) { print "--> USER $self->{ident} $self->{ident} $self->{ident} \:$self->{desc}\r\n" }

  ######################### MAIN KERNEL LOOP ################################

  # Enter main kernel loop
  $self->{quit}=0;
  my $curline="";
  my $succeed=0;
  while (!$self->{quit}) {

    if (eof($sock)) {
      # IRCD is offline.
      $self->{quitmessage}="IRCD seems to be down";
      $self->{quit}=1
    } else {

      my $inbuf;
      recv($sock,$inbuf,512,0);
      if (($! != EAGAIN) && ($! != EBUSY)) {
        if ($! == 10035) {
          # WSAEWOULDBLOCK (not implemented in POSIX; Waiting for input)
          usleep(10000)
        } elsif ($!) {
          print STDOUT "*** ERROR $!\n";
          $self->{quit}=1
        }
      }
      if ($inbuf) {
        if (!$succeed) {
          $self->event(0,'connect');
          $succeed=1;
        }
        # process what we read, split on \n, and keep the rest to process next time
        my @lines=split(/\n/,$inbuf);
        $lines[0]=$curline.$lines[0];
        $curline=pop @lines;
        if (ord(substr($curline,length($curline)-1,1)) == 13) {
          # We read the full line, so mark to process
          push @lines,$curline; $curline="";
        }
        # process all full lines
        foreach my $line (@lines) {
          $line =~ s/\r//g;
          if ($line) {
            $self->processinput($line)
          }
        }
      } else {
        # nothing to do so goto sleep
        if ($succeed) {
          usleep($self->{inputdelay});
        }
        # did we receive a PING?
        my $dtm=gettimeofday()-$self->{lastping};
        if ($dtm>$self->{timeout}) {
#          $self->{quitmessage}="No Ping received";
          print STDOUT "!!!*** No Ping received in $dtm seconds\n";
#          $self->{quit}=1
        }
        if (!$succeed && ($dtm>10)) {
          # connection failed, try again
          $self->{quit}=1
        }
      }
      if ($succeed) {
        $self->handletimers;
        $self->outputbuffer;
      }
    }
  }

  print $sock "QUIT \:$self->{quitmessage}\r\n";
  usleep(100000);

  # Closing up..
  close $self->{socket} or die "Cannot close socket: $!";
  print STDOUT "*** Lost connection to $self->{server}\n";

  $self->event(0,'disconnect');

  exit 1
}

################# USABLE FUNCTIONS ###########################################

sub flush {
  my ($self) = @_;
  $self->handletimers;
  $self->outputbuffer;
}

sub addevent {
  my ($self,$event,$procptr) = @_;
  $self->{events}{$event}=$procptr
}

sub delevent {
  my ($self,$event) = @_;
  if ($self->{events}{$event}) {
    delete $self->{events}{$event}
  }
}

sub addtimer {
  # seconds maybe float, repeat=0 is infinite
  my ($self,$name,$repeat,$seconds,$procptr) = @_;
  if (!$self->{timers}{$name}) {
    $self->{timers}{$name} = {}
  }
  $self->{timers}{$name}{repeat}=$repeat;
  $self->{timers}{$name}{seconds}=$seconds;
  $self->{timers}{$name}{event}=$procptr;
  $self->{timers}{$name}{activate}=gettimeofday()+$seconds
}

sub deltimer {
  my ($self,$name) = @_;
  if ($self->{timers}{$name}) {
    delete $self->{timers}{$name}
  }
}

sub raw {
  my ($self,$command,$target,$message,$nosemi) = @_;
  if ($nosemi) {
    $self->output(uc($command)." $target $message\r\n")
  } else {
    $self->output(uc($command)." $target \:$message\r\n")
  }
}

sub msg {
  my ($self,$target,$text) = @_;
  $self->output("PRIVMSG $target \:$text\r\n")
}

sub notice {
  my ($self,$target,$text) = @_;
  $self->output("NOTICE $target \:$text\r\n")
}

sub isop {
  my ($self,$nick,$channel) = @_;
  return $self->{chan}{$channel}{user}{$nick}{o}
}
sub ishalfop {
  my ($self,$nick,$channel) = @_;
  return $self->{chan}{$channel}{user}{$nick}{h}
}
sub isvoice {
  my ($self,$nick,$channel) = @_;
  return $self->{chan}{$channel}{user}{$nick}{v}
}
sub ispresent {
  my ($self,$nick,$channel) = @_;
  return $self->{chan}{$channel}{user}{$nick}{present}
}

sub joinchannel {
  my ($self,$channel) = @_;
  $self->output("JOIN $channel\r\n")
}
sub partchannel {
  my ($self,$channel) = @_;
  $self->output("PART $channel\r\n")
}
sub numusers {
  my ($self,$channel) = @_;
  my %users=%{$self->{chan}{$channel}{user}};
  my @nicks=();
  foreach my $nick (keys %users) {
    push @nicks,$nick
  }
  return 0+@nicks
}
sub userlist {
  my ($self,$channel) = @_;
  my %users=%{$self->{chan}{$channel}{user}};
  my $nicks=[];
  foreach my $nick (keys %users) {
    push @$nicks,$nick
  }
  return $nicks
}

sub hopchannel {
  my ($self,$channel) = @_;
  $self->partchannel($channel);
  $self->joinchannel($channel)
}

sub whois {
  my ($self,$nick,$event) = @_; # $event = \&mysub($ptr to hashinfo)
  if ($self->{nicklist}{$nick}) {
    # we need an event because we can only respond when the whois is finished on raw 318
    unshift @{$self->{infolist}},$self->{nicklist}{$nick}; # make this a priority
    $self->{nicklist}{$nick}{info}=0; # mark as being unread otherwise event will not fire
    if (defined($event)) {
      $self->{infoevents}{$nick}=$event;
    }
  } else {
    # nick already quit
    &$event({})
  }
}

sub gettopic {
  my ($self,$channel) = @_;
  return $self->{chan}{$channel}{topic}
}

sub topic {
  my ($self,$channel,$topic) = @_;
  $self->output("TOPIC $channel \:$topic\r\n")
}

sub chanserv_topic {
  my ($self,$channel,$topic) = @_;
  $self->msg("ChanServ","SET $channel TOPIC $topic\r\n")
}

sub setmode {
  my ($self,$channel,$nick,$mode) = @_;
  $self->output("MODE $channel +$mode $nick\r\n")
}
sub unsetmode {
  my ($self,$channel,$nick,$mode) = @_;
  $self->output("MODE $channel -$mode $nick\r\n")
}

###########################################################################

sub ascii {
  my ($self,$curline) = @_;
  for (my $i=0;$i<length($curline);$i++) {
    my $c=substr($curline,$i,1);
    print "[";
    if ((ord($c)!=13) && (ord($c)!=10)) { print $c }
    print "=".ord($c)."]"
  }
  print "\n";
}

sub processinput {
  my ($self,$line)=@_;

  # strip colors, bold, inverse, underline, italic
  $line =~ s/\x03[0-9]{1,2}(,[0-9]{1,2})?//g;
  my $process="";
  for (my $i=0;$i<length($line);$i++) {
    my $c=substr($line,$i,1);
    my $o=ord($c);
    if (($o>=32) || ($o==10) || ($o==1)) { # 1 is used for CTCP, 10 is newline
      $process.=$c
    }
  }
  if ($self->{verbose}) {
    my @s=split(/\s/,$process);
    if ($s[1] !~ /[^0-9]/) {
      if (($s[1]<=300) || ($s[1]>=320)) {
        if ($self->{verbosemotd} || (($s[1] != 372) && ($s[1] != 375) && ($s[1] != 376))) {
          print STDOUT "$process\n";
        }
      }
    } else {
      if ($self->{verboseprivmsg} || ($process !~ /privmsg/i)) {
        if ($self->{verbosepong} || ($process !~ /ping/i)) {
          print STDOUT $process."\n";
        }
      }
    }
  }
  $self->handle($process);
}

sub gaininfo {
  my ($self) = @_;
  my $nick=shift @{$self->{infolist}};
  if ($nick->{present} && !$nick->{info}) {
    my $sock=$self->{socket};
    $self->{infolag}=1;
    $nick->{info}=1;
    print $sock "WHOIS $nick->{nick}\r\n";
    if ($self->{verbosewhois} && $self->{verboseoutput}) { print "--> WHOIS $nick->{nick}\r\n" }
  }
}

sub antiflood {
  my ($self,$raw) = @_;
  if(!$self->{antiflood}) { return 1 }
  # clean up buffer or report spam, and quickly return, this will not completely clean the buffer but will keep it very fast, and in time it will be cleaned!
  foreach my $flood (keys %{$self->{floodbuffer}}) {
    if (time-$flood>=$self->{floodtimeout}) {
      # Timed out
      delete $self->{floodbuffer}{$flood}
    } elsif ($self->{floodbuffer}{$flood}{raw} eq $raw) {
      # Report flood
      return 0
    }
  }
  # Add to buffer
  my $tm=time;
  $self->{floodbuffer}{$tm} = { raw => $raw };
  return 1
}

sub output {
  my ($self,$raw) = @_;
  if ($self->antiflood($raw)) {
    my $pnt=0;
    if (length($raw)>450) {
      my ($pre,@actxt) = split(/\:/,$raw);
      my $ctxt=join(":",@actxt);
      while (length($ctxt)>400) {
        my $txt="";
        if ($pnt) { $txt.="... " }
        my $len=400;
        while (($len>0) && (ord(substr($ctxt,$len-1,1)) != 32)) {
          $len--
        }
        $txt.=substr($ctxt,0,$len);
        $ctxt=substr($ctxt,$len);
        if (length($ctxt)>0) { $txt.=" ..." }
        $txt.="\r\n";
        push $self->{buffer},$pre.":"."$txt";
        $pnt=1
      }
      if (length($ctxt)>0) {
        if ($pnt) { $ctxt="... $ctxt" }
        push $self->{buffer},$pre.":".$ctxt;
      }
    } else {
      push $self->{buffer},$raw
    }
  }
}

sub outputbuffer {
  my ($self) = @_;
  if ($#{$self->{buffer}}>=0) {
    my $sock = $self->{socket};
    my $curtime=gettimeofday();
    if ($#{$self->{buffer}}>=3) {
      my $delta=$curtime-$self->{buffertime};
      if ($delta>$self->{outputdelay}) {
        my $raw=shift $self->{buffer};
        print $sock $raw;
        if ($self->{verboseoutput}) { print "--> $raw" }
        $self->{buffertime}=$curtime;
      }
    } else {
      my $raw=shift $self->{buffer};
      print $sock $raw;
      if ($self->{verboseoutput}) { print "--> $raw" }
      # not much to do, so gain some information :)
      my $gaindelta=$curtime-$self->{infotime};
      if ($gaindelta>$self->{gaindelay}) {
        $self->gaininfo
      }
    }
    $self->{infotime}=$curtime;
  } else {
    my $curtime=gettimeofday();
    my $gaindelta=$curtime-$self->{infotime};
    if (($gaindelta>$self->{gaindelay}) && !$self->{infolag}) {
      $self->gaininfo;
      $self->{infotime}=$curtime;
    }
  }
}

sub handle {
  # Handle IRCD input and redirect it or react to it.
  my ($self,$msg)=@_;
  my $sock=$self->{socket};
  my @s=split(/\s/,$msg);
  if (substr($msg,0,5) eq 'ERROR') {
    $self->{quit}=1
  }
  if ($msg =~ /Found your hostname/i) {
    $self->{server}=shift @s;
    if ($self->{server} eq 'NOTICE') {
      $self->{server}='EFNET'
    }
    print STDOUT "*** Connected to server $self->{servername} ($self->{server})\n";
    return
  }
  if ($msg =~ /ping \:(.+)$/i) {
    my $pong=$1;
    if ($self->{ircnetid}) {
      print $sock "PONG $self->{server} \:$pong\r\n";
      if ($self->{verbosepong}) {
        print STDOUT "--> PONG $self->{server} \:$pong\n";
      }
    } else {
      print $sock "PONG \:$pong\r\n";
      if ($self->{verbosepong}) {
        print STDOUT "--> PONG \:$pong\n";
      }
    }
    $self->{lastping}=gettimeofday();
    return
  }
  my $code=0;
  if ($s[1] eq '001') {
    $self->{server}=substr($s[0],1);
    $self->{nick}=$s[2];
    $self->{me}=$s[2];
  }
  elsif (($s[0] eq $self->{server}) || ($s[0] eq "\:$self->{server}")) {
    # Server messages
    if ($s[1] !~ /[^0-9]/) {
      my $rawfunc="raw_".$s[1];
      if (defined(&$rawfunc)) {
        $self->$rawfunc(@s[2..$#s])
      }
    } elsif ($s[1] eq 'NOTICE') {
      $self->snotice(@s[2..$#s])
    } elsif ($s[1] eq 'MODE') {
      $self->smode(@s[2..$#s])
    }
    return
  }
  if ($s[0] =~ /^:(.+)?\!\~?(.+)?\@(.+)$/) {
    # Client messages
    if ($1 eq $self->{me}) {
      if (!$self->{host}) {
        $self->{host}=$3
      }
      $self->ownmsg(@s[1..$#s]);
    } else {
      $self->message(@s)
    }
    return
  }
}

sub handletimers {
  my ($self)=@_;
  my $curtime=gettimeofday();
  if ($curtime-$self->{lasttimercheck}>$self->{timerdelay}) {
    $self->{lasttimercheck}=$curtime;
    my @list = sort { $self->{timers}{$a}{activate} <=> $self->{timers}{$b}{activate} } keys %{$self->{timers}};
    foreach my $timer (@list) {
      if ($self->{timers}{$timer}{activate}>$curtime) { return } # we're done, rest of timers is later then now
      # fire event
      my $proc=$self->{timers}{$timer}{event};
      &$proc($timer,$curtime,$self->{timers}{$timer}{repeat});
      if ($self->{timers}{$timer}{repeat}>0) {
        $self->{timers}{$timer}{repeat}--;
        if ($self->{timers}{$timer}{repeat}==0) {
          $self->deltimer($timer)
        } else {
          $self->{timers}{$timer}{activate}+=$self->{timers}{$timer}{seconds}
        }
      } else {
        $self->{timers}{$timer}{activate}+=$self->{timers}{$timer}{seconds}
      }
    }
  }
}


sub event {
  my ($self,$level,$event,$message,$channel,$nick,$ident,$host) = @_;
  # level 0 = me
  # level 1 = server
  # level 2 = nick/channel
  if ($self->{events}{$event}) {
    $event=lc($event);
    if (substr($channel,0,1) eq ':') {
      $channel=substr($channel,1)
    }
    my $func=$self->{events}{$event};
    if ($self->{verboseevents}) {
      if ($self->{verbosewhois} || ($event ne 'whois')) {
        if ($self->{verboseprivmsg} || ($event ne 'privmsg')) {
          print STDOUT "*** Calling $event -> $level,$message,$channel,$nick,$ident,$host\n";
        }
      }
    }
    &$func($level,$message,$channel,$nick,$ident,$host)
  }
}

sub stripinfo {
  my ($self,@params) = @_;
  shift @params;
  $params[0]=substr($params[0],1,length($params[0])-1);
  return join(" ",@params)
}

sub masksplit {
  my ($self,$mask) = @_;
  $mask =~ s/\~//g;
  if ($mask =~ /^:(.+)?\!(.+)?\@(.+)$/) {
    my $ident=$2;
    $ident =~ s/\~//g;
    return ($1,$ident,$3);
  }
}

sub parsemodes {
  my ($self,$modes,$hash) = @_;
  my $i=0; my $a=1; my $l=length($modes);
  while ($i<$l) {
    my $c=substr($modes,$i,1);
    if ($c ne ':') {
      if ($c eq '+') { $a=1 }
      elsif ($c eq '-') { $a=0 }
      else {
        $hash->{$c}=$a;
      }
    }
    $i++
  }
}

sub gettime {
  my @t=localtime();
  my $sec=$t[0]; if ($sec<10) { $sec="0$sec" }
  my $min=$t[1]; if ($min<10) { $min="0$min" }
  my $hr=$t[2]; if ($hr<10) { $hr="0$hr" }
  return "[$hr:$min:$sec]"
}

sub joinchannels {
  my ($self) = @_;
  if (!$self->{alreadyjoined}) {
    print STDOUT "*** Joining channels.. \n";
    my $sock=$self->{socket};
    foreach my $chan (@{$self->{channels}}) {
      print $sock "JOIN $chan\r\n";
      if ($self->{verboseoutput}) { print "--> JOIN $chan\r\n" }
    }
  }
}

sub nickservtest {
  my ($self) = @_;
  if ($self->{nsnick} && !$self->{nickservtested}) {
    my $sock=$self->{socket};
    # fire whois for verification
    print $sock "WHOIS $self->{nsnick}\r\n";
    print "*** Checking NickServ '$self->{nsnick}'\n"
  } else {
    $self->{nickservtested}=1
  }
}

sub nickservidentify {
  my ($self) = @_;
  my $sock=$self->{socket};
  # fire identify
  print $sock "PRIVMSG $self->{nsnick} :IDENTIFY $self->{password}\r\n";
}

sub nickservmsg {
  my ($self,$message) = @_;
  my $sock=$self->{socket};
  if ($message =~ /nickname.+?not.+?registered/i) {
    # register our nick
    print "*** Registering our nick to NickServ\n";
    print $sock "PRIVMSG $self->{nsnick} :REGISTER $self->{password}\r\n";
  }
  elsif ($message =~ /password.+?remember/i) {
    # registered succesfully
    print "*** Succesfully Registered our nick to NickServ\n";
    $self->joinchannels
  }
  elsif ($message =~ /password.+?accepted/i) {
    print "*** Identified to NickServ\n";
    $self->joinchannels
  }
  elsif ($message =~ /already.+?identified/i) {
    print "*** Already identified to NickServ\n";
    $self->joinchannels
  }
}

sub initconnect {
  my ($self) = @_;
  if (!$self->{nickservtested}) {
    $self->nickservtest
  }
  if ($self->{nickservtested}) {
    $self->joinchannels
  }
}

##########################################################################

################  Server events

sub snotice {
  my ($self,@params) = @_;
  print STDOUT "*** SNOTICE ".$self->stripinfo(@params)."\n";
  $self->event(0,'notice',@params)
}

sub smode {
  my ($self,@params) = @_;
  my $chan=$params[0];
  $self->parsemodes($params[1],$self->{chan}{$chan}{modes});
  $self->event('mode',$params[1],$chan)
}

#################  Own events

sub ownmode {
  my ($self,@params) = @_;
  if ($params[0] eq $self->{me}) {
    $self->parsemodes($params[1],$self->{modes},1);
    $self->event(0,'mode',substr($params[1],1),undef,$self->{nick},$self->{ident},$self->{host});
  }
  print STDOUT "*** OWNMODE ".substr($params[1],1)."\n";
}

sub ownjoin {
  my ($self,$channel) = @_;
  $self->{chan}{$channel}={ modes => {} };
  print STDOUT "*** JOINED $channel\n";
  $self->event(0,"join","",$channel,$self->{nick},$self->{ident},$self->{host})
}

#################  User events

sub privmsg {
  my ($self,$channel,$message,$nick,$ident,$host) = @_;
  if ($message =~ /^\001VERSION\001$/) {
    print STDOUT "* ".$self->gettime." <$nick> VERSION -> $self->{version}\n";
    $self->event(2,'version',undef,undef,$nick,$ident,$host);
    $self->notice($nick,"\001VERSION $self->{version}\001")
  } else {
    print STDOUT $self->gettime." $channel <$nick> $message\n";
    if ($channel =~ /\#/) {
      $self->event(2,"privmsg",$message,$channel,$nick,$ident,$host)
    } else {
      $self->event(2,"privmsg",$message,$nick,$nick,$ident,$host)
    }
  }
}

sub joined {
  my ($self,$channel,$message,$nick,$ident,$host) = @_;
  print STDOUT $self->gettime." * $nick joined $channel\n";
  if (!$self->{chan}{$channel}{user}{$nick}) {
    $self->{chan}{$channel}{user}{$nick}={}
  }
  $self->{chan}{$channel}{user}{$nick}{nick}=$nick;
  $self->{chan}{$channel}{user}{$nick}{present}=1;
  $self->{chan}{$channel}{user}{$nick}{o}=0;
  $self->{chan}{$channel}{user}{$nick}{h}=0;
  $self->{chan}{$channel}{user}{$nick}{v}=0;
  if (!$self->{nicklist}{$nick}) {
    $self->{nicklist}{$nick} = { nick => $nick, present => 1, info => 0 }
  } else {
    $self->{nicklist}{$nick}{present}=1
  }
  if (!$self->{nicklist}{$nick}{info}) {
    push @{$self->{infolist}},$self->{nicklist}{$nick};
  }
  $self->event(2,"join",undef,$channel,$nick,$ident,$host);
}

sub parted {
  my ($self,$channel,$message,$nick,$ident,$host) = @_;
  print STDOUT $self->gettime." * $nick parted $channel\n";
  delete $self->{chan}{$channel}{user}{$nick};
  $self->event(2,"part",undef,$channel,$nick,$ident,$host)
}

sub quit {
  my ($self,$channel,$message,$nick,$ident,$host) = @_;
  print STDOUT $self->gettime." * $nick\!$ident\@$host quit ($message)\n";
  my $chans=[];
  delete $self->{nicklist}{$nick};
  foreach my $chan (keys %{$self->{chan}}) {
    if ($self->{chan}{$chan}{user}{$nick}) {
      delete $self->{chan}{$chan}{user}{$nick};
      push @$chans,$chan
    }
  }
  $self->event(2,"quit",$message,$chans,$nick,$ident,$host)
}

sub mode {
  my ($self,$channel,$message,$nick,$ident,$host) = @_;
  print STDOUT $self->gettime." * $channel: $nick set modes $message\n";
  # process channel mode-list
  my ($modes,@nicks) = split(/ /,$message);
  my $a=1;
  my $p=0;
  my $nr=0;
  my $msg=[];
  while ($p<length($modes)) {
    my $c=substr($modes,$p,1);
    if ($c eq '+') { $a=1 }
    elsif ($c eq '-') { $a=0 }
    else {
      $self->{chan}{$channel}{user}{$nicks[$nr]}{$c}=$a;
      push @$msg,{ nick => $nicks[$nr], mode => $c, set => $a };
      if ($a && ($nicks[$nr] eq $self->{me})) {
        # check prevent modes, ethics!
        if (($c eq 'o') && $self->{preventop}) {
          $self->raw("MODE",$channel,"-o $self->{me}",1)
        }
        if (($c eq 'h') && $self->{preventhalfop}) {
          $self->raw("MODE",$channel,"-h $self->{me}",1)
        }
        if (($c eq 'v') && $self->{preventvoice}) {
          $self->raw("MODE",$channel,"-v $self->{me}",1)
        }
      }
      $nr++
    }
    $p++
  }
  $self->event(2,'mode',$msg,$channel,$nick,$ident,$host)
}

sub nick {
  my ($self,$tonick,$nick,$ident,$host) = @_;
  print "*** $nick has changed nick to $tonick\n";
  $self->{nicklist}{$tonick} = { %{$self->{nicklist}{$nick}} }; # new pointer so we can delete old
  $self->{nicklist}{$tonick}{nick}=$tonick;
  delete $self->{nicklist}{$nick};
  foreach my $chan (keys %{$self->{chan}}) {
    if ($self->{chan}{$chan}{user}{$nick}) {
      $self->{chan}{$chan}{user}{$tonick} = { %{$self->{chan}{$chan}{user}{$nick}} };
      $self->{chan}{$chan}{user}{$tonick}{nick}=$tonick;
      if (!$self->{chan}{$chan}{user}{$tonick}{prevnick}) {
        $self->{chan}{$chan}{user}{$tonick}{prevnick}=[$nick]
      } else {
        push @{$self->{chan}{$chan}{user}{$tonick}{prevnick}},$nick
      }
      delete $self->{chan}{$chan}{user}{$nick};
    }
  }
  $self->event(2,'nick',$tonick,undef,$nick,$ident,$host)
}

sub noticed {
  my ($self,$message,$nick,$ident,$host) = @_;
  if ($self->{nsfound} && ($self->{nsnick} eq $nick) && ($self->{nsident} eq $ident) && ($self->{nshost} eq $host)) {
    $self->nickservmsg($message)
  } else {
    print "*** NOTICE <$nick> $message\n";
    $self->event(2,"notice",$message,undef,$nick,$ident,$host)
  }
}

sub topicset {
  my ($self,$channel,$topic,$nick,$ident,$host) = @_;
  $self->{chan}{$channel}{topic}=$topic;
  print "* $nick changed topic of $channel to '$topic'\n"
}

#################  Event control

sub ownmsg {
  my ($self,@params) = @_;
  if ($params[0] eq 'MODE') {
    $self->ownmode(@params[1..$#params]);
  } elsif ($params[0] eq 'JOIN') {
    my $chan=substr($params[1],1);
    $self->ownjoin($chan);
  }
}

sub message {
  my ($self,@params) = @_;
  if ($params[1] eq 'PRIVMSG') {
    $self->privmsg($params[2],join(" ",substr($params[3],1),@params[4..$#params]),$self->masksplit($params[0]))
  } elsif ($params[1] eq 'JOIN') {
    $self->joined(substr($params[2],1),undef,$self->masksplit($params[0]))
  } elsif ($params[1] eq 'PART') {
    $self->parted($params[2],undef,$self->masksplit($params[0]))
  } elsif ($params[1] eq 'QUIT') {
    $self->quit(undef,join(" ",substr($params[2],1),@params[3..$#params]),$self->masksplit($params[0]))
  } elsif ($params[1] eq 'MODE') {
    $self->mode($params[2],join(" ",@params[3..$#params]),$self->masksplit($params[0]))
  } elsif ($params[1] eq 'NICK') {
    $self->nick(substr($params[2],1),$self->masksplit($params[0]))
  } elsif ($params[1] eq 'NOTICE') {
    $self->noticed(join(" ",substr($params[3],1),@params[4..$#params]),$self->masksplit($params[0]))
  } elsif ($params[1] eq 'TOPIC') {
    $self->topicset($params[2],join(" ",substr($params[3],1),@params[4..$#params]),$self->masksplit($params[0]))
  }
}


#######################  R  A  W  ############################################

sub raw_001 {
  # server welcome message
  my ($self,@params) = @_;
  if ($self->{server} eq 'EFNET') {
    $self->{server}=substr($params[0],1)
  }
  $self->{nick}=$params[1];
  $self->{me}=$params[1];
  $self->{serverwelcome}=$self->stripinfo(@params);
  $self->event(1,'serverwelcome',$self->{serverwelcome});
  print "*** Server = $self->{server} nick=$self->{nick}\n";
}

sub raw_002 {
  # server info message
  my ($self,@params) = @_;
  $self->{serverinfo}=$self->stripinfo(@params);
  $self->event(1,'serverinfo',$self->{serverinfo})
}

sub raw_003 {
  # server created message
  my ($self,@params) = @_;
  $self->{servercreated}=$self->stripinfo(@params);
  $self->event(1,'servercreated',$self->{servercreated})
}

sub raw_004 {
  # server identification message
  my ($self,@params) = @_;
  $self->{serverversion}=$params[2];
  $self->{usermodes}=$params[3];
  $self->{chanmodes}=$params[4];
  $self->event(1,'serverident',join(" ",@params))
}

sub raw_005 {
  # server properties message
  my ($self,@params) = @_;
  shift @params;
  foreach my $prop (@params) {
    if (substr($prop,0,1) eq ':') { return }
    my ($key,$val)=split(/=/,$prop);
    $key=lc($key);
    $self->{serverprop}{$key}=$val;
  }
  $self->event(1,'serverprop',join(" ",@params))
}

sub raw_042 {
  # IRCNet ID
  my ($self,@params) = @_;
  $self->{ircnetid}=$params[1]
}

sub raw_250 {
  # total connections
  my ($self,@params) = @_;
  $self->{totalconnections}=substr($params[7],1);
  $self->event(1,'serverconn',join(" ",@params))
}

sub raw_251 {
  # number of connections
  my ($self,@params) = @_;
  $self->{numusers}=$params[3];
  $self->{invisibleusers}=$params[6];
  $self->{totalusers}=$self->{numusers}+$self->{invisibleusers};
  $self->{numservers}=$params[9];
  $self->event(1,'servernumusers',join(" ",@params))
}

sub raw_252 {
  # number of operators
  my ($self,@params) = @_;
  $self->{numopers}=$params[1];
  $self->event(1,'serveropers',join(" ",@params))
}

sub raw_254 {
  # number of channels
  my ($self,@params) = @_;
  $self->{numchannels}=$params[1];
  $self->event(1,'servernumchans',join(" ",@params))
}

sub raw_266 {
  # global connection stats
  my ($self,@params) = @_;
  $self->{maxconnections}=$params[7];
  $self->event(1,'serverglobconn',join(" ",@params))
}

sub raw_301 {
  # Whois - Away
  my ($self,@params) = @_;
  my $nick = $params[1];
  my $msg=substr($params[2],1)." ".join(" ",@params[3..$#params]);
  $self->{nicklist}{$nick}{away}=$msg;
}

sub raw_311 {
  # Whois
  my ($self,@params) = @_;
  my $nick = $params[1];
  my $ident = $params[2];
  my $host = $params[3];
  my $desc = join(" ",substr($params[5],1),@params[6..$#params]);
  $self->{nicklist}{$nick}{away}=""; # reset before 301 event.
  $self->{nicklist}{$nick}{desc}=$desc;
  $self->{nicklist}{$nick}{ident}=$ident;
  $self->{nicklist}{$nick}{ident} =~ s/\~//g;
  $self->{nicklist}{$nick}{host}=$host;
  if ($host =~ /[^0-9\.]/) {
    # host is no IP, so find IP
    $self->{nicklist}{$nick}{ip}=join('.',unpack('C4',inet_aton($host)))
  } else {
    $self->{nicklist}{$nick}{ip}=$host
  }
}
sub raw_312 {
  # Whois - Server
  my ($self,@params) = @_;
  my $nick = $params[1];
  $self->{nicklist}{$nick}{server}=$params[2];
}

sub raw_313 {
  # Whois - IRC-admin
  my ($self,@params) = @_;
  my $nick = $params[1];
  $self->{nicklist}{$nick}{admin}=1;
}

sub raw_317 {
  # Whois - Idle time & Signon time
  my ($self,@params) = @_;
  my $nick = $params[1];
  my $tm=localtime($params[3]);
  $self->{nicklist}{$nick}{idle}=$params[2];
  $self->{nicklist}{$nick}{signon}=$params[3];
}

sub raw_318 {
  # End of Whois
  my ($self,@params) = @_;
  $self->{infolag}=0; # sign we're ready for next info-call
  my $nick = $params[1];
  if (!$self->{nickservtested} && ($nick eq $self->{nsnick})) {
    $self->{nickservtested}=1;
    if (($self->{nicklist}{$nick}{ident} eq $self->{nsident}) && ($self->{nicklist}{$nick}{host} eq $self->{nshost})) {
      $self->{nsfound}=1;
      print "*** NickServ found as '$nick'... Identifying\n";
      $self->nickservidentify
    } else {
      print "*** NickServ '$nick' has a different host than expected\n";
      $self->joinchannels
    }
  } else {
    if ($self->{infoevents}{$nick}) {
      my $proc=$self->{infoevents}{$nick};
      &$proc($self->{nicklist}{$nick});
      # remove in case of quit/join of user (event would fire)
      delete $self->{infoevents}{$nick}
    }
    $self->event(1,'whois',$nick,$self->{nicklist}{$nick}{ident},$self->{nicklist}{$nick}{host})
  }
}

sub raw_319 {
  # Whois channel list
  my ($self,@params) = @_;
  my $nick = $params[1];
  my @chans = (substr($params[2],1),@params[3..$#params]);
  foreach my $wchan (@chans) {
    if ($wchan =~ /([\+\@\%]*)?\#(.*)/) {
      my $modes=$1; my $fchan="#".$2;
      foreach my $chan (keys %{$self->{chan}}) {
        if ($chan eq $fchan) {
          if ($modes =~ /\@/) {
            $self->{chan}{$chan}{user}{$nick}{o}=1
          }
          if ($modes =~ /\%/) {
            $self->{chan}{$chan}{user}{$nick}{h}=1
          }
          if ($modes =~ /\+/) {
            $self->{chan}{$chan}{user}{$nick}{v}=1
          }
        }
      }
    }
  }
}

sub raw_332 {
  # Topic
  my ($self,@params) = @_;
  my $chan=$params[1];
  $self->{chan}{$chan}{topic}=substr($params[2],1)." ".join(" ",@params[3..$#params]);
  $self->event(1,'topic',join(" ",@params))
}

sub raw_333 {
  # Topic set by, and time
  my ($self,@params) = @_;
  my $chan=$params[1];
  $self->{chan}{$chan}{topicowner}=$params[2];
  $self->{chan}{$chan}{topictime}=$params[3];
  $self->{chan}{$chan}{user}={};
  $self->event(1,'topicident',join(" ",@params))
}

sub raw_353 {
  # Channel Names list
  my ($self,@params) = @_;
  my $chan=$params[2];
  $params[3]=substr($params[3],1);
  for (my $i=3;$i<=$#params;$i++) {
    my $nick=$params[$i];
    $nick =~ s/[+%@]//g;
    $self->{chan}{$chan}{user}{$nick}={};
    my $voice=0; my $op=0; my $halfop=0;
    my $pre=substr($params[$i],0,1);
    if ($pre eq '+') { $voice=1 }
    if ($pre eq '@') { $op=1 }
    if ($pre eq '%') { $halfop=1 }
    $self->{chan}{$chan}{user}{$nick}{nick}=$nick;
    $self->{chan}{$chan}{user}{$nick}{o}=$op;
    $self->{chan}{$chan}{user}{$nick}{h}=$halfop;
    $self->{chan}{$chan}{user}{$nick}{v}=$voice;
    $self->{chan}{$chan}{user}{$nick}{present}=1;
    if (!$self->{nicklist}{$nick}) {
      $self->{nicklist}{$nick} = { nick =>$nick, present => 1, info => 0 }
    }
    if (!$self->{nicklist}{$nick}{info}) {
      push @{$self->{infolist}},$self->{nicklist}{$nick}
    }
  }
  $self->event(1,'names',join(" ",@params))
}

sub raw_366 {
  # end of names list
  my ($self,@params) = @_;
  my $chan=$params[1];
  $self->event(1,"joined",$chan,join(" ",@params))
}

sub raw_372 {
  # MOTD
  my ($self,@params) = @_;
  $self->{motd}.=$self->stripinfo(@params)."\n";
  $self->event(1,'motd',join(" ",@params))
}

sub raw_375 {
  # start of MOTD
  my ($self,@params) = @_;
  if ($self->{motd}) { $self->{alreadyjoined}=1 }
  $self->{motd}="";
  $self->event(1,'motdstart',join(" ",@params))
}

sub raw_376 {
  # end of MOTD
  my ($self,@params) = @_;
  if ($self->{verbosemotd}) {
    print "*** END OF MOTD\n";
  }
  $self->initconnect;
  $self->event(1,'motdend',join(" ",@params))
}

sub raw_401 {
  # no such nick/channel
  my ($self,@params) = @_;
  my $nick=$params[1];
  if (!$self->{nickservtested} && ($nick eq $self->{nsnick})) {
    # nickserv check failed
    $self->{nickservtested}=1;
    print "*** NickServ not found!\n";
    $self->joinchannels;
  } else {
    print "*** ERROR Nick/Channel '$nick' does not exist!\n";
    $self->event(1,"nosuch",join(" ",@params))
  }
}

sub raw_421 {
  # unknown command
  my ($self,@params) = @_;
  print "\n*!*!*!*! WARNING !*!*!*!*\n";
  print "Unknown command: ".join(" ",@params)."\n\n";
}

sub raw_422 {
  # MOTD file is missing
  my ($self,@params) = @_;
  if ($self->{verbosemotd}) {
    print "*** MOTD FILE MISSING\n";
  }
  $self->initconnect;
  $self->event(1,'nomotd',join(" ",@params))
}

sub raw_432 {
  # erroneus nickname
  my ($self,@params) = @_;
  $self->event(1,"nickerror",join(" ",@params));
  $self->{quit}=1;
  print "*** ERROR: Erroneus Nickname\n"
}

sub raw_433 {
  # nickname already in use
  my ($self,@params) = @_;
  my $sock=$self->{socket};
  print $sock "NICK $self->{altnick}\r\n";
  if ($self->{verboseoutput}) { print "--> NICK $self->{altnick}\r\n" }
  $self->{me}=$self->{altnick};
  print STDOUT "*** Changed nick to '$self->{altnick}'\n";
  $self->event(1,'nickinuse',join(" ",@params))
}

sub raw_436 {
  # nickname collision
  my ($self,@params) = @_;
  if ($self->{me} eq $self->{altnick}) {
    $self->{quit}=1;
    print "*** ERROR: Nick Collision\n"
  } else {
    my $sock=$self->{socket};
    print $sock "NICK $self->{altnick}\r\n";
    if ($self->{verboseoutput}) { print "--> NICK $self->{altnick}\r\n" }
    $self->{me}=$self->{altnick};
    print STDOUT "*** Changed nick to '$self->{altnick}'\n";
  }
  $self->event(1,"nickcollision",join(" ",@params));
}

sub raw_482 {
  # not a channel operator
  my ($self,@params) = @_;
  $self->event(1,"notchanop",$params[1],join(" ",@params))
}

########### EOF ###################
