#!/usr/bin/perl -w
# reception_bot.pl A simple IRC robot that accepts DNA submitted through IRC

# rik letsmakerobots.com 20100619
# should no longer accept multiple pieces simultaniously

use strict;
use IO::Socket;

$| = 1;

# The server to connect to and our details.
#my $server1 = "chat.freenode.net";
#my $server2 = "irc.freenode.net";
#my $server1 = "chat1.ustream.tv";
#my $server2 = "c.ustream.tv";
#my $login = "abc";
#my $reception_bot = "reception_bot";

# The channel which the bot will join.
my $channel = "#DarwinBot";

# Connect to the IRC server.
print "connecting $server1\n";
my $sock ;
if ($sock = new IO::Socket::INET(PeerAddr => $server1, PeerPort => 6667, Proto => 'tcp') ) {
   1;
} else {
   warn "Can't connect $server1\n";
   print "connecting $server2\n";
   $sock = new IO::Socket::INET(PeerAddr => $server2, PeerPort => 6667, Proto => 'tcp') or die "Can't connect $server2 either\n";
}

# Log on to the server.
#print       "NICK $moderator\r\n";
#print $sock "NICK $moderator\r\n";
print       "NICK $reception_bot\r\n";
print $sock "NICK $reception_bot\r\n";
#print       "PASS $login\r\n";
#print $sock "PASS $login\r\n";
print       "USER $login 8 * :Perl IRC test\r\n";
print $sock "USER $login 8 * :Perl IRC test\r\n";

# Read lines from the server until it tells us we have connected.
while (my $input = <$sock>) {
    chop $input;
    #print " ... $input\n";
    # Check the numerical responses from the server.
    if ($input =~ / 376 /) {
        # end of motd
        print "$input\n";
        last;
    } elsif ($input =~ /433/) {
        die "Nickname is already in use.";
    }
}

# Join the channel.
print "joining $channel\n";
print $sock "JOIN $channel\r\n";
while (my $input = <$sock>) {
   last if $input =~ / 366 /;
}

#print       "NICK $reception_bot\r\n";
#print $sock "NICK $reception_bot\r\n";

my ($usernick, $useraddress, $msgcmd, $msgtgt, $usermsg);
my ($cont_name, $cont_nick, $cont_dna);

my $timeout = 100;
my $input;

# Keep reading lines from the server.
#while (my $input = <$sock>) {
while (1) {
eval {
   local $SIG{ALRM} = sub { die "alarm\n" }; # NB: \n required
   alarm $timeout;
   #$nread = sysread SOCKET, $buffer, $size;
   $input = <$sock>;
   alarm 0;
};
if ($@) {
   die unless $@ eq "alarm\n"; # propagate unexpected errors
   print "timeout $timeout s timed out\n";
   # timed out
}
   else {
   # didn't time out
   #print $input;
}

    #chomp $input; # chop or chomp or both ?!!?!
    #chop  $input; # chop or chomp or both ?!!?! And in which order!?
    $input =~ s/[\r\n]*$// ;   # or just get rid of all of them!

    if ($input =~ /^PING(.*)$/i) {
        # We must respond to PINGs to avoid being disconnected.
        print $sock "PONG $1\r\n";
        next;
    } else {
        # Print the raw line received by the bot.
       # print "$input\n";
    }

    # typical line from a channel reads
    # :riklmr-1!~rik@doverkant.xs4all.nl PRIVMSG #darwinbot :hello world
    if ($input =~ /\:(\S+)\!(\S+)\s+(PRIVMSG)\s+(\S+)\s+\:(.*)/) {
       ($usernick, $useraddress, $msgcmd, $msgtgt, $usermsg) = ($1, $2, $3, $4, $5);
       #print "<$usernick> $usermsg\n";

       if ($cont_name) {
        if ($usernick eq $cont_nick) {
          if ($usermsg =~ /[\'\`\;]\s*end/) {
             $cont_dna .= "$usermsg\n";
             print $sock "PRIVMSG $channel :now storing DNA named \"$cont_name\" submitted by $usernick ...\n";
             print "#\n";
             #print "DNA =\n$cont_dna\n";
             if (open DNA, "> /ae/submitted/$cont_name.bas") {
                print DNA "$cont_dna\n";
                close DNA;
             } else {
                warn "$0: cannot write to dna file: $!\n";
                print $sock "PRIVMSG $channel :unable to write DNA to disk: $!\n";
             }
             ($cont_name, $cont_nick, $cont_dna) = ();
          } else {
             print ".";
             $cont_dna .= "$usermsg\n";
          }
        }
       } elsif ($usermsg =~ /[\'\`\;]\s*accept/) {
          $cont_name = mk_cont_name();
          while ((-e "/ae/submitted/$cont_name") || (-e "/ae/done/$cont_name")) {
             $cont_name = mk_cont_name();
          }
          $cont_nick = $usernick;
          $cont_dna = "\' meta author=$cont_nick name=$cont_name endmeta\n";
          print "$cont_name";
          print $sock "PRIVMSG $channel :now accepting DNA named \"$cont_name\" to be submitted by $cont_nick ...\n";
       }
    }

}

sub mk_cont_name {
   my @ay = qw(a e i o u y);
   my @fz = qw(f g h j l m n r s v w y z);
   my @bt = qw(b c d k p q t);
   my $name ;
   $name .= $bt[rand($#bt)];
   $name .= $ay[rand($#ay)];
   $name .= $fz[rand($#fz)];
   $name .= $bt[rand($#bt)];
   $name .= $ay[rand($#ay)];
   return $name;
}