#!/usr/bin/perl
###########################################################################
# AssBot
# Copyright (C) 2002, http://arctec.org
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the license, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,USA.
#
# Contact:
# web@arctec.org for issues regarding this program.
###########################################################################
# AssBot - (c) http://arctec.org
#
# AssBot is a NET::IRC bot that I threw together just to
# experiment. See next line for what it's based off of.
#
# All code is (c) 2002 Rando Christensen <rando@babblica.net>
#
# Notable features are the ascii image feature, and the
# tribes server list feature.
#
# AssBot - http://arctec.org/projects/
###########################################################################
# Connect to DB for word storage
use DBI;
use Net::IRC;
$db = "table";
$ho = "localhost";
$us = "login";
$pw = "password";
$debug = 1; #1 = print debug crap
my $dbh = DBI->connect("DBI:mysql:database=$db:host=$ho",
$us, $pw, {RaiseError => 1});
# Logging
open LOG, '>>/usr/local/neoborg-0.99/assbot.log';
# Connect to IRC server
$nk = "AssBot";
$sv = "irc.comething.com";
$un = "AssBot";
$in = create_sentence("teh-borg"); # Username is randomly generated
$mainchan = "#mainchan"; # main channel. cannot be removed from this channel.
@chanlist = ('#otherchan');
$irc = new Net::IRC;
$con = $irc->newconn(Nick => $nk,
Server => $sv,
Username => $un,
Ircname => $in);
# Set up initials
foreach $chan ($mainchan,@chanlist) {
$awake{$chan} = 0;
$rate{$chan} = 10;
}
# IRC Handlers
$con->add_handler('public', \&on_pub);
$con->add_handler('join', \&on_join);
#$con->add_handler('chat', \&on_chat);
$con->add_handler('cdcc', \&on_dcc);
$con->add_global_handler('376', \&on_connect);
$irc->start;
exit(0);
close LOG;
###### subs
sub neoparse {
my $self = shift;
my $event = shift;
my $line = shift;
my $mynick = $self->nick;
my ($channel) = ($event->to)[0];
my @words = map { drop_punc($_); } split(' ', $line);
for ($i = 0;$i <= $#words;$i++) {
rec_next($i,$i+1,$i+2,@words);
rec_prev($i,$i-1,$i-2,@words);
}
if ( $line =~ /^!wakeup/ ) { $awake{$channel} = 1; borg_speak($self,$event,"wakeup"); }
elsif ( $line =~ /^!shutup/ ) { $awake{$channel} = 0; borg_speak($self,$event,"shutup"); }
#elsif ( $line =~ /^$mynick[:,!]\s+/ ) { print LOG ("*** reply\n"); borg_speak($self,$event,$words[int rand scalar @words] ); }
elsif ( $line =~ /^!words/ ) { borg_words($self,$event); }
elsif ( $line =~ /^!help/ ) { borg_help($self,$event); }
elsif ( $line =~ /^!fbserv/ ) { fbserv($self,$event); }
elsif ( $line =~ /^!joinchan (\S+)/ ) { join_chan($self,$event,$1); }
elsif ( $line =~ /^!partchan (\S+)/ ) { part_chan($self,$event,$1); }
elsif ( $line =~ /^!rate (\d+)/ ) { set_rate($self,$event,$1); }
elsif ( $line =~ /^!ascii (\S+)/ ) { ascii($self, $event,$1); }
#elsif ( ($awake{$channel}>0) && ( (int rand $rate{$channel}) == 1 ) ) {
# print LOG ("*** speaking randomly in $channel\n");
# borg_speak( $self, $event, $words[int rand scalar @words] );
#}
}
sub borg_speak {
my $self = shift;
my $event = shift;
my ($channel) = ($event->to)[0];
my $word = shift;
my $prep = shift or '';
my $sentence = create_sentence($word);
my $target = $event->nick;
if ($prep ne '') { $sentence = "[$prep] $sentence"; }
elsif ( int(rand(50)) == 1 ) { $sentence = "$target: $sentence"; }
print LOG ("*** saying $sentence in $channel\n");
$self->privmsg($channel,$sentence);
}
sub set_rate {
my $self = shift;
my $event = shift;
my $nrate = shift;
my ($channel) = ($event->to)[0];
if ($nrate > 0) {
$rate{$channel} = $nrate;
borg_speak($self,$event,$event->nick,"rate set to $nrate");
}
}
sub borg_help {
my $self = shift;
my $event = shift;
my $tnick = $event->nick;
my $msg = "Commands: !help, !wakeup, !words, !fbserv";
my $msg2 = "To get an ascii image, dcc me a file. Then type !ascii filename. This is case sensitive.";
my $msg3 = "I can only do one thing at a time. If something doesn't work, wait a bit and try again.";
# Also !joinchan, !partchan, !rate
$self->privmsg($tnick,$msg);
$self->privmsg($tnick,$msg2);
$self->privmsg($tnick,$msg3);
}
sub borg_words {
my $self = shift;
my $event = shift;
my ($channel) = ($event->to)[0];
my $next = get_sql_val("SELECT COUNT(word) FROM next");
my $prev = get_sql_val("SELECT COUNT(word) FROM prev");
my $total = $next + $prev;
print LOG ("*** counting words!\n");
$self->privmsg($channel,"I know $total words total."); # : n$next/p$prev!");
}
sub join_chan {
my ($self,$event,$newchan) = @_;
$self->join($newchan);
borg_speak($self,$event,$event->nick,"joining $newchan");
$self->privmsg($newchan,create_sentence($newchan));
push(@chanlist, $newchan);
$awake{$newchan} = 1;
$rate{$newchan} = 10;
}
sub part_chan {
my ($self,$event,$newchan) = @_;
borg_speak($self,$event,$event->nick,"leaving $newchan");
$self->part($newchan);
}
sub rec_prev {
my $word = shift;
my $one = shift;
my $two = shift;
my @val = @_;
sql_add_word('prev',$val[$word],$val[$one],1) unless $one < 0;
sql_add_word('prev',$val[$word],$val[$two],2) unless $two < 0;
}
sub rec_next {
my $word = shift;
my $one = shift;
my $two = shift;
my @val = @_;
sql_add_word('next',$val[$word],$val[$one],1) unless $one > $#val;
sql_add_word('next',$val[$word],$val[$two],2) unless $two > $#val;
}
sub sql_add_word {
my ($table,$word,$xword,$dist) = @_;
my $query = sprintf('INSERT INTO %s (word,xword,distance) VALUES (%s,%s,%s)',
$table, $dbh->quote($word), $dbh->quote($xword),
$dbh->quote($dist));
$dbh->do($query);
}
sub drop_punc {
my $thing = shift;
#$thing =~ s/[\(\)\/\=,:;\.\?]+$//g;
$thing =~ s/[^a-z]+$//g;
return $thing;
}
sub create_sentence {
my $word = shift;
my @sentence = ( $word );
my $prev_total = int rand 10;
my $next_total = int rand 10;
my $prev_count = 0;
my $next_count = 0;
my $lastword = $word;
while ($prev_count <= $prev_total) {
if ( ($prev_total - $prev_count) == 1 ) {
my $append = prev_one($last_word);
unshift(@sentence, $append);
$last_word = $append;
$prev_count += 1;
} else {
my ($append,$append2) = prev_two($last_word);
unshift(@sentence, $append);
unshift(@sentence, $append2);
$last_word = $append2;
$prev_count += 2;
}
}
$lastword = $word;
while ($next_count <= $next_total) {
if ( ($next_total - $next_count) == 1 ) {
my $append = next_one($last_word);
push(@sentence, $append);
$last_word = $append;
$next_count += 1;
} else {
my ($append,$append2) = next_two($last_word);
push(@sentence, $append);
push(@sentence, $append2);
$last_word = $append2;
$next_count += 2;
}
}
$sentence =~ s/\s+/ /g;
$sentence = join(' ', @sentence);
}
sub prev_one {
my $word = shift;
my $retval;
my $q = sprintf('SELECT count(id) FROM prev WHERE word=%s',
$dbh->quote($word) );
my $num = get_sql_val($q);
if ($num > 0) {
my $q1 = sprintf('SELECT id FROM prev WHERE word=%s AND distance=1 ORDER BY RAND() LIMIT 1', $dbh->quote($word) );
my $id = get_sql_val($q1);
my $q2 = sprintf('SELECT xword FROM prev WHERE id=%s', $dbh->quote($id) );
$retval = get_sql_val($q2);
} else {
my $q1 = sprintf('SELECT id FROM prev WHERE distance=1 ORDER BY RAND() LIMIT 1');
my $id = get_sql_val($q1);
my $q2 = sprintf('SELECT xword FROM prev WHERE id=%s', $dbh->quote($id) );
$retval = get_sql_val($q2);
}
return $retval;
}
sub prev_two {
my $word = shift;
my $rv1,$rv2;
my $q = sprintf('SELECT count(id) FROM prev WHERE word=%s',
$dbh->quote($word) );
my $num = get_sql_val($q);
if ($num > 0) {
my $q1 = sprintf('SELECT id FROM prev WHERE word=%s AND distance=1 ORDER BY RAND() LIMIT 1', $dbh->quote($word) );
my $id = get_sql_val($q1);
my $q2 = sprintf('SELECT xword FROM prev WHERE id=%s', $dbh->quote($id) );
$rv1 = get_sql_val($q2);
my $q3 = sprintf('SELECT id FROM prev WHERE word=%s AND distance=2 ORDER BY RAND() LIMIT 1', $dbh->quote($word) );
my $id2 = get_sql_val($q3);
my $q4 = sprintf('SELECT xword FROM prev WHERE id=%s', $dbh->quote($id2) );
$rv2 = get_sql_val($q4);
} else {
my $q1 = sprintf('SELECT id FROM prev WHERE distance=1 ORDER BY RAND() LIMIT 1');
my $id = get_sql_val($q1);
my $q2 = sprintf('SELECT xword FROM prev WHERE id=%s', $dbh->quote($id) );
$rv1 = get_sql_val($q2);
my $rq = sprintf('SELECT word FROM prev WHERE id=%s', $dbh->quote($id) );
my $rword = get_sql_val($rq);
my $q3 = sprintf('SELECT id FROM prev WHERE word=%s AND distance=2 ORDER BY RAND() LIMIT 1', $dbh->quote($rword) );
my $id2 = get_sql_val($q3);
my $q4 = sprintf('SELECT xword FROM prev WHERE id=%s', $dbh->quote($id2) );
$rv2 = get_sql_val($q4);
}
return ($rv1,$rv2);
}
sub next_one {
my $word = shift;
my $retval;
my $q = sprintf('SELECT count(id) FROM next WHERE word=%s',
$dbh->quote($word) );
my $num = get_sql_val($q);
if ($num > 0) {
my $q1 = sprintf('SELECT id FROM next WHERE word=%s AND distance=1 ORDER BY RAND() LIMIT 1', $dbh->quote($word) );
my $id = get_sql_val($q1);
my $q2 = sprintf('SELECT xword FROM next WHERE distance=1 AND id=%s', $dbh->quote($id) );
$retval = get_sql_val($q2);
} else {
my $q1 = sprintf('SELECT id FROM next WHERE distance=1 ORDER BY RAND() LIMIT 1');
my $id = get_sql_val($q1);
my $q2 = sprintf('SELECT xword FROM next WHERE distance=1 AND id=%s', $dbh->quote($id) );
$retval = get_sql_val($q2);
}
return $retval;
}
sub next_two {
my $word = shift;
my $rv1,$rv2;
my $q = sprintf('SELECT count(id) FROM next WHERE word=%s',
$dbh->quote($word) );
my $num = get_sql_val($q);
if ($num > 0) {
my $q1 = sprintf('SELECT id FROM next WHERE word=%s AND distance=1 ORDER BY RAND() LIMIT 1', $dbh->quote($word) );
my $id = get_sql_val($q1);
my $q2 = sprintf('SELECT xword FROM next WHERE id=%s', $dbh->quote($id) );
$rv1 = get_sql_val($q2);
my $q3 = sprintf('SELECT id FROM next WHERE word=%s AND distance=2 ORDER BY RAND() LIMIT 1', $dbh->quote($word) );
my $id2 = get_sql_val($q3);
my $q4 = sprintf('SELECT xword FROM next WHERE id=%s', $dbh->quote($id2) );
$rv2 = get_sql_val($q4);
} else {
my $q1 = sprintf('SELECT id FROM next WHERE distance=1 ORDER BY RAND() LIMIT 1');
my $id = get_sql_val($q1);
my $q2 = sprintf('SELECT xword FROM next WHERE id=%s', $dbh->quote($id) );
$rv1 = get_sql_val($q2);
my $rq = sprintf('SELECT word FROM next WHERE id=%s', $dbh->quote($id) );
my $rword = get_sql_val($rq);
my $q3 = sprintf('SELECT id FROM next WHERE word=%s AND distance=2 ORDER BY RAND() LIMIT 1', $dbh->quote($rword) );
my $id2 = get_sql_val($q3);
my $q4 = sprintf('SELECT xword FROM next WHERE id=%s', $dbh->quote($id2) );
$rv2 = get_sql_val($q4);
}
return ($rv1,$rv2);
}
sub get_sql_val {
my $query = shift;
my @ary = $dbh->selectrow_array($query);
return $ary[0];
}
##### IRC HANDLERS #####
sub on_connect {
my $self = shift;
print LOG ("joining channel $channel\n");
foreach $channel ($mainchan,@chanlist) {
$self->join($channel);
$self->privmsg($channel,create_sentence($channel));
}
}
sub on_pub {
my ($self,$event) = @_;
my ($arg) = ($event->args);
my $whosaid = $event->nick;
my ($inchannel) = ($event->to)[0];
print LOG (" <$whosaid/$inchannel> $arg\n");
&neoparse($self,$event,$arg);
}
sub on_join {
my ($self, $event) = @_;
my ($channel) = ($event->to)[0];
printf LOG ("^_^ %s (%s) has joined channel %s\n",
$event->nick, $event->userhost, $channel);
if ( ( $event->nick ne $self->nick )&&($awake{$channel} > 0) ) {
borg_speak($self,$event,$event->nick);
}
}
sub on_msg {
my ($self, $event) = @_;
my ($nick) = $event->nick;
print LOG "*$nick* ", ($event->args), "\n";
if ($event->args eq "help") {
borg_help($self,$event);
}
# $self->privmsg($nick, &pickrandom()); # Say a Zippy quote.
}
# What to do when we receive a DCC SEND or CHAT request.
sub on_dcc {
my ($self, $event) = @_;
my $type = ($event->args)[1];
my @dccinfo=();
if(!$type) {
@dccinfo=split(" ",($event->args)[0]);
$filename = $dccinfo[1];
$filesize = $dccinfo[4];
$type=uc($dccinfo[0]);
$dccinfo[0]=0; # Not initiating
$dccinfo[1]=$event->nick;
}
if (uc($type) eq 'SEND') {
$path = "/tmp/" . $filename;
open TEST, ">$path"
or do { warn "Can't open test file: $!"; return; };
if(@dccinfo) {
$self->new_get(\@dccinfo, \*TEST);
print LOG "Saving dccinfo DCC SEND to $path\n";
if ( $debug == 1 ) {
$size = @dccinfo;
print LOG "dccinfo[]\n";
for ($i=0; $i<$size; $i++) {
print LOG $i . " " . $dccinfo[$i] . "\n";
}
$size = @_;
print LOG "\@_\n";
for ($i=0; $i<$size; $i++) {
print LOG $i . " " . $_[$i] . "\n";
}
print LOG "event->args[]\n";
for ($i=0; $i<5; $i++) {
$test = ($event->args)[$i];
print LOG $i . " " . $test . "\n";
}
print LOG "filename: " . $filename . "\n";
print LOG "filesize: " . $filesize . "\n";
print LOG "channel: " . ($event->to)[0] . "\n";
print LOG "nick: " . $event->nick . "\n";
}
my ($nick) = $event->nick;
my ($channel) = ($event->to)[0];
$msg = "Thanks, $nick for $filename \( $filesize bytes \)";
$self->privmsg($nick,$msg);
} else {
$self->new_get($event, \*TEST);
print LOG "Saving event DCC SEND to $path\n";
}
} elsif(uc($type) eq 'CHAT') {
if(@dccinfo) {
$self->new_chat(\@dccinfo);
print LOG "DCC CHAT dccinfo: " . @dccinfo . "\n";
} else {
$self->new_chat($event);
print LOG "DCC CHAT event: " . $event . "\n";
}
} else {
print LOG ("Unknown DCC type: " . $type);
}
}
sub fbserv {
my $self = shift;
my $event = shift;
my $tnick = $event->nick;
open SERVERS, "php -q /usr/local/neoborg-0.99/football.php|"
or die print "can't get server list: $!";
$self->privmsg($tnick,"Generating Football Server List...");
undef @bar;
while (<SERVERS>) {
push @bar, $_;
}
$self->privmsg($tnick,"Here's the list... Slow, so I don't flood.");
foreach my $q (@bar) {
$self->privmsg($tnick,$q);
#select undef,undef,undef, .5;
}
close SERVERS or die print "bad list: $! $?\n";
$self->privmsg($tnick,"Thassit");
}
# What to do when we receive a message via DCC CHAT.
sub ascii {
my $self = shift;
my $event = shift;
my $filename = shift;
my ($channel) = ($event->to)[0];
my ($sock) = ($event->to)[0];
$error = 0; # do error checking
$file = "/tmp/" . $filename;
if ($error != 1) {
if((-e "$file")) {
if ($filename !~ /\.png/){
$self->privmsg($channel,"Converting $filename to png");
print LOG ("Converting $file to png\n");
my ($name, $type) = split('\.', $filename);
$outfile = "/tmp/" . $name . "\.png";
system("/usr/X11R6/bin/convert $file $outfile") == 0
or die print "Convert $file $outfile failed $?\n";
$file = $outfile;
}
print LOG "ascii $file to $channel\n";
$self->privmsg($channel,"OK, working on it...");
open ASCII, "java -jar /usr/local/bin/jitac-0.2.0.jar -w 90 $file|"
or die print "can't ascii: $!";
undef @foo;
while (<ASCII>) {
push @foo, $_;
}
$self->privmsg($channel,"Here it comes, don't interrupt me:");
foreach my $z (@foo) {
$self->privmsg($channel,$z);
sleep 1;
}
close ASCII or die print "bad ascii: $! $?\n";
$self->privmsg($channel,"*phew*, all done");
} else {
print LOG "File $file does not exist\n";
$self->privmsg($channel,"File $file does not exist");
}
} else {
print LOG "Error on send line:\nchannel: $channel\n";
print LOG "file: $file\n";
}
}