From c6c53d6ebf52e2d45a4b96d36e9c4a7c51dde37c Mon Sep 17 00:00:00 2001 From: eleksir Date: Thu, 12 Nov 2020 02:15:00 +0300 Subject: [PATCH] First karma run fixes Thanks Ilya Savin for very special utf8 test case for karma. --- cpanfile | 2 +- data/sample_config.json | 3 +++ lib/karma.pm | 59 ++++++++++++++++++++++++++++++++--------- lib/telegrambot.pm | 10 +++---- 4 files changed, 55 insertions(+), 19 deletions(-) diff --git a/cpanfile b/cpanfile index 8e90043..a6a82a8 100644 --- a/cpanfile +++ b/cpanfile @@ -3,7 +3,7 @@ requires 'Cwd::utf8'; requires 'DB_File'; requires 'Digest::MD5'; requires 'Data::Dumper'; -requires 'Digest::SHA1'; +requires 'Digest::SHA'; requires 'File::Basename'; requires 'File::Path'; requires 'Hailo'; diff --git a/data/sample_config.json b/data/sample_config.json index 2396a08..b4cc8b2 100644 --- a/data/sample_config.json +++ b/data/sample_config.json @@ -15,5 +15,8 @@ }, "lat" : { "brain": "data/lat/lat.sqlite" + }, + "karma" : { + "dir": "data/karma" } } diff --git a/lib/karma.pm b/lib/karma.pm index afebaf4..e446679 100644 --- a/lib/karma.pm +++ b/lib/karma.pm @@ -6,7 +6,7 @@ use warnings; use utf8; use open qw(:std :utf8); use English qw( -no_match_vars ); -use Digest::SHA1; +use Digest::SHA qw(sha1_base64); use DB_File; use vars qw/$VERSION/; @@ -15,8 +15,6 @@ our @EXPORT_OK = qw(karmaSet karmaGet); $VERSION = '1.0'; -use File::Basename qw(dirname); -use File::Path qw(mkpath); use conf qw(loadConf); use botlib qw(logger); @@ -30,14 +28,25 @@ sub karmaSet (@) { my $phrase = shift; my $action = shift; my $score = 0; - my $karmafile = sprintf "$karmadir/%s.db", sha1_base64 ($chatid); + # sha1* does not understand utf8, so explicitly construct string cost of decimal numbers only + my $karmafile = join ('', unpack ('C*', $chatid)); + $karmafile = sha1_base64 ($karmafile); + # sha1 string can contain slashes, so make a bit longer string consist of only decimal numbers + $karmafile = join ('', unpack ('C*', $karmafile)); + $karmafile = sprintf '%s/%s.db', $karmadir, $karmafile; + + if (($phrase eq '') || ($phrase =~ /^ +$/)) { + $phrase = ''; + } + # init hash, store phrase and score - tie my %karma, 'DB_File', $karmafile or do { + tie my %karma, 'DB_File', $karmafile || do { logger "Something nasty happen when cachedata ties to its data: $OS_ERROR"; return sprintf 'Карма %s составляет 0', $phrase; }; - my $sha1_phrase = sha1($phrase); + # bdb does not understand utf8, so tied hash too, we do not want store original phrase anyway + my $sha1_phrase = sha1_base64 (join ('', unpack ('C*', $phrase))); if (defined $karma{$sha1_phrase}) { if ($action eq '++') { @@ -50,17 +59,27 @@ sub karmaSet (@) { } else { if ($action eq '++') { $karma{$sha1_phrase} = 1; + $score = 1; } else { $karma{$sha1_phrase} = -1; + $score = -1; } } untie %karma; - if ($score < 0 && (($score % $max) - 1) == 0)) { - return sprintf 'Зарегистрировано пробитие дна, карма %s составляет %d', $phrase, $score; + if ($score < -1 && (($score % (0 - $max)) + 1) == 0) { + if ($phrase eq '') { + return sprintf 'Зарегистрировано пробитие дна, карма пустоты составляет %d', $score; + } else { + return sprintf 'Зарегистрировано пробитие дна, карма %s составляет %d', $phrase, $score; + } } else { - return sprintf 'Карма %s составляет %d', $phrase, $score; + if ($phrase eq '') { + return sprintf 'Карма пустоты составляет %d', $score; + } else { + return sprintf 'Карма %s составляет %d', $phrase, $score; + } } } @@ -68,15 +87,25 @@ sub karmaSet (@) { sub karmaGet (@) { my $chatid = shift; my $phrase = shift; + # sha1* does not understand utf8, so explicitly construct string cost of decimal numbers only + my $karmafile = join ('', unpack ('C*', $chatid)); + $karmafile = sha1_base64 ($karmafile); + # sha1 string can contain slashes, so make a bit longer string consist of only decimal numbers + $karmafile = join ('', unpack ('C*', $karmafile)); + $karmafile = sprintf '%s/%s.db', $karmadir, $karmafile; + + if (($phrase eq '') || ($phrase =~ /^ +$/)) { + $phrase = ''; + } - my $karmafile = sprintf "$karmadir/%s.db", sha1_base64 ($chatid); # init hash, store phrase and score - tie my %karma, 'DB_File', $karmafile or do { + tie my %karma, 'DB_File', $karmafile || do { logger "Something nasty happen when karma ties to its data: $OS_ERROR"; return sprintf 'Карма %s составляет 0', $phrase; }; - my $sha1_phrase = sha1 ($phrase); + # bdb does not understand utf8, so tied hash too, we do not want store original phrase anyway + my $sha1_phrase = sha1_base64 (join ('', unpack ('C*', $phrase))); my $score = $karma{$sha1_phrase}; untie %karma; @@ -84,7 +113,11 @@ sub karmaGet (@) { $score = 0; } - return sprintf 'Карма %s составляет %d', $phrase, $score; + if ($phrase eq '') { + return sprintf 'Карма пустоты составляет %d', $score; + } else { + return sprintf 'Карма %s составляет %d', $phrase, $score; + } } 1; diff --git a/lib/telegrambot.pm b/lib/telegrambot.pm index 45ff005..61309a8 100644 --- a/lib/telegrambot.pm +++ b/lib/telegrambot.pm @@ -16,6 +16,7 @@ use conf qw(loadConf); use botlib qw(weather logger trim randomCommonPhrase); use telegramlib qw(visavi); use lat qw(latAnswer); +use karma qw(karmaSet karmaGet); use Exporter qw(import); our @EXPORT_OK = qw(run_telegrambot); @@ -357,12 +358,11 @@ MYHELP $reply = weather ($city); } elsif (length ($text) == 4 && (substr ($text, 1, 3) eq 'lat' || substr ($text, 1, 3) eq 'лат')) { $reply = latAnswer(); - } elsif ((length($text) > 8) || (substr ($text, 1, 6) eq 'karma ') || (substr ($text, 1, 6) eq 'карма ')) { + } elsif ((length ($text) >= 7) && ((substr ($text, 1, 6) eq 'karma ') || (substr ($text, 1, 6) eq 'карма '))) { my $mytext = substr ($text, 7); + chomp ($mytext); $mytext = trim ($mytext); $reply = karmaGet ($chatid, $mytext); - } elsif ((length($text) > 8) || (substr ($text, 1, 6) eq 'karma ') || (substr ($text, 1, 6) eq 'карма ')) { - $reply = 'Простите, что? Карма пустоты?'; } } elsif ( ($text eq $qname) or @@ -384,11 +384,11 @@ MYHELP } elsif ((lc ($text) =~ /.+ ${qtname}[\,|\!|\?|\.| ]/) or (lc ($text) =~ / $qtname$/)) { $phrase = $text; $reply = $hailo->{$msg->chat->id}->reply ($phrase); - } elsif ((substr ($text, -2) eq '++') && (substr ($text, -2) eq '--')) { + } elsif ((substr ($text, -2) eq '++') || (substr ($text, -2) eq '--')) { my @arr = split(/\n/, $text); if ($#arr < 1) { - $reply = kermaSet ($chatid, $phrase, substr ($text, -2)); + $reply = karmaSet ($chatid, substr ($text, 0, -2), substr ($text, -2)); } else { # just message in chat $hailo->{$msg->chat->id}->learn ($text);