Refactor code. Fix some bugs.
+ Use lazy brain init. * Move plugin code out of botlib.pm. + Now bot can private chatting * Properly detect real jid if can, extract username from jid * Change chatid generation, so all previously generated brains will be lost + Add !dig and !копать commands + Add !cat and !кис commands * Some other minor changes
This commit is contained in:
eleksir
223
lib/jabberbot.pm
223
lib/jabberbot.pm
@@ -7,22 +7,23 @@ use 5.018;
|
||||
use strict;
|
||||
use warnings;
|
||||
use utf8;
|
||||
use open qw(:std :utf8);
|
||||
use Net::Jabber::Bot;
|
||||
use open qw (:std :utf8);
|
||||
use English qw ( -no_match_vars );
|
||||
use Carp qw(carp);
|
||||
use File::Path qw (make_path);
|
||||
use Hailo;
|
||||
use conf qw(loadConf);
|
||||
use botlib qw(weather trim randomCommonPhrase);
|
||||
use lat qw(latAnswer);
|
||||
use karma qw(karmaSet karmaGet);
|
||||
use friday qw(friday);
|
||||
use fortune qw(fortune);
|
||||
use Net::Jabber::Bot;
|
||||
use botlib qw (command randomCommonPhrase realjid);
|
||||
use conf qw (loadConf);
|
||||
use karma qw (karmaSet);
|
||||
use util qw (trim utf2sha1);
|
||||
|
||||
use Exporter qw(import);
|
||||
use Exporter qw (import);
|
||||
use vars qw/$VERSION/;
|
||||
$VERSION = '1.0';
|
||||
our @EXPORT_OK = qw(run_jabberbot);
|
||||
our @EXPORT_OK = qw (run_jabberbot);
|
||||
|
||||
my $c = loadConf();
|
||||
my $c = loadConf ();
|
||||
my $hailo;
|
||||
my $imonline = 0;
|
||||
|
||||
@@ -40,128 +41,94 @@ sub __background_checks {
|
||||
sub __new_bot_message {
|
||||
my %hash = @_;
|
||||
my $bot = $hash{bot_object};
|
||||
|
||||
# ignore self messages
|
||||
if ($hash{'from_full'} eq $bot->{'from_full'}) {
|
||||
return;
|
||||
}
|
||||
|
||||
my $text = $hash{body};
|
||||
|
||||
my %jid = realjid (%hash);
|
||||
my $chattername = $jid{'name'};
|
||||
my $chatid;
|
||||
|
||||
if ($hash{'type'} eq 'groupchat') {
|
||||
# ignore self messages
|
||||
return if ($hash{'from_full'} eq $bot->{'from_full'});
|
||||
# parse messages
|
||||
my $qname = quotemeta ($c->{jabberbot}->{aleesa}->{mucname});
|
||||
if ($text =~ /^$qname$/) {
|
||||
$bot->SendGroupMessage ($hash{'reply_to'}, 'Чего тебе?');
|
||||
} elsif ($text =~ /^$qname[\,|\:]? (.+)/) {
|
||||
$bot->SendGroupMessage ($hash{'reply_to'}, $hailo->learn_reply($1));
|
||||
} elsif ($text eq "$c->{jabberbot}->{aleesa}->{csign}пинг") {
|
||||
$bot->SendGroupMessage ($hash{'reply_to'}, 'Понг.');
|
||||
} elsif ($text eq "$c->{jabberbot}->{aleesa}->{csign}ping") {
|
||||
$bot->SendGroupMessage ($hash{'reply_to'}, 'Pong.');
|
||||
} elsif (substr ($text, 0, 1) eq $c->{jabberbot}->{aleesa}->{csign}) {
|
||||
if (substr ($text, 1, 3) eq 'rum') {
|
||||
eval {
|
||||
$bot->SendGroupMessage (
|
||||
$hash{'reply_to'},
|
||||
'/me притаскивает на подносе стопку рома для ' . (split (/\//,$hash{from_full}))[1] . ', края стопки искрятся кристаллами соли.'
|
||||
);
|
||||
};
|
||||
} elsif (substr ($text, 1, 5) eq 'vodka') {
|
||||
eval {
|
||||
$bot->SendGroupMessage (
|
||||
$hash{'reply_to'},
|
||||
'/me подаёт водку с маринованным огурчиком для ' . (split (/\//,$hash{from_full}))[1]
|
||||
);
|
||||
};
|
||||
} elsif (substr($text, 1, 4) eq 'beer') {
|
||||
eval {
|
||||
$bot->SendGroupMessage (
|
||||
$hash{'reply_to'},
|
||||
'/me бахает об стол перед ' . (split (/\//,$hash{from_full}))[1] . ' кружкой холодного пива, часть пенной шапки сползает по запотевшей спенке кружки.'
|
||||
);
|
||||
};
|
||||
} elsif (substr($text, 1, 7) eq 'tequila') {
|
||||
eval {
|
||||
$bot->SendGroupMessage (
|
||||
$hash{'reply_to'},
|
||||
'/me ставит рядом с ' . (split (/\//,$hash{from_full}))[1] . ' шот текилы, аккуратно на ребро стопки насаживает дольку лайма и ставит кофейное блюдце с горочкой соли.'
|
||||
);
|
||||
};
|
||||
} elsif (substr ($text, 1, 6) eq 'whisky') {
|
||||
eval {
|
||||
$bot->SendGroupMessage (
|
||||
$hash{'reply_to'},
|
||||
'/me демонстративно достаёт из морозилки пару кубических камушков, бросает их в толстодонный стакан и аккуратно наливает Jack Daniels. Запускает стакан вдоль барной стойки, он останавливается около ' . (split (/\//,$hash{from_full}))[1] . '.'
|
||||
);
|
||||
};
|
||||
} elsif (substr ($text, 1, 8) eq 'absinthe') {
|
||||
eval {
|
||||
$bot->SendGroupMessage (
|
||||
$hash{'reply_to'},
|
||||
"/me наливает абсент в стопку. Смочив кубик сахара в абсенте кладёт его на дырявую ложечку и пожигает. Как только пламя потухнет, $c->{jabberbot}->{aleesa}->{mucname} размешивает оплавившийся кубик в абсенте и подносит стопку " .(split (/\//,$hash{from_full}))[1] . '.'
|
||||
);
|
||||
};
|
||||
} elsif (substr ($text, 1, 2) eq 'w ' || substr ($text, 1, 2) eq 'п ') {
|
||||
my $city = substr ($text, 2);
|
||||
$chatid = utf2sha1 $hash{'reply_to'};
|
||||
} else {
|
||||
$chatid = utf2sha1 $jid{'name'};
|
||||
}
|
||||
|
||||
eval {
|
||||
$bot->SendGroupMessage (
|
||||
$hash{'reply_to'},
|
||||
weather($city) =~ tr/\n/ /r
|
||||
);
|
||||
};
|
||||
} elsif (substr ($text, 1) eq 'version' || substr ($text, 1) eq 'ver') {
|
||||
$bot->SendGroupMessage ($hash{'reply_to'}, 'Версия нуль.чего-то_там.чего-то_там');
|
||||
} elsif (substr ($text, 1) eq 'help' || substr ($text, 1) eq 'помощь') {
|
||||
$bot->SendGroupMessage ($hash{'reply_to'}, <<"EOL" );
|
||||
!help | !помощь - это сообщение
|
||||
!f | !ф | !fortune | !фортунка - рандомная фраза из сборника цитат fortune_mod
|
||||
!friday | !пятница - а не пятница ли сегодня?
|
||||
!lat | !лат - сгенерировать фразу из крылатого латинского выражения
|
||||
!ping | !пинг - попинговать бота
|
||||
!some_brew - выдать соответсвующий напиток, бармен может налить rum, vodka, beer, tequila, whisky, absinthe
|
||||
!ver | !version | !версия - написать что-то про версию ПО
|
||||
!w город | !п город - погода в городе
|
||||
!karma фраза | !карма фраза - посмотреть карму фразы
|
||||
фраза++ | фраза-- - повысить или понизить карму фразы
|
||||
EOL
|
||||
$chatid =~ s/\//-/xmsg;
|
||||
|
||||
} elsif (substr ($text, 1) eq 'lat' || substr ($text, 1) eq 'лат') {
|
||||
$bot->SendGroupMessage ($hash{'reply_to'}, latAnswer ());
|
||||
} elsif (substr ($text, 1, 6) eq 'karma ' || substr($text, 1, 6) eq 'карма ' || substr ($text, 1) eq 'karma' || substr ($text, 1) eq 'карма') {
|
||||
my $mytext = substr ($text, 7);
|
||||
my $reply;
|
||||
|
||||
if ($mytext ne '') {
|
||||
chomp $mytext;
|
||||
$mytext = trim $mytext;
|
||||
}
|
||||
# lazy init chat-bot brains
|
||||
unless (defined ($hailo->{$chatid})) {
|
||||
my $braindir = $c->{jabberbot}->{braindir};
|
||||
my $brainname = sprintf '%s/%s.sqlite', $braindir, $chatid;
|
||||
|
||||
$bot->SendGroupMessage ($hash{'reply_to'}, karmaGet ($hash{'reply_to'}, $mytext));
|
||||
} elsif (substr ($text, 1) eq 'friday' || substr ($text, 1) eq 'пятница') {
|
||||
$bot->SendGroupMessage ($hash{'reply_to'}, friday ());
|
||||
} elsif (substr ($text, 1) eq 'fortune' || substr ($text, 1) eq 'фортунка' || substr ($text, 1) eq 'f' || substr ($text, 1) eq 'ф') {
|
||||
my $phrase = fortune ();
|
||||
# workaround Net::Jabber::Bot outgoing message ![:print:] replacement
|
||||
$phrase =~ s/\s\s+\-\-/\n \-\-/xmsg;
|
||||
$bot->SendGroupMessage ($hash{'reply_to'}, $phrase);
|
||||
} else {
|
||||
$hailo->learn ($text);
|
||||
unless (-d $braindir) {
|
||||
make_path ($braindir) or do {
|
||||
carp "[ERROR] Unable to create $braindir: $OS_ERROR";
|
||||
return;
|
||||
}
|
||||
} elsif ((substr ($text, -2) eq '++') || (substr ($text, -2) eq '--')) {
|
||||
my @arr = split (/\n/, $text);
|
||||
|
||||
if ($#arr < 1) {
|
||||
my $reply = karmaSet($hash{'reply_to'}, substr ($text, 0, -2), substr ($text, -2));
|
||||
$bot->SendGroupMessage ($hash{'reply_to'}, $reply);
|
||||
} else {
|
||||
# just message in chat
|
||||
$hailo->learn ($text);
|
||||
}
|
||||
} else {
|
||||
$hailo->learn ($text);
|
||||
return;
|
||||
};
|
||||
}
|
||||
|
||||
$hailo->{$chatid} = Hailo->new (
|
||||
brain => $brainname,
|
||||
order => 2
|
||||
);
|
||||
|
||||
if ($hash{'type'} eq 'groupchat') {
|
||||
carp "[INFO] Initialized brain for chat $hash{'reply_to'}: $brainname";
|
||||
} else {
|
||||
carp "[INFO] Initialized brain for chat $jid{'jid'}: $brainname";
|
||||
}
|
||||
}
|
||||
|
||||
# parse messages
|
||||
my $qname = quotemeta ($bot->{'alias'});
|
||||
|
||||
if ($text =~ /^$qname\,?\s*$/) {
|
||||
$reply = 'Чего тебе?';
|
||||
} elsif (($text =~ /^$qname[\,|\:]? (.+)/) && ($hash{'type'} eq 'groupchat')) {
|
||||
$reply = $hailo->{$chatid}->learn_reply ($1);
|
||||
} elsif (substr ($text, 0, 1) eq $c->{jabberbot}->{aleesa}->{csign}) {
|
||||
$reply = command (%hash);
|
||||
# karma agjustment
|
||||
} elsif (substr ($text, -2) eq '++' || substr ($text, -2) eq '--') {
|
||||
my @arr = split(/\n/, $text);
|
||||
|
||||
if ($#arr < 1) {
|
||||
$reply = karmaSet ($chatid, trim (substr ($text, 0, -2)), substr ($text, -2));
|
||||
} else {
|
||||
# just message in chat
|
||||
# in groupchat we answer only to phrases that mention us
|
||||
if ($hash{'type'} eq 'groupchat') {
|
||||
$hailo->{$chatid}->learn ($text);
|
||||
# in tet-a-tet chat we must always answer, if possible
|
||||
} elsif ($hash{'type'} eq 'chat') {
|
||||
$reply = $hailo->{$chatid}->learn_reply ($text);
|
||||
}
|
||||
}
|
||||
# just message in chat
|
||||
} else {
|
||||
# in groupchat we answer only to phrases that mention us
|
||||
if ($hash{'type'} eq 'groupchat') {
|
||||
$hailo->{$chatid}->learn ($text);
|
||||
# in tet-a-tet chat we must always answer, if possible
|
||||
} elsif ($hash{'type'} eq 'chat') {
|
||||
$reply = $hailo->{$chatid}->learn_reply ($text);
|
||||
}
|
||||
}
|
||||
|
||||
if (defined $reply && ($reply ne '')) {
|
||||
if ($hash{'type'} eq 'groupchat') {
|
||||
$bot->SendGroupMessage ($hash{'reply_to'}, $reply);
|
||||
} elsif ($hash{'type'} eq 'chat') {
|
||||
$bot->SendPersonalMessage ($hash{'reply_to'}, $reply);
|
||||
}
|
||||
} elsif ($hash{'type'} eq 'chat') {
|
||||
$bot->SendPersonalMessage ($hash{'reply_to'}, 'Я вас не знаю, идите нахуй.');
|
||||
return;
|
||||
}
|
||||
|
||||
return;
|
||||
@@ -169,11 +136,6 @@ EOL
|
||||
|
||||
|
||||
sub run_jabberbot {
|
||||
$hailo = Hailo->new (
|
||||
brain => $c->{jabberbot}->{aleesa}->{brain},
|
||||
order => 2
|
||||
);
|
||||
|
||||
my %conflist = ();
|
||||
$conflist{$c->{jabberbot}->{aleesa}->{room}} = [];
|
||||
my $qname = quotemeta ($c->{jabberbot}->{aleesa}->{mucname});
|
||||
@@ -182,7 +144,8 @@ sub run_jabberbot {
|
||||
server => $c->{jabberbot}->{aleesa}->{host},
|
||||
server_host => $c->{jabberbot}->{aleesa}->{host},
|
||||
conference_server => $c->{jabberbot}->{aleesa}->{confsrv},
|
||||
tls => 0,
|
||||
tls => 1,
|
||||
ssl_verify => 0,
|
||||
username => $c->{jabberbot}->{aleesa}->{authname},
|
||||
# threre is some nasty bug in module, so we have to set from_full explicitly
|
||||
from_full => sprintf (
|
||||
|
||||
Reference in New Issue
Block a user