Compare commits
5 Commits
v1.2
...
4d9cde38be
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
4d9cde38be | ||
|
|
61ad8278d5 | ||
|
|
7ddd97710c | ||
|
|
1229199ddc | ||
|
|
5f31a10832 |
10
lib/Karma.pm
10
lib/Karma.pm
@@ -1,4 +1,5 @@
|
||||
package Karma;
|
||||
# Хранит и выдаёт карму фразы
|
||||
|
||||
use 5.018; ## no critic (ProhibitImplicitImport)
|
||||
use strict;
|
||||
@@ -22,18 +23,17 @@ my $c = LoadConf ();
|
||||
my $cachedir = $c->{cachedir};
|
||||
my $max = 5;
|
||||
|
||||
# swallow phrase and return answer
|
||||
sub KarmaSet (@) {
|
||||
my $chatid = shift;
|
||||
my $phrase = shift;
|
||||
my $action = shift;
|
||||
|
||||
$phrase = trim ($phrase);
|
||||
|
||||
if ((! defined $phrase) || $phrase eq '') {
|
||||
$phrase = ' ';
|
||||
}
|
||||
|
||||
$phrase = trim ($phrase);
|
||||
|
||||
my $cache = CHI->new (
|
||||
driver => 'BerkeleyDB',
|
||||
root_dir => $cachedir,
|
||||
@@ -80,12 +80,12 @@ sub KarmaGet (@) {
|
||||
my $chatid = shift;
|
||||
my $phrase = shift;
|
||||
|
||||
$phrase = trim ($phrase);
|
||||
|
||||
if ((! defined $phrase) || $phrase eq '') {
|
||||
$phrase = ' ';
|
||||
}
|
||||
|
||||
$phrase = trim ($phrase);
|
||||
|
||||
my $cache = CHI->new (
|
||||
driver => 'BerkeleyDB',
|
||||
root_dir => $cachedir,
|
||||
|
||||
@@ -67,11 +67,14 @@ my $parse_message = sub {
|
||||
$answer->{misc}->{msg_format} = 0;
|
||||
}
|
||||
|
||||
$answer->{userid} = 0 + $m->{userid};
|
||||
$answer->{chatid} = 0 + $m->{chatid};
|
||||
|
||||
$log->debug ('[DEBUG] Incoming message ' . Dumper ($m));
|
||||
|
||||
# Нормальная команда
|
||||
if (substr ($m->{message}, 0, 1) eq $answer->{misc}->{csign}) {
|
||||
my $cmd = substr ($m->{message}, 1);
|
||||
if (substr ($m->{message}, 0, length ($answer->{misc}->{csign})) eq $answer->{misc}->{csign}) {
|
||||
my $cmd = substr $m->{message}, length ($answer->{misc}->{csign});
|
||||
|
||||
if ($cmd eq 'friday' || $cmd eq 'пятница') {
|
||||
$reply = Friday ();
|
||||
@@ -94,20 +97,42 @@ my $parse_message = sub {
|
||||
} else {
|
||||
$reply = trim (Fortune ());
|
||||
}
|
||||
} elsif ($cmd =~ /^(karma|карма)\s(.+)/su) {
|
||||
# TODO: избавиться от регулярки в пользу манипуляци со строкой через substr
|
||||
$reply = KarmaGet ($m->{chatid}, $2);
|
||||
} elsif (length ($cmd) >= length ('karma ') && substr ($cmd, 0, length ('karma ') eq 'karma ')) {
|
||||
# По-умолчанию достаём карму пустоты
|
||||
my $text = undef;
|
||||
|
||||
if (length ($cmd) > length ('karma ')) {
|
||||
$text = substr $cmd, length ('karma ');
|
||||
}
|
||||
|
||||
$reply = KarmaGet ($m->{chatid}, $text);
|
||||
} elsif (length ($cmd) >= length ('карма ') && substr ($cmd, 0, length ('карма ') eq 'карма ')) {
|
||||
# По-умолчанию достаём карму пустоты
|
||||
my $text = undef;
|
||||
|
||||
if (length ($cmd) > length ('карма ')) {
|
||||
$text = substr $cmd, length ('карма ');
|
||||
}
|
||||
|
||||
$reply = KarmaGet ($m->{chatid}, $text);
|
||||
# Достаём карму пустоты :)
|
||||
} elsif ($cmd eq 'karma') {
|
||||
$reply = KarmaGet ($m->{chatid}, undef);
|
||||
# Достаём карму пустоты :)
|
||||
}elsif ($cmd eq 'карма') {
|
||||
$reply = KarmaGet ($m->{chatid}, undef);
|
||||
}
|
||||
# Скорее всего изменение кармы, но это не точно
|
||||
} elsif (substr ($m->{message}, -2) eq '++' || substr ($m->{message}, -2) eq '--') {
|
||||
} elsif ($m->{message} > length ('++')) {
|
||||
if (substr ($m->{message}, 0 - length ('++')) eq '++' || substr ($m->{message}, 0 - length ('--')) eq '--') {
|
||||
my @arr = split /\n/s, $m->{message};
|
||||
|
||||
# Предполагается, что фраза - это только одна строка
|
||||
if ($#arr < 1) {
|
||||
$reply = KarmaSet (
|
||||
$m->{chatid},
|
||||
trim (substr $m->{message}, 0, -2),
|
||||
substr $m->{message}, -2,
|
||||
trim (substr $m->{message}, 0, 0 - length ('++')),
|
||||
substr $m->{message}, 0 - length ('++'),
|
||||
);
|
||||
# Если у нас более одной строки - пусть с этим разбирается craniac, у него есть *мозги*
|
||||
} else {
|
||||
@@ -115,15 +140,17 @@ my $parse_message = sub {
|
||||
$reply = $m->{message};
|
||||
}
|
||||
}
|
||||
|
||||
$log->debug ("[DEBUG] Sending message to channel $send_to " . Dumper ($answer));
|
||||
}
|
||||
|
||||
if (defined $reply && $answer->{misc}->{answer}) {
|
||||
$answer->{message} = $reply;
|
||||
$log->debug ("[DEBUG] Sending message to channel $send_to " . Dumper ($answer));
|
||||
|
||||
$self->json ($send_to)->notify (
|
||||
$send_to => $answer,
|
||||
);
|
||||
} else {
|
||||
$log->debug ('[DEBUG] No reply generated, skip sending message.');
|
||||
}
|
||||
|
||||
return;
|
||||
|
||||
Reference in New Issue
Block a user