Introduce cachedir config pragma, move karma to CHI

* Move karma from homebrew storage to CHI
* Use cachedir for CHI file storage heap
* Use cachedir in drink.pm
* Use cachedir in weather.pm

data/sample_config.json

@@ -4,6 +4,9 @@
         "dir" : "data/admin"
     },
 
+# cachedir used not only for caches but for somesettings and stats too
+    "cachedir" : "data/cache",
+
     "fortune" : {
         "dir" : "data/fortune",
         "srcdir" : "data/fortune_src"
@@ -31,10 +34,6 @@
         }
     },
 
-    "karma": {
-        "dir": "data/karma"
-    },
-
     "lat" : {
         "brain": "data/lat/brain.sqlite",
         "src": "data/lat.txt"
@@ -46,8 +45,6 @@
 # openwatermap plugin
     "openweathermap" : {
         "appid" : "md5sum-like_string",
-# result cache, stores data for 4 hours
-        "cachedir" : "data/cache",
     },
 
 # stuff for telegram itself

lib/drink.pm

@@ -15,12 +15,15 @@ use HTML::TokeParser;
 use Mojo::Log;
 use Mojo::UserAgent::Cached;
 use POSIX qw (strftime);
+use conf qw (loadConf);
 
 use version; our $VERSION = qw (1.0);
 use Exporter qw (import);
 our @EXPORT_OK = qw (drink);
 
 my @MONTH = qw (yanvar fevral mart aprel may iyun iyul avgust sentyabr oktyabr noyabr dekabr);
+my $c = loadConf ();
+my $cachedir = $c->{cachedir};
 
 sub drink {
 	my $r;
@@ -59,7 +62,7 @@ sub drink {
 		$ua->cache_agent(
 				CHI->new (
 				driver             => 'BerkeleyDB',
-				root_dir           => 'data/cache',
+				root_dir           => $cachedir,
 				namespace          => __PACKAGE__,
 				expires_at         => $expirationDate,
 				expires_on_backend => 1,

lib/karma.pm

@@ -7,9 +7,8 @@ use utf8;
 use open qw (:std :utf8);
 use English qw ( -no_match_vars );
 use Carp qw (cluck);
-use Digest::SHA qw (sha1_base64);
+use CHI;
-use DB_File;
+use CHI::Driver::BerkeleyDB;
-use File::Path qw (make_path);
 use conf qw (loadConf);
 
 use version; our $VERSION = qw (1.0);
@@ -17,7 +16,7 @@ use Exporter qw (import);
 our @EXPORT_OK = qw (karmaSet karmaGet);
 
 my $c = loadConf ();
-my $karmadir = $c->{karma}->{dir};
+my $cachedir = $c->{cachedir};
 my $max = 5;
 
 # swallow phrase and return answer
@@ -25,62 +24,45 @@ sub karmaSet (@) {
 	my $chatid = shift;
 	my $phrase = shift;
 	my $action = shift;
-	my $score = 0;
-	# 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 = '';
+		$phrase = ' ';
 	}
 
-	unless (-d $karmadir) {
+	my $cache = CHI->new (
-		make_path ($karmadir) or do {
+		driver => 'BerkeleyDB',
-			cluck "Unable to create $karmadir: $OS_ERROR";
+		root_dir => $cachedir,
-			return sprintf 'Карма %s составляет 0', $phrase;
+		namespace => __PACKAGE__ . '_' . $chatid
-		};
+	);
-	}
 
-	# init hash, store phrase and score
+	my $score = $cache->get ($phrase);
-	tie my %karma, 'DB_File', $karmafile || do {
-		cluck "[ERROR] Something nasty happen when cachedata ties to its data: $OS_ERROR";
-		return sprintf 'Карма %s составляет 0', $phrase;
-	};
 
-	# bdb does not understand utf8, so tied hash too, we do not want store original phrase anyway
+	if (defined $score) {
-	my $sha1_phrase = sha1_base64 (join ('', unpack ('C*', $phrase)));
-
-	if (defined $karma{$sha1_phrase}) {
 		if ($action eq '++') {
-			$score = $karma{$sha1_phrase} + 1;
+			$score++;
-			$karma{$sha1_phrase} = $score;
 		} else {
-			$score = $karma{$sha1_phrase} - 1;
+			$score--;
-			$karma{$sha1_phrase} = $score;
 		}
 	} else {
 		if ($action eq '++') {
-			$karma{$sha1_phrase} = 1;
 			$score = 1;
 		} else {
-			$karma{$sha1_phrase} = -1;
 			$score = -1;
 		}
 	}
 
-	untie %karma;
+	if ($cache->set ($phrase, $score, 'never') != $score) {
+		cluck 'Cache error: unable to set karma.';
+	}
 
 	if ($score < -1 && (($score % (0 - $max)) + 1) == 0) {
-		if ($phrase eq '') {
+		if ($phrase eq ' ') {
 			return sprintf 'Зарегистрировано пробитие дна, карма пустоты составляет %d', $score;
 		} else {
 			return sprintf 'Зарегистрировано пробитие дна, карма %s составляет %d', $phrase, $score;
 		}
 	} else {
-		if ($phrase eq '') {
+		if ($phrase eq ' ') {
 			return sprintf 'Карма пустоты составляет %d', $score;
 		} else {
 			return sprintf 'Карма %s составляет %d', $phrase, $score;
@@ -92,40 +74,24 @@ 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 = '';
+		$phrase = ' ';
 	}
 
-	unless (-d $karmadir) {
+	my $cache = CHI->new (
-		make_path ($karmadir) or do {
+		driver => 'BerkeleyDB',
-			cluck "Unable to create $karmadir: $OS_ERROR";
+		root_dir => $cachedir,
-			return sprintf 'Карма %s составляет 0', $phrase;
+		namespace => __PACKAGE__ . '_' . $chatid
-		};
+	);
-	}
 
-	# init hash, store phrase and score
+	my $score = $cache->get ($phrase);
-	tie my %karma, 'DB_File', $karmafile || do {
-		cluck "[ERROR] Something nasty happen when karma ties to its data: $OS_ERROR";
-		return sprintf 'Карма %s составляет 0', $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;
 
 	unless (defined $score) {
 		$score = 0;
 	}
 
-	if ($phrase eq '') {
+	if ($phrase eq ' ') {
 		return sprintf 'Карма пустоты составляет %d', $score;
 	} else {
 		return sprintf 'Карма %s составляет %d', $phrase, $score;

lib/weather.pm

@@ -22,6 +22,7 @@ use Exporter qw (import);
 our @EXPORT_OK = qw (weather);
 
 my $c = loadConf ();
+my $cachedir = $c->{cachedir};
 
 sub weather {
 	my $city = shift;
@@ -74,7 +75,6 @@ sub __weather {
 	my $city = shift;
 	$city = urlencode $city;
 	my $appid = $c->{openweathermap}->{appid};
-	my $cachedir = $c->{openweathermap}->{cachedir};
 	my $now = time ();
 	my $fc;
 	my $w;