Use CHI for caching in Weather and Drink modules

2021-03-28 18:39:55 +03:00
parent 91888e1c24
commit a406c7c717
5 changed files with 199 additions and 212 deletions
--- a/bin/aleesa-jabber-bot
+++ b/bin/aleesa-jabber-bot
@@ -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
--- a/3
+++ b/3
@@ -1,4 +1,7 @@
+requires 'CHI';
+requires 'CHI::Driver::BerkeleyDB';
 requires 'Cwd::utf8';
+requires 'DateTime';
 requires 'DB_File';
 requires 'SQLite_File';
 requires 'Digest::MD5';
--- a/data/sample_config.json
+++ b/data/sample_config.json
@@ -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",
--- a/lib/BotLib/Drink.pm
+++ b/lib/BotLib/Drink.pm
@@ -8,107 +8,115 @@ 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 ($dayNum, $monthNum) = (localtime ())[3, 4];
-	my $url = sprintf 'https://kakoysegodnyaprazdnik.ru/baza/%s/%s', $MONTH[$monthNum], $dayNum;
+	my $drinkCallBack = sub {
+		my $ret;
+		my ($dayNum, $monthNum) = (localtime ())[3, 4];
+		my $url = sprintf 'https://kakoysegodnyaprazdnik.ru/baza/%s/%s', $MONTH[$monthNum], $dayNum;
+		my $r;

-	for (1..3) {
-		my $http = HTTP::Tiny->new (timeout => 3);
-		$r = $http->get ($url, {'Accept-Charset' => 'utf-8', 'Accept-Language' => 'ru-RU'});
+		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'));
+			if ($r->{success}) {
+				last;
 			}

-		} while ($#{$a[0]} > 1);
-
-		if ($#holyday > 0) {
-			# cut off something weird, definely not a "holyday"
-			$#holyday = $#holyday - 1;
+			sleep 2;
 		}

-		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);
-		$r = $http->get ($url, {'Accept-Charset' => 'utf-8', 'Accept-Language' => 'ru-RU'});
-
 		if ($r->{success}) {
-			last;
-		}
+			# TODO: Handle unexpected content
+			my $p = HTML::TokeParser->new(\$r->{content});
+			my @a;
+			my @holyday;

-		sleep 2;
-	}
+			do {
+				$#a = -1;
+				@a = $p->get_tag('span'); ## no critic (Variables::RequireLocalizedPunctuationVars)

-	if ($r->{success}) {
-		my $p = HTML::TokeParser->new(\$r->{content});
-		my @a;
-		my @holyday;
+				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'));
+				}

-		do {
-			$#a = -1;
-			@a = $p->get_tag('span'); ## no critic (Variables::RequireLocalizedPunctuationVars)
+			} while ($#{$a[0]} > 1);

-			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'));
+			if ($#holyday > 0) {
+				# cut off something weird, definely not a "holyday"
+				$#holyday = $#holyday - 1;
 			}

-		} 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 undef;
 		}

-		if ($#holyday > 0) {
-			$ret = join "\n", @holyday;
-		}
-	} else {
-		cluck sprintf 'Server return status %s with message: %s', $r->{status}, $r->{reason};
+		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;
 	}

