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
This commit is contained in:
@@ -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,
|
||||
|
||||
86
lib/karma.pm
86
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 DB_File;
|
||||
use File::Path qw (make_path);
|
||||
use CHI;
|
||||
use CHI::Driver::BerkeleyDB;
|
||||
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) {
|
||||
make_path ($karmadir) or do {
|
||||
cluck "Unable to create $karmadir: $OS_ERROR";
|
||||
return sprintf 'Карма %s составляет 0', $phrase;
|
||||
};
|
||||
}
|
||||
my $cache = CHI->new (
|
||||
driver => 'BerkeleyDB',
|
||||
root_dir => $cachedir,
|
||||
namespace => __PACKAGE__ . '_' . $chatid
|
||||
);
|
||||
|
||||
# init hash, store phrase and score
|
||||
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;
|
||||
};
|
||||
my $score = $cache->get ($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 (defined $score) {
|
||||
if ($action eq '++') {
|
||||
$score = $karma{$sha1_phrase} + 1;
|
||||
$karma{$sha1_phrase} = $score;
|
||||
$score++;
|
||||
} else {
|
||||
$score = $karma{$sha1_phrase} - 1;
|
||||
$karma{$sha1_phrase} = $score;
|
||||
$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) {
|
||||
make_path ($karmadir) or do {
|
||||
cluck "Unable to create $karmadir: $OS_ERROR";
|
||||
return sprintf 'Карма %s составляет 0', $phrase;
|
||||
};
|
||||
}
|
||||
my $cache = CHI->new (
|
||||
driver => 'BerkeleyDB',
|
||||
root_dir => $cachedir,
|
||||
namespace => __PACKAGE__ . '_' . $chatid
|
||||
);
|
||||
|
||||
# init hash, store phrase and score
|
||||
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;
|
||||
my $score = $cache->get ($phrase);
|
||||
|
||||
unless (defined $score) {
|
||||
$score = 0;
|
||||
}
|
||||
|
||||
if ($phrase eq '') {
|
||||
if ($phrase eq ' ') {
|
||||
return sprintf 'Карма пустоты составляет %d', $score;
|
||||
} else {
|
||||
return sprintf 'Карма %s составляет %d', $phrase, $score;
|
||||
|
||||
@@ -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;
|
||||
|
||||
Reference in New Issue
Block a user