Use AnyEvent::IRC as main IRC gear
This commit is contained in:
eleksir
@@ -30,7 +30,7 @@ use POSIX qw (setgid setuid);
|
|||||||
use File::Path qw (make_path);
|
use File::Path qw (make_path);
|
||||||
use File::Basename qw (dirname);
|
use File::Basename qw (dirname);
|
||||||
use BotLib::Conf qw (LoadConf);
|
use BotLib::Conf qw (LoadConf);
|
||||||
use IRCBot qw (RunIRCBot);
|
use IRCBot2 qw (RunIRCBot);
|
||||||
|
|
||||||
# if we run under root, create pid dir and set correct owner for it, same for debug log if it is defined
|
# if we run under root, create pid dir and set correct owner for it, same for debug log if it is defined
|
||||||
if ($UID == 0) {
|
if ($UID == 0) {
|
||||||
|
|||||||
3
cpanfile
3
cpanfile
@@ -1,8 +1,9 @@
|
|||||||
requires "Bot::IRC";
|
requires "AnyEvent::IRC";
|
||||||
requires "CHI";
|
requires "CHI";
|
||||||
requires "CHI::Driver::BerkeleyDB";
|
requires "CHI::Driver::BerkeleyDB";
|
||||||
requires "Cwd";
|
requires "Cwd";
|
||||||
requires "Cwd::utf8";
|
requires "Cwd::utf8";
|
||||||
|
requires "Date::Format::ISO8601";
|
||||||
requires "DateTime";
|
requires "DateTime";
|
||||||
requires "DB_File";
|
requires "DB_File";
|
||||||
requires "Digest::HMAC_SHA1";
|
requires "Digest::HMAC_SHA1";
|
||||||
|
|||||||
@@ -1,10 +1,18 @@
|
|||||||
{
|
{
|
||||||
# all cached will go there, they named after module name
|
# where to connect
|
||||||
"server" : "127.0.0.1",
|
"server" : "127.0.0.1",
|
||||||
"port" : "6667",
|
"port" : "6667",
|
||||||
"ssl" : 0,
|
"ssl" : 0,
|
||||||
"nick" : "aleesa",
|
"nick" : "aleesa",
|
||||||
"connect_cmd" : "/join #a\n/join #b",
|
|
||||||
|
# join to at least one channel
|
||||||
|
"channels": [
|
||||||
|
"#a",
|
||||||
|
"#b"
|
||||||
|
],
|
||||||
|
|
||||||
|
# identify with nickserv
|
||||||
|
"identify": "password",
|
||||||
|
|
||||||
# where caches go
|
# where caches go
|
||||||
"cachedir" : "data/cache",
|
"cachedir" : "data/cache",
|
||||||
|
|||||||
1461
lib/Bot/IRC.pm
1461
lib/Bot/IRC.pm
File diff suppressed because it is too large
Load Diff
@@ -1,207 +0,0 @@
|
|||||||
package Bot::IRC::OnMessage;
|
|
||||||
|
|
||||||
use 5.018;
|
|
||||||
use strict;
|
|
||||||
use warnings;
|
|
||||||
use utf8;
|
|
||||||
use open qw (:std :utf8);
|
|
||||||
use English qw ( -no_match_vars );
|
|
||||||
use Math::Random::Secure qw (irand);
|
|
||||||
use BotLib qw (Command RandomCommonPhrase);
|
|
||||||
use BotLib::Conf qw (LoadConf);
|
|
||||||
use BotLib::Karma qw (KarmaSet);
|
|
||||||
use BotLib::Util qw (trim utf2sha1);
|
|
||||||
use Encode qw (_utf8_on);
|
|
||||||
use Hailo;
|
|
||||||
our $VERSION = '1.35'; # VERSION
|
|
||||||
|
|
||||||
# Most gears are spinning here.
|
|
||||||
sub init {
|
|
||||||
my ($bot) = @_;
|
|
||||||
my $c = LoadConf ();
|
|
||||||
my $hailo;
|
|
||||||
|
|
||||||
$bot->hook (
|
|
||||||
{
|
|
||||||
command => 'PRIVMSG',
|
|
||||||
},
|
|
||||||
|
|
||||||
sub {
|
|
||||||
my $bot = shift;
|
|
||||||
my $msg = shift;
|
|
||||||
my $text = shift;
|
|
||||||
|
|
||||||
# fix some utf8 flags, that are lost
|
|
||||||
_utf8_on $msg->{forum};
|
|
||||||
_utf8_on $msg->{full_text};
|
|
||||||
_utf8_on $msg->{user};
|
|
||||||
my $chatid = $msg->{forum};
|
|
||||||
|
|
||||||
# The main idea is to find out if message contains command.
|
|
||||||
# I know that this framework contains nifty way to guess commands
|
|
||||||
# but it detects command when bot mentiond, but'd like to send
|
|
||||||
# commands via command sign (say, exclamation mark).
|
|
||||||
if ($msg->{full_text} =~ qr/^\s*\Q$bot->{nick}\E[\,|\:]?\s*$/i) {
|
|
||||||
# Someone call bot, but says only name, nothing more
|
|
||||||
$bot->reply_to ('Чего тебе?');
|
|
||||||
} elsif ($msg->{full_text} =~ /^\Q$bot->{nick}\E[\,|\:]?\s+(.+)/i) {
|
|
||||||
# Someone wants to chit-chat with bot, lets use our brain to make an answer.
|
|
||||||
my $phrase = trim ($1);
|
|
||||||
|
|
||||||
unless (defined $hailo->{$chatid}) {
|
|
||||||
my $cid = utf2sha1 ($chatid);
|
|
||||||
$cid =~ s/\//-/xmsg;
|
|
||||||
my $brainname = sprintf '%s/%s.sqlite', $c->{braindir}, $cid;
|
|
||||||
|
|
||||||
$hailo->{$chatid} = eval {
|
|
||||||
Hailo->new (
|
|
||||||
brain => $brainname,
|
|
||||||
order => 3
|
|
||||||
);
|
|
||||||
};
|
|
||||||
|
|
||||||
unless (defined $hailo->{$chatid}) {
|
|
||||||
$bot->note ($EVAL_ERROR);
|
|
||||||
return;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
my $answer = eval {
|
|
||||||
$hailo->{$chatid}->learn_reply ($phrase);
|
|
||||||
};
|
|
||||||
|
|
||||||
unless (defined $answer) {
|
|
||||||
$bot->note ($EVAL_ERROR);
|
|
||||||
$answer = RandomCommonPhrase ();
|
|
||||||
}
|
|
||||||
|
|
||||||
$bot->reply_to ($answer);
|
|
||||||
} elsif (substr ($msg->{full_text}, -2) eq '++' || substr ($msg->{full_text}, -2) eq '--') {
|
|
||||||
# Looks like someone wants to adjust karma of the phrase
|
|
||||||
my @arr = split /\n/, $msg->{full_text};
|
|
||||||
|
|
||||||
if ($#arr < 1) {
|
|
||||||
my $answer = eval {
|
|
||||||
KarmaSet (
|
|
||||||
$chatid,
|
|
||||||
trim (
|
|
||||||
substr (
|
|
||||||
$msg->{full_text},
|
|
||||||
0,
|
|
||||||
-2
|
|
||||||
)
|
|
||||||
),
|
|
||||||
substr ($msg->{full_text}, -2)
|
|
||||||
);
|
|
||||||
};
|
|
||||||
|
|
||||||
if (defined $answer) {
|
|
||||||
$bot->reply ($answer);
|
|
||||||
} else {
|
|
||||||
$bot->note ($EVAL_ERROR);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
} elsif (substr ($msg->{full_text}, 0, 1) eq $c->{csign}) {
|
|
||||||
my $answer = Command ($msg->{forum}, $msg->{user}, $msg->{full_text});
|
|
||||||
|
|
||||||
if (defined $answer && $answer ne '') {
|
|
||||||
foreach my $str (split /\n/, $answer) {
|
|
||||||
chomp $str;
|
|
||||||
$str = trim ($str);
|
|
||||||
|
|
||||||
if ($str ne '') {
|
|
||||||
$bot->reply ($str);
|
|
||||||
sleep 1;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
} else {
|
|
||||||
# Default action - add phrase to brain reactor as is
|
|
||||||
unless (defined $hailo->{$chatid}) {
|
|
||||||
my $cid = utf2sha1 ($chatid);
|
|
||||||
$cid =~ s/\//-/xmsg;
|
|
||||||
my $brainname = sprintf '%s/%s.sqlite', $c->{braindir}, $cid;
|
|
||||||
|
|
||||||
$hailo->{$chatid} = Hailo->new (
|
|
||||||
brain => $brainname,
|
|
||||||
order => 3
|
|
||||||
);
|
|
||||||
|
|
||||||
unless (defined $hailo->{$chatid}) {
|
|
||||||
$bot->note ($EVAL_ERROR);
|
|
||||||
return;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
$hailo->{$chatid}->learn ($msg->{full_text});
|
|
||||||
}
|
|
||||||
|
|
||||||
return 1;
|
|
||||||
},
|
|
||||||
);
|
|
||||||
|
|
||||||
$bot->helps (
|
|
||||||
anek => "$c->{csign}anek - рандомный анекдот с anekdot.ru",
|
|
||||||
анек => "$c->{csign}анек - рандомный анекдот с anekdot.ru",
|
|
||||||
анекдот => "$c->{csign}анекдот - рандомный анекдот с anekdot.ru",
|
|
||||||
buni => "$c->{csign}buni - комикс-стрип hapi buni",
|
|
||||||
bunny => "$c->{csign}bunny - рандомный кролик",
|
|
||||||
rabbit => "$c->{csign}rabbit - рандомный кролик",
|
|
||||||
кролик => "$c->{csign}кролик - рандомный кролик",
|
|
||||||
cat => "$c->{csign}cat - рандомная кошечка",
|
|
||||||
coin => "$c->{csign}cat - подбросить монетку - орёл или решка?",
|
|
||||||
монетка => "$c->{csign}cat - подбросить монетку - орёл или решка?",
|
|
||||||
кис => "$c->{csign}кис - рандомная кошечка",
|
|
||||||
dice => "$c->{csign}dice - бросить кости",
|
|
||||||
roll => "$c->{csign}roll - бросить кости",
|
|
||||||
кости => "$c->{csign}кости - бросить кости",
|
|
||||||
dig => "$c->{csign}dig - заняться археологией",
|
|
||||||
копать => "$c->{csign}копать - заняться археологией",
|
|
||||||
drink => "$c->{csign}drink - какой сегодня праздник?",
|
|
||||||
пословица => "$c->{csign}пословица - рандомная русская пословица",
|
|
||||||
proverb => "$c->{csign}proverb - рандомная русская пословица",
|
|
||||||
праздник => "$c->{csign}праздник - какой сегодня праздник?",
|
|
||||||
fish => "$c->{csign}fish - порыбачить",
|
|
||||||
fisher => "$c->{csign}fisher - порыбачить",
|
|
||||||
рыба => "$c->{csign}рыба - порыбачить",
|
|
||||||
рыбка => "$c->{csign}рыбка - порыбачить",
|
|
||||||
рыбалка => "$c->{csign}рыбалка - порыбачить",
|
|
||||||
f => "$c->{csign}f - рандомная фраза из сборника цитат fortune_mod",
|
|
||||||
fortune => "$c->{csign}fortune - рандомная фраза из сборника цитат fortune_mod",
|
|
||||||
фортунка => "$c->{csign}фортунка - рандомная фраза из сборника цитат fortune_mod",
|
|
||||||
fox => "$c->{csign}fox - рандомная лисичка",
|
|
||||||
лис => "$c->{csign}лис - рандомная лисичка",
|
|
||||||
friday => "$c->{csign}friday - а не пятница ли сегодня?",
|
|
||||||
пятница => "$c->{csign}пятница - а не пятница ли сегодня?",
|
|
||||||
frog => "$c->{csign}frog - рандомная лягушка",
|
|
||||||
лягушка => "$c->{csign}лягушка - рандомная лягушка",
|
|
||||||
horse => "$c->{csign}horse - рандомная лошадка",
|
|
||||||
лошадь => "$c->{csign}лошадь - рандомная лошадка",
|
|
||||||
лошадка => "$c->{csign}лошадка - лошадка",
|
|
||||||
karma => "$c->{csign}karma фраза - посмотреть карму фразы",
|
|
||||||
карма => "$c->{csign}карма фраза - посмотреть карму фразы",
|
|
||||||
lat => "$c->{csign}lat - сгенерировать фразу из крылатого латинского выражения",
|
|
||||||
лат => "$c->{csign}лат - сгенерировать фразу из крылатого латинского выражения",
|
|
||||||
monkeyuser => "$c->{csign}monkeyuser - комикс-стрип MonkeyUser",
|
|
||||||
owl => "$c->{csign}owl - рандомная сова",
|
|
||||||
сова => "$c->{csign}сова - рандомная сова",
|
|
||||||
ping => "$c->{csign}ping - попинговать бота",
|
|
||||||
пинг => "$c->{csign}пинг - попинговать бота",
|
|
||||||
snail => "$c->{csign}snail - рандомная улитка",
|
|
||||||
улитка => "$c->{csign}улитка - рандомная улитка",
|
|
||||||
ver => "$c->{csign}ver - написать что-то про версию ПО",
|
|
||||||
version => "$c->{csign}version - написать что-то про версию ПО",
|
|
||||||
версия => "$c->{csign}версия - написать что-то про версию ПО",
|
|
||||||
w => "$c->{csign}w Город - погода в городе",
|
|
||||||
п => "$c->{csign}п Город - погода в городе",
|
|
||||||
xkcd => "$c->{csign}xkcd - комикс-стрип с xkcb.ru",
|
|
||||||
);
|
|
||||||
|
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
|
|
||||||
1;
|
|
||||||
|
|
||||||
__END__
|
|
||||||
|
|
||||||
# vim: set ft=perl noet ai ts=4 sw=4 sts=4:
|
|
||||||
@@ -1,52 +0,0 @@
|
|||||||
package Bot::IRC::ReJoin;
|
|
||||||
# Re-Join to channel on /kick
|
|
||||||
|
|
||||||
use 5.018;
|
|
||||||
use strict;
|
|
||||||
use warnings;
|
|
||||||
use utf8;
|
|
||||||
use open qw (:std :utf8);
|
|
||||||
use English qw ( -no_match_vars );
|
|
||||||
use Encode qw (_utf8_on);
|
|
||||||
|
|
||||||
our $VERSION = '1.35'; # VERSION
|
|
||||||
|
|
||||||
# Most gears are spinning here.
|
|
||||||
sub init {
|
|
||||||
my ($bot) = @_;
|
|
||||||
|
|
||||||
$bot->hook (
|
|
||||||
{
|
|
||||||
command => 'KICK',
|
|
||||||
},
|
|
||||||
|
|
||||||
sub {
|
|
||||||
my $bot = shift;
|
|
||||||
my $msg = shift;
|
|
||||||
|
|
||||||
# fix some utf8 flags, that are lost
|
|
||||||
_utf8_on $msg->{forum};
|
|
||||||
_utf8_on $msg->{full_text};
|
|
||||||
_utf8_on $msg->{user};
|
|
||||||
|
|
||||||
my ($who, $why) = split / \:/, $msg->{text}, 2;
|
|
||||||
|
|
||||||
if ($who eq $bot->{nick}) {
|
|
||||||
$bot->note ("I was kicked from $msg->{forum} by $msg->{nick} with reason $why");
|
|
||||||
sleep 5;
|
|
||||||
$bot->join ($msg->{forum});
|
|
||||||
$bot->note ("Re-joining to $msg->{forum}");
|
|
||||||
}
|
|
||||||
|
|
||||||
return 1;
|
|
||||||
},
|
|
||||||
);
|
|
||||||
|
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
|
|
||||||
1;
|
|
||||||
|
|
||||||
__END__
|
|
||||||
|
|
||||||
# vim: set ft=perl noet ai ts=4 sw=4 sts=4:
|
|
||||||
@@ -8,6 +8,7 @@ use open qw (:std :utf8);
|
|||||||
use English qw ( -no_match_vars );
|
use English qw ( -no_match_vars );
|
||||||
use Carp qw (carp);
|
use Carp qw (carp);
|
||||||
use Math::Random::Secure qw (irand);
|
use Math::Random::Secure qw (irand);
|
||||||
|
use BotLib::Anek qw (Anek);
|
||||||
use BotLib::Archeologist qw (Dig);
|
use BotLib::Archeologist qw (Dig);
|
||||||
use BotLib::Buni qw (Buni);
|
use BotLib::Buni qw (Buni);
|
||||||
use BotLib::Conf qw (LoadConf);
|
use BotLib::Conf qw (LoadConf);
|
||||||
|
|||||||
@@ -1,58 +0,0 @@
|
|||||||
package IRCBot;
|
|
||||||
|
|
||||||
use 5.018;
|
|
||||||
use strict;
|
|
||||||
use warnings;
|
|
||||||
use utf8;
|
|
||||||
use open qw (:std :utf8);
|
|
||||||
use English qw ( -no_match_vars );
|
|
||||||
use Bot::IRC;
|
|
||||||
use BotLib::Conf qw (LoadConf);
|
|
||||||
|
|
||||||
use version; our $VERSION = qw (1.0);
|
|
||||||
use Exporter qw (import);
|
|
||||||
our @EXPORT_OK = qw (RunIRCBot);
|
|
||||||
|
|
||||||
|
|
||||||
sub RunIRCBot {
|
|
||||||
my $c = LoadConf ();
|
|
||||||
|
|
||||||
my $bot = Bot::IRC->new (
|
|
||||||
spawn => 2,
|
|
||||||
daemon => {
|
|
||||||
name => 'aleesa-irc-bot',
|
|
||||||
lsb_sdesc => 'Aleesa IRC Bot',
|
|
||||||
pid_file => $c->{pid},
|
|
||||||
stderr_file => $c->{log},
|
|
||||||
stdout_file => $c->{debug_log},
|
|
||||||
},
|
|
||||||
connect => {
|
|
||||||
server => $c->{server},
|
|
||||||
port => $c->{port},
|
|
||||||
nick => $c->{nick},
|
|
||||||
name => 'Aleesa IRC Bot',
|
|
||||||
ssl => $c->{ssl},
|
|
||||||
ipv6 => 0,
|
|
||||||
},
|
|
||||||
);
|
|
||||||
|
|
||||||
$bot->load ('OnMessage', 'ReJoin'); # our main plugin that handles all the incomming messages, mostly
|
|
||||||
$bot->helps(
|
|
||||||
about => 'I am just another chatty bot.',
|
|
||||||
);
|
|
||||||
|
|
||||||
# finally, run bot
|
|
||||||
if (defined $c->{'connect_cmd'} && $c->{'connect_cmd'} ne '') {
|
|
||||||
my @connect_cmd = map {chomp; $_} split (/\n/, $c->{'connect_cmd'});
|
|
||||||
$bot->run (@connect_cmd);
|
|
||||||
} else {
|
|
||||||
$bot->run;
|
|
||||||
}
|
|
||||||
|
|
||||||
return;
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
1;
|
|
||||||
|
|
||||||
# vim: set ft=perl noet ai ts=4 sw=4 sts=4:
|
|
||||||
282
lib/IRCBot2.pm
Normal file
282
lib/IRCBot2.pm
Normal file
@@ -0,0 +1,282 @@
|
|||||||
|
package IRCBot2;
|
||||||
|
|
||||||
|
use 5.018;
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
use utf8;
|
||||||
|
use open qw (:std :utf8);
|
||||||
|
use English qw ( -no_match_vars );
|
||||||
|
use AnyEvent;
|
||||||
|
use AnyEvent::IRC;
|
||||||
|
use AnyEvent::IRC::Client;
|
||||||
|
use Date::Format::ISO8601 qw (gmtime_to_iso8601_datetime);
|
||||||
|
use Encode qw (_utf8_on _utf8_off decode encode);
|
||||||
|
use Hailo;
|
||||||
|
use BotLib qw (Command RandomCommonPhrase);
|
||||||
|
use BotLib::Conf qw (LoadConf);
|
||||||
|
use BotLib::Karma qw (KarmaSet);
|
||||||
|
use BotLib::Util qw (trim utf2sha1);
|
||||||
|
|
||||||
|
use version; our $VERSION = qw (1.0);
|
||||||
|
use Exporter qw (import);
|
||||||
|
our @EXPORT_OK = qw (RunIRCBot);
|
||||||
|
|
||||||
|
|
||||||
|
sub RunIRCBot {
|
||||||
|
my $c = LoadConf ();
|
||||||
|
my $hailo;
|
||||||
|
my $cv = AnyEvent->condvar;
|
||||||
|
my $irc = new AnyEvent::IRC::Client;
|
||||||
|
|
||||||
|
$irc->reg_cb (
|
||||||
|
irc_privmsg => sub {
|
||||||
|
my ($self, $msg) = @_;
|
||||||
|
my $botnick = $irc->nick ();
|
||||||
|
my $chatid = $msg->{params}->[0];
|
||||||
|
my $text = decode('utf8', $msg->{params}->[-1]);
|
||||||
|
my $nick = (split /!/, $msg->{prefix})[0];
|
||||||
|
my $answer;
|
||||||
|
|
||||||
|
unless (defined $text) { return; }
|
||||||
|
|
||||||
|
# The main idea is to find out if message contains command.
|
||||||
|
# I know that this framework contains nifty way to guess commands
|
||||||
|
# but it detects command when bot mentiond, but'd like to send
|
||||||
|
# commands via command sign (say, exclamation mark).
|
||||||
|
if ($text =~ qr/^\s*\Q$botnick\E[\,|\:]?\s*$/i) {
|
||||||
|
# Someone call bot, but says only name, nothing more
|
||||||
|
$answer = sprintf '%s, чего тебе?', $nick;
|
||||||
|
} elsif ($text =~ /^\Q$botnick\E[\,|\:]?\s+(.+)/i) {
|
||||||
|
# Someone wants to chit-chat with bot, lets use our brain to make an answer.
|
||||||
|
my $phrase = trim ($1);
|
||||||
|
|
||||||
|
unless (defined $hailo->{$chatid}) {
|
||||||
|
my $cid = utf2sha1 ($chatid);
|
||||||
|
$cid =~ s/\//-/xmsg;
|
||||||
|
my $brainname = sprintf '%s/%s.sqlite', $c->{braindir}, $cid;
|
||||||
|
|
||||||
|
$hailo->{$chatid} = eval {
|
||||||
|
Hailo->new (
|
||||||
|
brain => $brainname,
|
||||||
|
order => 3
|
||||||
|
);
|
||||||
|
};
|
||||||
|
|
||||||
|
unless (defined $hailo->{$chatid}) {
|
||||||
|
warn ($EVAL_ERROR);
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
$answer = eval {
|
||||||
|
sprintf '%s, %s', $nick, lcfirst ($hailo->{$chatid}->learn_reply ($phrase));
|
||||||
|
};
|
||||||
|
|
||||||
|
unless (defined $answer) {
|
||||||
|
warn ($EVAL_ERROR);
|
||||||
|
$answer = sprintf '%s, %s', $nick, RandomCommonPhrase ();
|
||||||
|
}
|
||||||
|
} elsif (substr ($text, -2) eq '++' || substr ($text, -2) eq '--') {
|
||||||
|
# Looks like someone wants to adjust karma of the phrase
|
||||||
|
my @arr = split /\n/, $text;
|
||||||
|
|
||||||
|
if ($#arr < 1) {
|
||||||
|
my $answer = eval {
|
||||||
|
KarmaSet (
|
||||||
|
$chatid,
|
||||||
|
trim ( substr ($text, 0, -2) ),
|
||||||
|
substr ($text, -2)
|
||||||
|
);
|
||||||
|
};
|
||||||
|
|
||||||
|
unless (defined $answer) {
|
||||||
|
warn ($EVAL_ERROR);
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
} elsif (substr ($text, 0, 1) eq $c->{csign}) {
|
||||||
|
$answer = Command ($chatid, $nick, $text);
|
||||||
|
|
||||||
|
unless (defined $answer && $answer ne '') {
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
# Default action - add phrase to brain reactor as is
|
||||||
|
unless (defined $hailo->{$chatid}) {
|
||||||
|
my $cid = utf2sha1 ($chatid);
|
||||||
|
$cid =~ s/\//-/xmsg;
|
||||||
|
my $brainname = sprintf '%s/%s.sqlite', $c->{braindir}, $cid;
|
||||||
|
|
||||||
|
$hailo->{$chatid} = Hailo->new (
|
||||||
|
brain => $brainname,
|
||||||
|
order => 3
|
||||||
|
);
|
||||||
|
|
||||||
|
unless (defined $hailo->{$chatid}) {
|
||||||
|
warn ($EVAL_ERROR);
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
$hailo->{$chatid}->learn ($text);
|
||||||
|
}
|
||||||
|
|
||||||
|
if (defined $answer) {
|
||||||
|
foreach my $string (split /\n/, $answer) {
|
||||||
|
if ($string ne '') {
|
||||||
|
_utf8_off ($string);
|
||||||
|
$irc->send_chan ($chatid, "PRIVMSG", $chatid, $string);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
return;
|
||||||
|
},
|
||||||
|
|
||||||
|
connect => sub {
|
||||||
|
my ($pc, $err) = @_;
|
||||||
|
if (defined $err) {
|
||||||
|
warn "Couldn't connect to server: $err\n";
|
||||||
|
}
|
||||||
|
|
||||||
|
if (defined ($c->{identify}) && $c->{identify} ne '') {
|
||||||
|
# freenode/libera.chat identification style
|
||||||
|
$irc->send_srv (
|
||||||
|
PRIVMSG => 'NickServ',
|
||||||
|
sprintf ('identify %s %s', $c->{nick}, $c->{identify})
|
||||||
|
);
|
||||||
|
}
|
||||||
|
|
||||||
|
for my $chan (@{$c->{channels}}) {
|
||||||
|
$irc->send_srv ("JOIN", $chan);
|
||||||
|
}
|
||||||
|
|
||||||
|
return;
|
||||||
|
},
|
||||||
|
|
||||||
|
connfail => sub {
|
||||||
|
warn "Connection failed, trying again";
|
||||||
|
sleep 5;
|
||||||
|
|
||||||
|
$irc->connect(
|
||||||
|
$c->{server},
|
||||||
|
$c->{port},
|
||||||
|
{
|
||||||
|
nick => $c->{nick},
|
||||||
|
user => $c->{nick},
|
||||||
|
real => $c->{nick}
|
||||||
|
}
|
||||||
|
);
|
||||||
|
},
|
||||||
|
|
||||||
|
registered => sub {
|
||||||
|
my ($self) = @_;
|
||||||
|
print "registered!\n";
|
||||||
|
$irc->enable_ping (60);
|
||||||
|
return;
|
||||||
|
},
|
||||||
|
|
||||||
|
disconnect => sub {
|
||||||
|
print "disconnected: $_[1]!\n";
|
||||||
|
sleep 5;
|
||||||
|
|
||||||
|
$irc->connect(
|
||||||
|
$c->{server},
|
||||||
|
$c->{port},
|
||||||
|
{
|
||||||
|
nick => $c->{nick},
|
||||||
|
user => $c->{nick},
|
||||||
|
real => $c->{nick}
|
||||||
|
}
|
||||||
|
);
|
||||||
|
|
||||||
|
return;
|
||||||
|
},
|
||||||
|
|
||||||
|
kick => sub {
|
||||||
|
my ($self, $kicked_nick, $channel, $is_myself, $msg, $kicker_nick) = @_;
|
||||||
|
|
||||||
|
if ($is_myself) {
|
||||||
|
warn sprintf ('%s kicked me from %s with reason: %s', $kicker_nick, $channel, decode('utf8', $msg));
|
||||||
|
sleep 3;
|
||||||
|
$irc->send_srv ("JOIN", $channel);
|
||||||
|
}
|
||||||
|
|
||||||
|
return;
|
||||||
|
},
|
||||||
|
|
||||||
|
nick_change => sub {
|
||||||
|
my ($self, $old_nick, $new_nick, $is_myself) = @_;
|
||||||
|
|
||||||
|
if ($is_myself) {
|
||||||
|
warn sprintf ('my nick have been changed from %s to %s', $old_nick, $new_nick);
|
||||||
|
}
|
||||||
|
|
||||||
|
return;
|
||||||
|
},
|
||||||
|
|
||||||
|
part => sub {
|
||||||
|
my ($self, $nick, $channel, $is_myself, $msg) = @_;
|
||||||
|
|
||||||
|
if ($is_myself) {
|
||||||
|
warn sprintf ('I left %s channel', $channel);
|
||||||
|
}
|
||||||
|
|
||||||
|
return;
|
||||||
|
},
|
||||||
|
|
||||||
|
join => sub {
|
||||||
|
my ($self, $nick, $channel, $is_myself) = @_;
|
||||||
|
|
||||||
|
if ($is_myself) {
|
||||||
|
warn sprintf ('I joined to %s channel', $channel);
|
||||||
|
}
|
||||||
|
|
||||||
|
return;
|
||||||
|
},
|
||||||
|
);
|
||||||
|
|
||||||
|
# these commands will queue until the connection
|
||||||
|
# is completly registered and has a valid nick etc.
|
||||||
|
$irc->ctcp_auto_reply ('CLIENTINFO', ['CLIENTINFO', 'CLIENTINFO ACTION FINGER PING SOURCE TIME USERINFO VERSION']);
|
||||||
|
$irc->ctcp_auto_reply ('ACTION',
|
||||||
|
sub {
|
||||||
|
my ($cl, $src, $target, $tag, $msg, $type) = @_;
|
||||||
|
return ['ACTION', $msg];
|
||||||
|
}
|
||||||
|
);
|
||||||
|
$irc->ctcp_auto_reply ('FINGER', ['FINGER', $c->{nick}]);
|
||||||
|
$irc->ctcp_auto_reply ('PING',
|
||||||
|
sub {
|
||||||
|
my ($cl, $src, $target, $tag, $msg, $type) = @_;
|
||||||
|
return ['PING', $msg];
|
||||||
|
}
|
||||||
|
);
|
||||||
|
$irc->ctcp_auto_reply ('SOURCE', ['SOURCE', 'https://github.com/eleksir/aleesa-irc-bot']);
|
||||||
|
$irc->ctcp_auto_reply ('USERINFO', ['USERINFO', $c->{nick}]);
|
||||||
|
$irc->ctcp_auto_reply ('VERSION', ['VERSION', 'Aleesa IRC Bot/1.0']);
|
||||||
|
$irc->ctcp_auto_reply ('TIME', ['TIME', gmtime_to_iso8601_datetime (time ()) ]);
|
||||||
|
|
||||||
|
if ($c->{ssl}) {
|
||||||
|
$irc->enable_ssl ();
|
||||||
|
}
|
||||||
|
|
||||||
|
$irc->connect (
|
||||||
|
$c->{server},
|
||||||
|
$c->{port},
|
||||||
|
{
|
||||||
|
nick => $c->{nick},
|
||||||
|
user => $c->{nick},
|
||||||
|
real => $c->{nick}
|
||||||
|
}
|
||||||
|
);
|
||||||
|
|
||||||
|
$cv->wait;
|
||||||
|
$irc->disconnect;
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
1;
|
||||||
|
|
||||||
|
# vim: set ft=perl noet ai ts=4 sw=4 sts=4:
|
||||||
Reference in New Issue
Block a user