Make use of karma module

cpanfile

@@ -3,6 +3,7 @@ requires 'Cwd::utf8';
 requires 'DB_File';
 requires 'Digest::MD5';
 requires 'Data::Dumper';
+requires 'Digest::SHA1';
 requires 'File::Basename';
 requires 'File::Path';
 requires 'Hailo';

lib/karma.pm

@@ -0,0 +1,92 @@
+package karma;
+
+use 5.018;
+use strict;
+use warnings;
+use utf8;
+use open qw(:std :utf8);
+use English qw( -no_match_vars );
+use Digest::SHA1;
+use DB_File;
+
+use vars qw/$VERSION/;
+use Exporter qw(import);
+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);
+
+my $c = loadConf();
+my $karmadir = $c->{karma}->{dir};
+my $max = 5;
+
+# swallow phrase and return answer
+sub karmaSet (@) {
+	my $chatid = shift;
+	my $phrase = shift;
+	my $action = shift;
+	my $score = 0;
+	my $karmafile = sprintf "$karmadir/%s.db", sha1_base64 ($chatid);
+	# init hash, store phrase and score
+	tie my %karma, 'DB_File', $karmafile or do {
+		logger "Something nasty happen when cachedata ties to its data: $OS_ERROR";
+		return sprintf 'Карма %s составляет 0', $phrase;
+	};
+
+	my $sha1_phrase = sha1($phrase);
+
+	if (defined $karma{$sha1_phrase}) {
+		if ($action eq '++') {
+			$score = $karma{$sha1_phrase} + 1;
+			$karma{$sha1_phrase} = $score;
+		} else {
+			$score = $karma{$sha1_phrase} - 1;
+			$karma{$sha1_phrase} = $score;
+		}
+	} else {
+		if ($action eq '++') {
+			$karma{$sha1_phrase} = 1;
+		} else {
+			$karma{$sha1_phrase} = -1;
+		}
+	}
+
+	untie %karma;
+
+	if ($score < 0 && (($score % $max) - 1) == 0)) {
+		return sprintf 'Зарегистрировано пробитие дна, карма %s составляет %d', $phrase, $score;
+	} else {
+		return sprintf 'Карма %s составляет %d', $phrase, $score;
+	}
+}
+
+# just return answer
+sub karmaGet (@) {
+	my $chatid = shift;
+	my $phrase = shift;
+
+	my $karmafile = sprintf "$karmadir/%s.db", sha1_base64 ($chatid);
+	# init hash, store phrase and score
+	tie my %karma, 'DB_File', $karmafile or do {
+		logger "Something nasty happen when karma ties to its data: $OS_ERROR";
+		return sprintf 'Карма %s составляет 0', $phrase;
+	};
+
+	my $sha1_phrase = sha1 ($phrase);
+	my $score = $karma{$sha1_phrase};
+	untie %karma;
+
+	unless (defined $score) {
+		$score = 0;
+	}
+
+	return sprintf 'Карма %s составляет %d', $phrase, $score;
+}
+
+1;
+
+# vim: ft=perl noet ai ts=4 sw=4 sts=4:

lib/telegrambot.pm

@@ -330,10 +330,12 @@ sub __on_msg {
 				my $send_args;
 				$send_args->{text} = << 'MYHELP';
 ```
-!help | !помощь     - список команд
-!w город | !п город - погода в указанном городе
-!ping | !пинг       - попинговать бота
-!lat | !лат         - сгенерировать фразу из крылатых латинских выражений
+!help | !помощь       - список команд
+!w город | !п город   - погода в указанном городе
+!ping | !пинг         - попинговать бота
+!lat | !лат           - сгенерировать фразу из крылатых латинских выражений
+!karma | !карма фраза - посмотреть карму фразы
+фраза-- | фраза++     - убавить или добавить карму фразе
 ```
 Но на самом деле я бот больше для общения, чем для исполнения команд.
 Поговоришь со мной?
@@ -355,6 +357,12 @@ 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 'карма ')) {
+				my $mytext = substr ($text, 7);
+				$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
@@ -376,6 +384,15 @@ 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 '--')) {
+				my @arr = split(/\n/, $text);
+
+				if ($#arr < 1) {
+					$reply = kermaSet ($chatid, $phrase, substr ($text, -2));
+				} else {
+					# just message in chat
+					$hailo->{$msg->chat->id}->learn ($text);
+				}
 			# just message in chat
 			} else {
 				$hailo->{$msg->chat->id}->learn ($text);