aleesa-bot/aleesa-telegram
0
Fork 0
Code Pull Requests Projects Releases Activity

Implement fuzzy matching in bred answer checking to avoid repeating input phrase.

Browse Source
This commit is contained in:
eleksir
2020-12-20 14:18:04 +03:00
parent 07275c5b43
commit 0cfecd72b3
3 changed files with 20 additions and 8 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
cpanfile
View File

@@ -20,4 +20,5 @@ requires 'Log::Any::For::Std';
requires 'Mojo::Base';
requires 'Mojo::IOLoop';
requires 'Mojo::UserAgent';
requires 'Text::Fuzzy';
requires 'URI::URL';

18
lib/botlib.pm
View File

@@ -13,6 +13,7 @@ use URI::URL;
use JSON::XS qw(decode_json encode_json);
use Digest::MD5 qw(md5_base64);
use DB_File;
use Text::Fuzzy qw(distance_edits);
use conf qw(loadConf);
use lat qw(latAnswer);
use karma qw(karmaSet karmaGet);
@@ -22,7 +23,7 @@ use archeologist qw (dig);
use vars qw/$VERSION/;
use Exporter qw(import);
our @EXPORT_OK = qw(weather trim randomCommonPhrase command highlight botsleep);
our @EXPORT_OK = qw(weather trim randomCommonPhrase command highlight botsleep fmatch);
$VERSION = '1.0';
my $c = loadConf();
@@ -362,6 +363,21 @@ sub botsleep {
return;
}
sub fmatch {
my $srcphrase = shift;
my $answer = shift;
my ($distance, undef) = distance_edits ($srcphrase, $answer);
my $srcphraselen = length $srcphrase;
my $distance_max = int ($srcphraselen - ($srcphraselen * (100 - (90 / ($srcphraselen ** 0.5))) * 0.01));
if ($distance >= $distance_max) {
return 0;
} else {
return 1;
}
}
1;
# vim: set ft=perl noet ai ts=4 sw=4 sts=4:

9
lib/telegrambot.pm
View File

@@ -12,7 +12,7 @@ use File::Path qw(mkpath);
use Hailo;
use Mojo::Base 'Teapot::Bot::Brain';
use conf qw(loadConf);
use botlib qw(weather trim randomCommonPhrase command highlight botsleep);
use botlib qw(weather trim randomCommonPhrase command highlight botsleep fmatch);
use karma qw(karmaSet);
use fortune qw(fortune fortune_toggle_list);
@@ -287,12 +287,7 @@ sub __on_msg {
$phrase = lc ($phrase);
if (lc ($reply) eq $phrase) {
$reply = randomCommonPhrase ();
} elsif (lc ($reply) eq substr ($phrase, 0, -1)) {
# in case of trailing dot
$reply = randomCommonPhrase ();
} elsif (substr (lc ($reply), 0, -1) eq $phrase) {
if (fmatch (lc ($reply), $phrase)) {
$reply = randomCommonPhrase ();
}