More heavy perlcritic policies, more careful work with strings/substr
This commit is contained in:
eleksir
@@ -10,10 +10,10 @@ use utf8;
|
||||
use open qw (:std :utf8);
|
||||
use English qw ( -no_match_vars );
|
||||
use File::Path qw (make_path);
|
||||
use Hailo;
|
||||
use Hailo ();
|
||||
use Log::Any qw ($log);
|
||||
use Net::Jabber::Bot;
|
||||
use BotLib qw (Command RandomCommonPhrase RealJID);
|
||||
use Net::Jabber::Bot ();
|
||||
use BotLib qw (Command RealJID);
|
||||
use BotLib::Conf qw (LoadConf);
|
||||
use BotLib::Karma qw (KarmaSet);
|
||||
use BotLib::Util qw (trim utf2sha1);
|
||||
@@ -23,6 +23,7 @@ use Exporter qw (import);
|
||||
our @EXPORT_OK = qw (RunJabberBot);
|
||||
|
||||
my $c = LoadConf ();
|
||||
my $csign = $c->{jabberbot}->{aleesa}->{csign};
|
||||
my $hailo;
|
||||
my $imonline = 0;
|
||||
|
||||
@@ -42,19 +43,19 @@ sub __new_bot_message {
|
||||
my $bot = $hash{bot_object};
|
||||
|
||||
# ignore self messages
|
||||
if ($hash{'from_full'} eq $bot->{'from_full'}) {
|
||||
if ($hash{from_full} eq $bot->{from_full}) {
|
||||
return;
|
||||
}
|
||||
|
||||
my $text = $hash{body};
|
||||
my %jid = RealJID (%hash);
|
||||
my $chattername = $jid{'name'};
|
||||
my $chattername = $jid{name};
|
||||
my $chatid;
|
||||
|
||||
if ($hash{'type'} eq 'groupchat') {
|
||||
$chatid = utf2sha1 $hash{'reply_to'};
|
||||
if ($hash{type} eq 'groupchat') {
|
||||
$chatid = utf2sha1 $hash{reply_to};
|
||||
} else {
|
||||
$chatid = utf2sha1 $jid{'name'};
|
||||
$chatid = utf2sha1 $jid{name};
|
||||
}
|
||||
|
||||
$chatid =~ s/\//-/xmsg;
|
||||
@@ -75,10 +76,10 @@ sub __new_bot_message {
|
||||
|
||||
$hailo->{$chatid} = Hailo->new (
|
||||
brain => $brainname,
|
||||
order => 2
|
||||
order => 2,
|
||||
);
|
||||
|
||||
if ($hash{'type'} eq 'groupchat') {
|
||||
if ($hash{type} eq 'groupchat') {
|
||||
$log->info ("[INFO] Initialized brain for chat $hash{'reply_to'}: $brainname");
|
||||
} else {
|
||||
$log->info ("[INFO] Initialized brain for chat $jid{'jid'}: $brainname");
|
||||
@@ -86,34 +87,39 @@ sub __new_bot_message {
|
||||
}
|
||||
|
||||
# parse messages
|
||||
my $qname = quotemeta $bot->{'alias'};
|
||||
my $qname = quotemeta $bot->{alias};
|
||||
|
||||
if ($text =~ /^$qname\,?\s*$/) {
|
||||
if ($text =~ /^$qname\,?\s*$/u) {
|
||||
$reply = 'Чего тебе?';
|
||||
} elsif (($text =~ /^$qname[\,|\:]? (.+)/) && ($hash{'type'} eq 'groupchat')) {
|
||||
} elsif (($text =~ /^$qname[\,|\:]? (.+)/u) && ($hash{type} eq 'groupchat')) {
|
||||
$reply = $hailo->{$chatid}->learn_reply ($1);
|
||||
} elsif ($text =~ /^=\($/u || $text =~ /^\:\($/u || $text eq /^\)\:$/u) {
|
||||
$reply = ':)';
|
||||
} elsif ($text =~ /^=\)$/u || $text =~ /^\:\)$/u || $text =~ /^\(\:$/u) {
|
||||
$reply = ':D';
|
||||
# karma adjustment
|
||||
} elsif (substr ($text, -2) eq '++' || substr ($text, -2) eq '--') {
|
||||
} elsif ($text =~ /(\+\+|\-\-)$/) {
|
||||
my @arr = split /\n/, $text;
|
||||
|
||||
if ($#arr < 1) {
|
||||
$reply = KarmaSet ($chatid, trim (substr ($text, 0, -2)), substr ($text, -2));
|
||||
$text =~ /(.*)(\+\+|\-\-)$/u;
|
||||
$reply = KarmaSet ($chatid, trim ($1), $2); ## no critic (RegularExpressions::ProhibitCaptureWithoutTest)
|
||||
} else {
|
||||
# just message in chat
|
||||
# in groupchat we answer only to phrases that mention us
|
||||
if ($hash{'type'} eq 'groupchat') {
|
||||
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') {
|
||||
} elsif ($hash{type} eq 'chat') {
|
||||
$reply = $hailo->{$chatid}->learn_reply ($text);
|
||||
}
|
||||
}
|
||||
} elsif (substr ($text, 0, 1) eq $c->{jabberbot}->{aleesa}->{csign}) {
|
||||
} elsif ((length ($text) > length ($csign)) && (substr ($text, 0, length ($csign)) eq $csign)) {
|
||||
$reply = Command (%hash);
|
||||
# just message in chat
|
||||
} else {
|
||||
# in groupchat we answer only to phrases that mention us
|
||||
if ($hash{'type'} eq 'groupchat') {
|
||||
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') {
|
||||
@@ -139,27 +145,27 @@ sub RunJabberBot {
|
||||
my $qname = quotemeta $c->{jabberbot}->{aleesa}->{mucname};
|
||||
|
||||
my $bot = Net::Jabber::Bot->new (
|
||||
server => $c->{jabberbot}->{aleesa}->{host},
|
||||
server_host => $c->{jabberbot}->{aleesa}->{host},
|
||||
conference_server => $c->{jabberbot}->{aleesa}->{confsrv},
|
||||
tls => 1,
|
||||
ssl_verify => 0,
|
||||
username => $c->{jabberbot}->{aleesa}->{authname},
|
||||
server => $c->{jabberbot}->{aleesa}->{host},
|
||||
server_host => $c->{jabberbot}->{aleesa}->{host},
|
||||
conference_server => $c->{jabberbot}->{aleesa}->{confsrv},
|
||||
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 (
|
||||
from_full => sprintf (
|
||||
'%s@%s/%s',
|
||||
$c->{jabberbot}->{aleesa}->{room},
|
||||
$c->{jabberbot}->{aleesa}->{confsrv},
|
||||
$c->{jabberbot}->{aleesa}->{authname}
|
||||
$c->{jabberbot}->{aleesa}->{authname},
|
||||
),
|
||||
password => $c->{jabberbot}->{aleesa}->{password},
|
||||
alias => $c->{jabberbot}->{aleesa}->{mucname}, # name on confs
|
||||
resource => 'bot',
|
||||
safety_mode => 1,
|
||||
message_function => \&__new_bot_message,
|
||||
password => $c->{jabberbot}->{aleesa}->{password},
|
||||
alias => $c->{jabberbot}->{aleesa}->{mucname}, # name on confs
|
||||
resource => 'bot',
|
||||
safety_mode => 1,
|
||||
message_function => \&__new_bot_message,
|
||||
background_function => \&__background_checks,
|
||||
loop_sleep_time => 60,
|
||||
loop_sleep_time => 60,
|
||||
forums_and_responses => \%conflist,
|
||||
);
|
||||
|
||||
|
||||
Reference in New Issue
Block a user