-	return $ret;
+	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;
--- a/lib/BotLib/Weather.pm
+++ b/lib/BotLib/Weather.pm
@@ -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,7 +28,113 @@ sub Weather {
 	return 'Длинновато для названия города.' if (length ($city) > 80);

 	$city = ucfirst $city;
-	my $w = __weather ($city);
+
+	my $weatherCallBack = sub {
+		my $appid = $c->{openweathermap}->{appid};
+
+		unless (defined $appid) {
+			carp 'No appid specified for openweathermap';
+			return undef;
+		}
+
+		my $fc;
+		my $w;
+		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', urlencode ($city), $appid));
+
+			if ($r->{success}) {
+				last;
+			}
+
+			sleep 2;
+		}
+
+		# all 3 times can give error, so check it here
+		if ($r->{success}) {
+			$fc = eval {
+				decode_json ($r->{content});
+			};
+
+			if ($EVAL_ERROR) {
+				carp "[WARN] openweathermap returns corrupted json: $EVAL_ERROR";
+				return undef;
+			};
+		} else {
+			carp sprintf 'Server return status %s with message: %s', $r->{status}, $r->{reason};
+			return undef;
+		}
+
+		# TODO: check all of this for existence
+		$w->{'name'} = $fc->{name};
+		$w->{'state'} = $fc->{state};
+		$w->{'country'} = $fc->{sys}->{country};
+		$w->{'longitude'} = $fc->{coord}->{lon};
+		$w->{'latitude'} = $fc->{coord}->{lat};
+		$w->{'temperature_min'} = int ($fc->{main}->{temp_min} - 273.15);
+		$w->{'temperature_max'} = int ($fc->{main}->{temp_max} - 273.15);
+		$w->{'temperature_feelslike'} = int ($fc->{main}->{feels_like} - 273.15);
+		$w->{'humidity'} = $fc->{main}->{humidity};
+		$w->{'pressure'} = int ($fc->{main}->{pressure} * 0.75006375541921);
+		$w->{'description'} = $fc->{weather}->[0]->{description};
+		$w->{'wind_speed'} = $fc->{wind}->{speed};
+		$w->{'wind_direction'} = 'разный';
+		my $dir = int ($fc->{wind}->{deg} + 0);
+
+		if ($dir == 0) {
+			$w->{'wind_direction'} = 'северный';
+		} elsif ($dir > 0   && $dir <= 30) {
+			$w->{'wind_direction'} = 'северо-северо-восточный';
+		} elsif ($dir > 30  && $dir <= 60) {
+			$w->{'wind_direction'} = 'северо-восточный';
+		} elsif ($dir > 60  && $dir <  90) {
+			$w->{'wind_direction'} = 'восточно-северо-восточный';
+		} elsif ($dir == 90) {
+			$w->{'wind_direction'} = 'восточный';
+		} elsif ($dir > 90  && $dir <= 120) {
+			$w->{'wind_direction'} = 'восточно-юго-восточный';
+		} elsif ($dir > 120 && $dir <= 150) {
+			$w->{'wind_direction'} = 'юговосточный';
+		} elsif ($dir > 150 && $dir <  180) {
+			$w->{'wind_direction'} = 'юго-юго-восточный';
+		} elsif ($dir == 180) {
+			$w->{'wind_direction'} = 'южный';
+		} elsif ($dir > 180 && $dir <= 210) {
+			$w->{'wind_direction'} = 'юго-юго-западный';
+		} elsif ($dir > 210 && $dir <= 240) {
+			$w->{'wind_direction'} = 'юго-западный';
+		} elsif ($dir > 240 && $dir <  270) {
+			$w->{'wind_direction'} = 'западно-юго-западный';
+		} elsif ($dir == 270) {
+			$w->{'wind_direction'} = 'западный';
+		} elsif ($dir > 270 && $dir <= 300) {
+			$w->{'wind_direction'} = 'западно-северо-западный';
+		} elsif ($dir > 300 && $dir <= 330) {
+			$w->{'wind_direction'} = 'северо-западный';
+		} elsif ($dir > 330 && $dir <  360) {
+			$w->{'wind_direction'} = 'северо-северо-западный';
+		} elsif ($dir == 360) {
+			$w->{'wind_direction'} = 'северный';
+		}
+
+		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) {
@@ -66,135 +171,6 @@ sub Weather {
 	return $reply;
 }

-sub __weather {
-	my $city = shift;
-	$city = urlencode $city;
-	my $id = md5_base64 $city;
-	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 ();
-	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));
-
-			if ($r->{success}) {
-				last;
-			}
-
-			sleep 2;
-		}
-
-		# all 3 times can give error, so check it here
-		if ($r->{success}) {
-			$fc = eval {
-				decode_json ($r->{content});
-			};
-
-			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};
-	$w->{'state'} = $fc->{state};
-	$w->{'country'} = $fc->{sys}->{country};
-	$w->{'longitude'} = $fc->{coord}->{lon};
-	$w->{'latitude'} = $fc->{coord}->{lat};
-	$w->{'temperature_min'} = int ($fc->{main}->{temp_min} - 273.15);
-	$w->{'temperature_max'} = int ($fc->{main}->{temp_max} - 273.15);
-	$w->{'temperature_feelslike'} = int ($fc->{main}->{feels_like} - 273.15);
-	$w->{'humidity'} = $fc->{main}->{humidity};
-	$w->{'pressure'} = int ($fc->{main}->{pressure} * 0.75006375541921);
-	$w->{'description'} = $fc->{weather}->[0]->{description};
-	$w->{'wind_speed'} = $fc->{wind}->{speed};
-	$w->{'wind_direction'} = 'разный';
-	my $dir = int ($fc->{wind}->{deg} + 0);
-
-	if ($dir == 0) {
-		$w->{'wind_direction'} = 'северный';
-	} elsif ($dir > 0   && $dir <= 30) {
-		$w->{'wind_direction'} = 'северо-северо-восточный';
-	} elsif ($dir > 30  && $dir <= 60) {
-		$w->{'wind_direction'} = 'северо-восточный';
-	} elsif ($dir > 60  && $dir <  90) {
-		$w->{'wind_direction'} = 'восточно-северо-восточный';
-	} elsif ($dir == 90) {
-		$w->{'wind_direction'} = 'восточный';
-	} elsif ($dir > 90  && $dir <= 120) {
-		$w->{'wind_direction'} = 'восточно-юго-восточный';
-	} elsif ($dir > 120 && $dir <= 150) {
-		$w->{'wind_direction'} = 'юговосточный';
-	} elsif ($dir > 150 && $dir <  180) {
-		$w->{'wind_direction'} = 'юго-юго-восточный';
-	} elsif ($dir == 180) {
-		$w->{'wind_direction'} = 'южный';
-	} elsif ($dir > 180 && $dir <= 210) {
-		$w->{'wind_direction'} = 'юго-юго-западный';
-	} elsif ($dir > 210 && $dir <= 240) {
-		$w->{'wind_direction'} = 'юго-западный';
-	} elsif ($dir > 240 && $dir <  270) {
-		$w->{'wind_direction'} = 'западно-юго-западный';
-	} elsif ($dir == 270) {
-		$w->{'wind_direction'} = 'западный';
-	} elsif ($dir > 270 && $dir <= 300) {
-		$w->{'wind_direction'} = 'западно-северо-западный';
-	} elsif ($dir > 300 && $dir <= 330) {
-		$w->{'wind_direction'} = 'северо-западный';
-	} elsif ($dir > 330 && $dir <  360) {
-		$w->{'wind_direction'} = 'северо-северо-западный';
-	} elsif ($dir == 360) {
-		$w->{'wind_direction'} = 'северный';
-	}
-
-	return $w;
-}
-
 1;

 # vim: set ft=perl noet ai ts=4 sw=4 sts=4: