MockerBot
An irc in perl - written by Mocker/Sokercap/Kimochii
Purpose: This bot is written for fun and as an excercise. I am posting it here with small comments for
anyone that wants to take a look, get ideas, or just have a laugh at my coding :|
If anyone wants to contact me, its sokercap [at] gmail [dot[ com
the header, requires a few nifty modules and mech_scripts.pl, an external file I keep some of the functions in
#!/usr/bin/perl
#starts irc bot. Add socket handler to get input
require "cgi-lib.pl";
require "mech_scripts.pl";
use Net::IRC;
#use strict;
use IO::Socket::INET;
use DBI;
use Net::Dict;
Open the relay socket, ircclient, db connection and set my many many globals (bad style I know)
my $MySocket = new IO::Socket::INET->new(LocalPort=>1234,Proto=>'udp');
my $irc = new Net::IRC;
$dbpath = "dbi:mysql:database=**DBNAME**;host=localhost";
$dbh = DBI->connect($dbpath, "***DBUSER***", "**PWD***") or die "Can't open db: $DBI::errstr";
$dict = Net::Dict->new('dict.org');
$dict->setDicts('english');
my @thedate = localtime();
my $botname = "Nyuu";
my $botpwd = "**NICKPWD**";
my $botisreg = 0;
my $logdir = "/home/thegupst/public_html/test_irc/";
my $quotefile = $logdir . "quotes.db";
my $helpfile = $logdir . "helptext";
my $tbl_pre = 'test_';
my $messagefrom = "";
my $inputstring = "";
my $lastsec = (localtime)[0]; #current seconds
my $lastmin = (localtime)[1]; #current min
my $data1 = "";
my $talkon = 0;
my $talkperson = 'default';
my $islike = 0;
$dicdb = 'wn';
$data2 = "default";
#setup irc
my $conn = $irc->newconn(
Server => shift || 'irc.aniverse.com',
Port => shift || '6667',
Nick => $botname,
Ircname => 'lucy',
Username => 'elfenlied'
);
#set channel
$conn->{channel} = shift || '#testchannel';
Start my custom functions.. first up do_botstuff! If a message starts with !, it is sent here to check if it matches
any command triggers. If so, it usually sets some flag and sends it to the appropriate function. Languages correspond to
dictionary, language form or url of language dictionary
##other functions
sub do_botstuff {
#msg started with !, check for command
my @words = split(/ /, $quoted);
my $command = $words[0];
if($command eq '!quote'){
if($words[1] eq 'random'){
get_quote();
$conn->privmsg($conn->{channel}, "ahem: $data1");
}
if($words[1] eq 'add'){
my $counter = 0;
$data1 = "";
foreach (@words){
if($counter > 1){
$data1 .= ' ' . $_;
}
else {
$counter += 1;
}
}
add_quote();
}
if($words[1] eq 'randomirc'){
if($words[2] eq 'LIKE'){
$islike = 1;
if(length($words[3]) > 1){
$data2 = $words[3]; }
}
else {
if(length($words[2]) > 1){
$data2 = $words[2]; }
}
get_ircquote();
}
}
#end quote cmd
if($words[0] eq '!info'){
if($words[1] eq 'postcount'){
$data1 = $words[2];
if($data1 eq 'LIKE'){
$islike = 1;
$data1 = 'default';
if(length($words[3]) > 2){
$data1 = $words[3]; }
}
info_postcount();
}
}
#end info cmd
if($words[0] eq '!talk' && $words[1] eq 'on'){
$talkon = 1;
if(length($words[2]) > 1){
$talkperson = $words[2]; }
}
if($words[0] eq '!talk' && $words[1] eq 'off'){
$talkon = 0;
$talkperson = 'default';
}
#end talk
if($words[0] eq '!define'){
$data1 = $words[1];
if($data1 eq 'SPANISH'){
$dicdb = 'eng-sp'; $data1 = $words[2]; }
if($data1 eq 'ROM'){
$dicdb = 'eng-rom'; $data1 = $words[2]; }
if($data1 eq 'GERMAN'){
$dicdb = 'eng-deu'; $data1 = $words[2]; }
if($data1 eq 'FRENCH'){
$dicdb = 'eng-fra'; $data1 = $words[2]; }
if($data1 eq 'NLD'){
$dicdb = 'eng-nld'; $data1 = $words[2]; }
if($data1 eq 'DEVIL'){
$dicdb = 'devils'; $data1 = $words[2]; }
if($data1 eq 'JARGON'){
$dicdb = 'jargon'; $data1 = $words[2]; }
if($data1 eq 'THES'){
$dicdb = 'moby-thes'; $data1 = $words[2]; }
if($dicdb eq 'wn'){
$conn->privmsg('mocker', "getting dictionary.com");
$conref = \$conn;
dictionary_com($conn, $data1); }
else {
define_word(); }
}
#end define
if($words[0] eq '!tran'){
$whatdb = 'google';
$dicdb = 'en|es';
$data1 = $words[1];
if($words[1] eq 'GERMAN'){
$dicdb = 'en|de'; $data1 = $words[2]; }
if($words[1] eq 'FRENCH'){
$dicdb = 'en|fr'; $data1 = $words[2]; }
if($words[1] eq 'GERMAN'){
$dicdb = 'en|de'; $data1 = $words[2]; }
#if($words[1] eq 'ITALIAN'){
#$dicdb = 'en|il'; $data1 = $words[2]; }
if($words[1] eq 'ARABIC'){
$dicdb = 'en|ar'; $data1 = $words[2]; }
if($words[1] eq 'JAPANESE'){
$dicdb = 'http://www.freedict.com/onldict/jap.html'; $whatdb = 'freedict'; }
if($words[1] eq 'NIHONGO'){
$dicdb = '2http://www.freedict.com/onldict/jap.html'; $whatdb = 'freedict'; }
if($words[1] eq 'KOREAN'){
$dicdb = 'en|ko'; $data1 = $words[2]; }
if($words[1] eq 'CHINESE'){
$dicdb = 'en|zh-CN'; $data1 = $words[2]; }
if($words[1] eq 'DEUTSCH'){
$dicdb = 'de|en'; $data1 = $words[2]; }
if($words[1] eq 'FRANCAIS'){
$dicdb = 'fr|en'; $data1 = $words[2]; }
if($words[1] eq 'ESPANOL'){
$dicdb = 'es|en'; $data1 = $words[2]; }
if($words[1] eq 'SPANISH'){
$data1 = $words[2]; }
if($dicdb ne 'en|es' || $words[1] eq 'SPANISH'){
shift(@words); shift(@words); $data1 = join " ", @words;
}
else {
shift(@words); $data1 = join " ", @words;
}
if(length($data1) < 2){
$data1 = 'idiot'; }
if($whatdb eq 'google'){
google_trans($conn, $dicdb, $data1); }
else {
freedict_trans($conn, $dicdb, $data1); }
$whatdb = 'google';
$dicdb = 'wn';
}
#end translate
if($words[0] eq '!google'){
shift(@words); $input = join " ", @words;
google_search($conn, $input);
}
#end google
if($words[0] eq '!help'){
help_msg();
}
#end help
}
Next up are a few of the subroutines for handling actions. Actually, screw this, i'll comment on the rest later
sub help_msg {
open(HELPIN, $helpfile);
@helptmp = ;
close(HELPIN);
$counti = 0;
foreach $helpline (@helptmp){
if($counti < 13){
$conn->privmsg($speaker, $helpline);
}
$counti = $counti + 1;
}
}
sub define_word {
my $input = $data1;
if(length($input) < 2){
$input = "idiot"; }
$data1 = "";
$h = $dict->define($input) or die "could not define $input";
@i = @{$h}[0];
$x = $i[0]->[1];
if(length($x) < 3){ $x = "No definition found, doh"; }
#@splitx = $x =~ /.{1,200}/gs;
#@splitx = split(/(.{200})/, $x);
$c = 0;
$spx = substr($x, 0, 500);
#foreach $spx (@splitx){
#if(length($spx) < 2) { $spx = "error"; }
#if($c < 3){
$syscmd = "dict -d $dicdb $input | head -5 > /scripts/custom/irc_files/tmpdic";
system($syscmd);
$dicdb = 'wn';
$tmpdefine = "";
open(DICIN, "/scripts/custom/irc_files/tmpdic");
@tmpdefine = ;
close(DICIN);
foreach $tmpdef (@tmpdefine){
if(substr($tmpdef, 0, 3) ne '---' && $input ne 'lazer' && $input ne 'lazer'){
$conn->privmsg($conn->{'channel'}, $tmpdef);
}
}
if($input eq 'lazer' || $input eq 'lazers'){
$conn->privmsg($conn->{'channel'}, "Pew ! Pew!"); }
#$speaker = $botname; $quoted = $spx; log_msg();
#}
#$c += 1;
#}
}
sub info_postcount {
if($islike == 0){
$data1 = $dbh->quote($data1);
$sql = "SELECT username, msgcount FROM $tbl_pre" . "usernames WHERE username = $data1";
}
if($islike == 1){
$sql = "SELECT username, msgcount FROM $tbl_pre" . "usernames WHERE username LIKE '%" . $data1 . "%' ORDER BY msgcount DESC LIMIT 5";
$islike = 0;
}
if($islike != 0 && $islike != 1){
$sql = "SELECT username, msgcount FROM $tbl_pre" . "usernames WHERE postcount > 2 ORDER BY RAND() LIMIT 1";
}
$query = $dbh->prepare($sql);
$query->execute or die "SQL Error: $DBI::errstr\n";
while(@postinfo = $query->fetchrow_array){
my $botmsg = "<$postinfo[0]> has posted $postinfo[1] times";
$conn->privmsg($conn->{channel}, $botmsg);
$speaker = $botname; $quoted = $botmsg; log_msg();
}
}
sub get_ircquote {
my $sqlname = "";
if($data2 ne 'default'){
$blahblah = $data2 =~ tr/'//d;
$sqlname = " AND username = '" . $data2 . "' ";
}
if($data2 ne 'default' && $islike == 1){
$sqlname = " AND username LIKE '%" . $data2 . "%' ";
$islike = 0;
}
$data2 = 'default';
$sql = "SELECT username, msg FROM $tbl_pre" . "messages WHERE type < 4 " . $sqlname . "ORDER BY RAND() LIMIT 1";
$query = $dbh->prepare($sql) or die "could not prepare, $sql";
$query->execute or die "SQL Error: $DBI::errstr\n";
@quotenfo = $query->fetchrow_array;
$data1 = "<" . $quotenfo[0] . "> " . $quotenfo[1];
$conn->privmsg($conn->{channel}, $data1 );
$speaker = $botname; $quoted = $data1; log_msg();
}
sub get_quote {
my $delimiter = "\n\%\%\n";
#my $quotefile = "/home/thegupst/public_html/was_irc/quote.db";
open(QFILE,"$quotefile") || die "couldnt open quote file";
@QFILE = ;
close (QFILE);
$phrases = join('',@QFILE);
@phrases = split(/$delimiter/,$phrases);
srand(time^ $$);
$phrase = rand(@phrases);
$data1 = @phrases[$phrase];
$speaker = $botname; $quoted = $data1; log_msg();
}
sub add_quote {
#append quote to quote.db
my $delimiter = "\n\%\%\n";
#my $quotefile = "/home/thegupst/public_html/was_irc/quote.db";
open(QFILE,">>$quotefile") || die "could not open quote file";
print QFILE $delimiter . $data1 ;
close(QFILE);
}
sub log_msg {
#open file and log the message
my $sql = "";
my $cmdtype = 0;
@thedate = localtime();
$thedate[2] = $thedate[4] + 1; $thedate[5] = $thedate[5] + 1900; $thedate[5] =
sprintf("%02d", $thedate[5] % 100);
my $linein = "(" . $thedate[2] . ":" . $thedate[1] . ":" .
$thedate[0] . ") >$filename");
flock (LOGIN,2);
if ($quoted eq 'dundundunleaves') {
$cmdtype = 1;
$linein .= 'green';
$quoted = "sadly leaves";
}
if ($quoted eq 'dundundunjoins') {
$cmdtype = 2;
$linein .= 'red';
$quoted = "joyfully enters";
}
if ($quoted ne 'joyfully enters' && $quoted ne 'sadly leaves') {
$cmdtype = 3;
$linein .= 'blue';
if (substr($quoted, 0 , 1) eq '!') {
do_botstuff();
$cmdtype = 4;
}
if (substr($quoted, 0, 1) ne '!' && $talkon == 1 && substr($quoted, 0, 1) ne '<' && $speaker ne $botname){
$data2 = $talkperson;
get_ircquote();
}
}
$speaker = $dbh->quote($speaker); $quoted = $dbh->quote($quoted);
$sqlquery = $dbh->do("UPDATE $tbl_pre". "usernames SET msgcount = msgcount + 1 WHERE username
= $speaker LIMIT 1");
if($sqlquery < 1){
$sqlquery = $dbh->prepare("INSERT INTO $tbl_pre" . "usernames (username) VALUES ($speaker)");
$sqlquery2 = $sqlquery->execute or die "SQL Error: $DBI::errstr\n";
}
$sql = "INSERT INTO $tbl_pre" . "messages SET username = $speaker, msg = $quoted, date =
NOW(), type = '$cmdtype'";
$sth = $dbh->prepare($sql);
$sth->execute or die "SQL Error: $DBI::errstr\n";
$linein .= "'>" . $speaker . " : " . $quoted . "
";
print LOGIN "$linein\n";
close(LOGIN);
}
## HANDLERS
#public message
sub on_pubmsg {
#log, parse, respond whatnot
my ($conn, $event) = @_;
$isSysMsg = 0;
$speaker = $event->{nick};
$quoted = $event->{args}[0];
if($quoted =~ /whee/){
$conn->privmsg($conn->{channel}, "Wiiiii!!" );
}
log_msg();
}
#socket recieved msg
sub on_sockmsg {
#parse, send to irc
my $text = "";
my $cursec = (localtime)[0];
my $curmin = (localtime)[1];
$MySocket->recv($text,128);
my @msgin = split('\~', $text);
$text = "<" . $msgin[0] . "> " . $msgin[1];
if (($curmin == $lastmin) && (($cursec - $lastsec) < 5)){
#spamspam
}
else {
$conn->privmsg($conn->{channel}, $text );
$lastmin = $curmin;
$lastsec = $cursec;
$speaker = "m_" . $msgin[0];
$quoted = $msgin[1];
log_msg();
}
}
sub on_connect {
# shift in our connection object that is passed automatically
my $conn = shift;
print "connected fine";
# when we connect, join our channel and greet it
$conn->join($conn->{channel});
# $conn->privmsg($conn->{channel}, 'Hello everyone!');
$conn->{connected} = 1;
}
sub on_join {
my ($conn, $event) = @_;
# this is the nick that just joined
my $nick = $event->{nick};
# say hello to the nick in public
if($botisreg > 0){
$conn->privmsg('nickserv', "IDENTIFY $botpwd");
}
$isSysMsg = 1;
$speaker = $nick;
$quoted = "dundundunjoins";
log_msg();
}
sub on_part {
# pretty much the same as above
my ($conn, $event) = @_;
my $nick = $event->{nick};
$isSysMsg = 1;
$speaker = $nick;
$quoted = "dundundunleaves";
log_msg();
}
##Callbacks
$conn->add_handler('join', \&on_join);
$conn->add_handler('part', \&on_part);
$conn->add_handler('public', \&on_pubmsg);
$irc->addfh($MySocket, \&on_sockmsg);
# The end of MOTD (message of the day), numbered 376 signifies we've connect
$conn->add_handler('376', \&on_connect);
# start IRC
$irc->start();
In conclusion: blaaaaaaaah blah blah