1

Use CHI for caching in Weather and Drink modules

This commit is contained in:
eleksir
2021-03-28 18:39:55 +03:00
parent 91888e1c24
commit a406c7c717
5 changed files with 199 additions and 212 deletions

View File

@@ -87,9 +87,9 @@ if ($UID == 0) {
}
if (defined $logfile) {
Log::Any::Adapter->set ('File', $logfile);
Log::Any::Adapter->set ('File', $logfile, 'log_level'=>'warning'); # fatal
} else {
Log::Any::Adapter->set ('File', '/dev/null');
Log::Any::Adapter->set ('File', '/dev/null', 'log_level'=>'emergency');
}
# double fork attach to /dev/null all stdio and go background

View File

@@ -1,4 +1,7 @@
requires 'CHI';
requires 'CHI::Driver::BerkeleyDB';
requires 'Cwd::utf8';
requires 'DateTime';
requires 'DB_File';
requires 'SQLite_File';
requires 'Digest::MD5';

View File

@@ -1,4 +1,6 @@
{
# all cached will go there, they named after module name
"cachedir" : "data/cache",
"user" : "nobody",
"jabberbot": {
# maybe onece it will be multi-instance of bot
@@ -24,8 +26,6 @@
}
},
"openweathermap" : {
"cachetime": "data/cache/openweathermap.Id-Timestamp.db",
"cachedata": "data/cache/openweathermap.Id-Data.db",
"appid": "get_it_on_openweathermap.org"
},
"log" : "/var/log/aleesa-jabber-bot/aleesa-jabber-bot.log",

View File

@@ -8,67 +8,27 @@ use open qw (:std :utf8);
use English qw ( -no_match_vars );
use Encode;
use Carp qw (cluck);
use CHI;
use CHI::Driver::BerkeleyDB;
use DateTime;
use HTTP::Tiny;
use HTML::TokeParser;
use POSIX qw (strftime);
use BotLib::Conf qw (LoadConf);
use version; our $VERSION = qw (1.0);
use Exporter qw (import);
our @EXPORT_OK = qw (Drink Drink2);
our @EXPORT_OK = qw (Drink);
my @MONTH = qw (yanvar fevral mart aprel may iyun iyul avgust sentyabr oktyabr noyabr dekabr);
my $c = LoadConf ();
sub Drink {
my $r;
my $ret = 'Не знаю праздников - вджобываю весь день на шахтах, как проклятая.';
my $drinkCallBack = sub {
my $ret;
my ($dayNum, $monthNum) = (localtime ())[3, 4];
my $url = sprintf 'https://kakoysegodnyaprazdnik.ru/baza/%s/%s', $MONTH[$monthNum], $dayNum;
for (1..3) {
my $http = HTTP::Tiny->new (timeout => 3);
$r = $http->get ($url, {'Accept-Charset' => 'utf-8', 'Accept-Language' => 'ru-RU'});
if ($r->{success}) {
last;
}
sleep 2;
}
if ($r->{success}) {
my $p = HTML::TokeParser->new(\$r->{content});
my @a;
my @holyday;
do {
$#a = -1;
@a = $p->get_tag('span'); ## no critic (Variables::RequireLocalizedPunctuationVars)
if ($#{$a[0]} > 2 && defined $a[0][1]->{itemprop} && $a[0][1]->{itemprop} eq 'text') {
push @holyday,'* ' . decode ('UTF-8', $p->get_trimmed_text ('/span'));
}
} while ($#{$a[0]} > 1);
if ($#holyday > 0) {
# cut off something weird, definely not a "holyday"
$#holyday = $#holyday - 1;
}
if ($#holyday > 0) {
$ret = join "\n", @holyday;
}
} else {
cluck sprintf 'Server return status %s with message: %s', $r->{status}, $r->{reason};
}
return $ret;
}
sub drink2 {
my $r;
my $ret = 'Не знаю праздников - вджобываю весь день на шахтах, как проклятая.';
my ($dayNum, $monthNum) = (localtime ())[3, 4];
my $url = sprintf 'https://calendareveryday.ru/?id=prazdniki', $MONTH[$monthNum], $dayNum;
for (1..3) {
my $http = HTTP::Tiny->new (timeout => 3);
@@ -82,6 +42,7 @@ sub drink2 {
}
if ($r->{success}) {
# TODO: Handle unexpected content
my $p = HTML::TokeParser->new(\$r->{content});
my @a;
my @holyday;
@@ -106,9 +67,56 @@ sub drink2 {
}
} else {
cluck sprintf 'Server return status %s with message: %s', $r->{status}, $r->{reason};
return undef;
}
return $ret;
};
my $cache = CHI->new (
driver => 'BerkeleyDB',
root_dir => $c->{cachedir},
namespace => __PACKAGE__
);
# Those POSIX assholes just forgot to add unix timestamps without TZ offset, so...
my ($mday, $mon, $year) = (gmtime ())[3, 4, 5];
my $offset = strftime ('%z', gmtime ());
my $offsetMinutes = (substr $offset, -2) * 60;
my $offsetHours = (substr $offset, 1, 2) * 60 * 60;
my $offsetSign;
if ((substr $offset, 0, 1) eq '+') {
$offsetSign = 1;
}
my $expirationDate = DateTime->new (
year => $year + 1900,
month => $mon + 1,
day => $mday,
hour => 0,
minute => 0,
second => 0
)->add (days => 1)->strftime ('%s');
if ((substr $offset, 0, 1) eq '+') {
$expirationDate = $expirationDate - $offsetHours - $offsetMinutes;
} else {
$expirationDate = $expirationDate + $offsetHours + $offsetMinutes;
}
# Okay, now we have correct unix timestamp, heh
my $res = $cache->compute (
'Holiday',
{ expires_at => $expirationDate },
$drinkCallBack
);
if (defined $res && $res ne '') {
return $res;
} else {
return 'Не знаю праздников - вджобываю весь день на шахтах, как проклятая.';
}
}
1;

View File

@@ -7,9 +7,8 @@ use utf8;
use open qw (:std :utf8);
use English qw ( -no_match_vars );
use Carp qw (carp cluck);
use DB_File;
use Digest::MD5 qw (md5_base64);
use File::Path qw (make_path);
use CHI;
use CHI::Driver::BerkeleyDB;
use HTTP::Tiny;
use JSON::XS;
use BotLib::Conf qw (LoadConf);
@@ -29,83 +28,23 @@ sub Weather {
return 'Длинновато для названия города.' if (length ($city) > 80);
$city = ucfirst $city;
my $w = __weather ($city);
my $reply;
if ($w) {
if ($w->{temperature_min} == $w->{temperature_max}) {
$reply = sprintf ("Погода в городе %s, %s:\n%s, ветер %s %s м/c, температура %s°C, ощущается как %s°C, относительная влажность %s%%, давление %s мм.рт.с",
$w->{name},
$w->{country},
ucfirst ($w->{description}),
$w->{wind_direction},
$w->{wind_speed},
$w->{temperature_min},
$w->{temperature_feelslike},
$w->{humidity},
$w->{pressure}
);
} else {
$reply = sprintf ("Погода в городе %s, %s:\n%s, ветер %s %s м/c, температура %s-%s°C, ощущается как %s°C, относительная влажность %s%%, давление %s мм.рт.ст",
$w->{name},
$w->{country},
ucfirst ($w->{description}),
$w->{wind_direction},
$w->{wind_speed},
$w->{temperature_min},
$w->{temperature_max},
$w->{temperature_feelslike},
$w->{humidity},
$w->{pressure}
);
}
} else {
$reply = "Я не знаю, какая погода в $city";
}
return $reply;
}
sub __weather {
my $city = shift;
$city = urlencode $city;
my $id = md5_base64 $city;
my $weatherCallBack = sub {
my $appid = $c->{openweathermap}->{appid};
my $cachedir = $c->{openweathermap}->{cachedir};
my $cachetimefile = $cachedir . '/openweathermap.Id-Timestamp.db';
my $cachedatafile = $cachedir . '/openweathermap.Id-Data.db';
my $now = time ();
unless (defined $appid) {
carp 'No appid specified for openweathermap';
return undef;
}
my $fc;
my $w;
unless (-d $cachedir) {
make_path ($cachedir) || do {
carp "[ERROR] Unable to create $cachedir: $OS_ERROR";
return;
};
}
# attach to cache data
tie my %cachetime, 'DB_File', $cachetimefile or do {
carp "[ERROR] Something nasty happen when cachetime ties to its data: $OS_ERROR";
return undef;
};
tie my %cachedata, 'DB_File', $cachedatafile or do {
carp "[ERROR] Something nasty happen when cachedata ties to its data: $OS_ERROR";
return undef;
};
# lookup cache
if (defined ($cachetime{$id}) && (($now - $cachetime{$id}) < 10800)) {
$fc = decode_json ($cachedata{$id});
} else {
my $r;
# try 3 times and giveup
for (1..3) {
my $http = HTTP::Tiny->new (timeout => 3);
$r = $http->get (sprintf ('http://api.openweathermap.org/data/2.5/weather?q=%s&lang=ru&APPID=%s', $city, $appid));
$r = $http->get (sprintf ('http://api.openweathermap.org/data/2.5/weather?q=%s&lang=ru&APPID=%s', urlencode ($city), $appid));
if ($r->{success}) {
last;
@@ -122,23 +61,12 @@ sub __weather {
if ($EVAL_ERROR) {
carp "[WARN] openweathermap returns corrupted json: $EVAL_ERROR";
untie %cachetime;
untie %cachedata;
return undef;
};
$cachetime{$id} = $now;
$cachedata{$id} = encode_json ($fc);
} else {
carp sprintf 'Server return status %s with message: %s', $r->{status}, $r->{reason};
untie %cachetime;
untie %cachedata;
return undef;
}
}
untie %cachetime;
untie %cachedata;
# TODO: check all of this for existence
$w->{'name'} = $fc->{name};
@@ -193,6 +121,54 @@ sub __weather {
}
return $w;
};
my $cache = CHI->new (
driver => 'BerkeleyDB',
root_dir => $c->{cachedir},
namespace => __PACKAGE__
);
my $w = $cache->compute (
$city,
'3 hours',
$weatherCallBack
);
my $reply;
if ($w) {
if ($w->{temperature_min} == $w->{temperature_max}) {
$reply = sprintf ("Погода в городе %s, %s:\n%s, ветер %s %s м/c, температура %s°C, ощущается как %s°C, относительная влажность %s%%, давление %s мм.рт.с",
$w->{name},
$w->{country},
ucfirst ($w->{description}),
$w->{wind_direction},
$w->{wind_speed},
$w->{temperature_min},
$w->{temperature_feelslike},
$w->{humidity},
$w->{pressure}
);
} else {
$reply = sprintf ("Погода в городе %s, %s:\n%s, ветер %s %s м/c, температура %s-%s°C, ощущается как %s°C, относительная влажность %s%%, давление %s мм.рт.ст",
$w->{name},
$w->{country},
ucfirst ($w->{description}),
$w->{wind_direction},
$w->{wind_speed},
$w->{temperature_min},
$w->{temperature_max},
$w->{temperature_feelslike},
$w->{humidity},
$w->{pressure}
);
}
} else {
$reply = "Я не знаю, какая погода в $city";
}
return $reply;
}
1;