First karma run fixes

Thanks Ilya Savin for very special utf8 test case for karma.

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';

data/sample_config.json

@@ -15,5 +15,8 @@
     },
     "lat" : {
         "brain": "data/lat/lat.sqlite"
+    },
+    "karma" : {
+        "dir": "data/karma"
     }
 }

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,33 +59,53 @@ 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)) {
+	if ($score < -1 && (($score % (0 - $max)) + 1) == 0) {
+		if ($phrase eq '') {
+			return sprintf 'Зарегистрировано пробитие дна, карма пустоты составляет %d', $score;
+		} else {
 			return sprintf 'Зарегистрировано пробитие дна, карма %s составляет %d', $phrase, $score;
+		}
+	} else {
+		if ($phrase eq '') {
+			return sprintf 'Карма пустоты составляет %d', $score;
 		} else {
 			return sprintf 'Карма %s составляет %d', $phrase, $score;
 		}
 	}
+}
 
 # just return answer
 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,8 +113,12 @@ sub karmaGet (@) {
 		$score = 0;
 	}
 
+	if ($phrase eq '') {
+		return sprintf 'Карма пустоты составляет %d', $score;
+	} else {
 		return sprintf 'Карма %s составляет %d', $phrase, $score;
 	}
+}
 
 1;
 

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);