Initial version

lib/BotLib/Command.pm

@@ -0,0 +1,258 @@
+package BotLib::Command;
+# Парсит команды
+
+use 5.030; ## no critic (ProhibitImplicitImport)
+use strict;
+use warnings;
+use utf8;
+use open         qw (:std :utf8);
+use English      qw ( -no_match_vars );
+
+use JSON::XS     qw (encode_json);
+use Log::Any     qw ($log);
+
+use BotLib::Conf qw (LoadConf);
+use BotLib::Util qw (storedata rakedata deletedata timems utf2md5hex utf2sha1hex utf2sha224hex utf2sha256hex
+	                 utf2sha384hex utf2sha512hex utf2crc32hex utf2murmurhash utf2b64 urlencode irandom);
+
+use version; our $VERSION = qw (1.0);
+use Exporter qw (import);
+our @EXPORT_OK = qw (Help Notify DelayedNotify PrintMsg Todo B64Str Md5Str Sha1Str Sha224Str Sha256Str Sha384Str
+                     Sha512Str Crc32Str MurmurhashStr UrlencodeStr IrandNum);
+
+local $OUTPUT_AUTOFLUSH = 1;
+
+my $c = LoadConf();
+
+# Возвращает список возможных команд
+# $text Help()
+sub Help {
+	my $text = '';
+	my $csign = $c->{csign};
+	$text .= "${csign}help                       - это сообщение\n";
+	$text .= "${csign}ping                       - попинговать бота\n";
+	$text .= "${csign}ver                        - написать что-то про версию ПО\n";
+	$text .= "${csign}cal                        - календарик\n";
+	$text .= "${csign}exit                       - завершить работу бота\n";
+	$text .= "${csign}quit                       - завершить работу бота\n";
+	$text .= "${csign}notify me after N [s|m|h]  - одноразовая напоминалка через desktop notification\n";
+	$text .= "${csign}n N[s|m|h] message         - одноразовая напоминалка через desktop notification\n";
+	$text .= "${csign}todo                       - выводит списк запланированных дел\n";
+	$text .= "${csign}todo -d N                  - удаляет из списка запланированных дел дело N\n";
+	$text .= "${csign}todo ДЕЛО                  - добавляет в списк запланированных дел ДЕЛО\n";
+	$text .= "${csign}sha1 STR                   - выводит sha1sum для STR\n";
+	$text .= "${csign}sha224 STR                 - выводит sha224sum для STR\n";
+	$text .= "${csign}sha256 STR                 - выводит sha256sum для STR\n";
+	$text .= "${csign}sha384 STR                 - выводит sha384sum для STR\n";
+	$text .= "${csign}sha512 STR                 - выводит sha512sum для STR\n";
+	$text .= "${csign}crc32 STR                  - выводит crc32 для STR\n";
+	$text .= "${csign}md5 STR                    - выводит md5sum для STR\n";
+	$text .= "${csign}murmurhash STR             - выводит murmur hash для STR\n";
+	$text .= "${csign}b64 STR                    - выводит base64 для STR\n";
+	$text .= "${csign}urlencode STR              - кодирует STR по urlencode\n";
+	$text .= "${csign}rand N                     - выдаёт рандомное целое число от 0 до указанного\n";
+	$text .= "${csign}unixtime                   - выдаёт текущее время в формате unix timestamp (секунды с 1 янв 1970)\n";
+
+	return $text;
+}
+
+# Одноразовая напоминалка. Сохраняет сообщение в базу notifications и отправляет его в delayed notifications.
+# Возвращает либо строку-подтверждение, либо подсказку как пользоваться командой.
+# $string Notify($chatid, $amount, $units, $message)
+sub Notify {
+	my $chatid  = shift;
+	my $amount  = shift;
+	my $units   = shift;
+	my $message = shift;
+
+	if (defined $units) {
+		if ($units eq 'm' || $units eq 'minute' || $units eq 'minutes') {
+			$amount = eval { $amount * 60 };
+
+			unless (defined $units) {
+				return sprintf ('Usage: %s NUM [s|seconds|m|minutes|h|hours]', $units);
+			}
+		} elsif ($units eq 'h' || $units eq 'hour' || $units eq 'hours') {
+			$amount = eval { $amount * 60 * 60 };
+
+			unless (defined $units) {
+				return sprintf ('Usage: %s NUM [s|seconds|m|minutes|h|hours]', $units);
+			}
+		} elsif ($units eq 's' || $units eq 'second' || $units eq 'seconds') {
+			$amount = eval { $amount + 0 };
+
+			unless (defined $units) {
+				return sprintf ('Usage: %s NUM [s|seconds|m|minutes|h|hours]', $units);
+			}
+		}
+	} else {
+		$amount = eval { $amount + 0 };
+
+		unless (defined $units) {
+			return sprintf ('Usage: %s NUM [s|seconds|m|minutes|h|hours]', $units);
+		}
+	}
+
+	my $timestamp = time () + $amount;
+	my $msg->{title} = 'Meow-bot notification';
+	my $json;
+
+	if (defined $message && $message ne '') {
+		$msg->{text} = $message;
+	} else {
+		$msg->{text} = 'Напоминалка!';
+	}
+
+	$json = encode_json $msg;
+	storedata ('notifications', $timestamp, $json, $c->{notifications}->{retention_days});
+	DelayedNotify ($c->{channels}->{notify}, $msg->{text});
+
+	return sprintf 'Notification will be sent after %d seconds', $amount;
+}
+
+# Пишет сообщение в чятик и складывает в БД, чтобы позже показать юзеру, когда он появится в чятике
+# undef PrinfMsgForUser($userid, $chatid, $message)
+sub DelayedNotify {
+	my $channel = shift;
+	my $message = shift;
+
+	my $timestamp = timems ();
+	my $data;
+	$data->{message}         = $message;
+	$data->{channel}         = $channel;
+	$data->{timestamp}       = $timestamp;
+	$data->{expiration_time} = $c->{delayed_notifications}->{retention_days} * 24 * 60 * 60 * 1000 + $timestamp;
+	$data->{retention_days}  = $c->{delayed_notifications}->{retention_days} ;
+
+	# Достанем список тех, кто есть в канальчике notify, им на джоине показывать сообщение не надо
+	my @users = keys %{$MAIN::IRC->channel_list->{$c->{channels}->{notify}}}; ## no critic (Modules::RequireExplicitInclusion)
+	$data->{users_shown} = \@users;
+
+	# TODO: Pretty jsonl
+	my $json = encode_json $data;
+	storedata ('delayed_notifications', timems (), $json, $c->{delayed_notifications}->{retention_days});
+
+	return;
+}
+
+# Пишет сообщение в чятик или юзеру
+# undef PrintMsg($chatid, $text)
+sub PrintMsg {
+	my $channel = shift;
+	my $message = shift;
+
+	$MAIN::IRC->send_long_message ('utf8', 0, 'PRIVMSG', $channel, $message); ## no critic (Modules::RequireExplicitInclusion)
+	$log->debug ("[DEBUG] message '$message' sent to $channel");
+
+	return;
+}
+
+# Выгребает список todo-шек из базы
+# $msg = _todoPrint()
+sub _todoPrint {
+	$log->debug ('[DEBUG] raking data from todo db');
+	my $todo = rakedata ('todo');
+	my $msg = '';
+
+	foreach (sort keys (%{$todo})) {
+		$msg .= sprintf "%d. %s\n", $_, $todo->{$_};
+	}
+
+	return $msg;
+}
+
+# Парсит запрос команды .todo
+# $reply Todo($message)
+sub Todo {
+	my $message = shift;
+
+	$log->debug ("$message");
+	my $reply;
+
+	if (($message eq 'todo') || ($message =~ /^todo\s+$/)) {
+		$log->debug ('[DEBUG] got todo command without arguments');
+		$reply = _todoPrint ();
+	} elsif ($message =~ /^todo\s+\-d\s+(\d+)\s*$/) {
+		$log->debug ('[DEBUG] got todo command with -d argument');
+		deletedata('todo', $1);
+		$reply = _todoPrint ();
+	} else {
+		if ($message =~ /^todo\s+(.*)/) {
+			my $data = $1;
+			$log->debug("[DEBUG] got todo command message: $message");
+			my $todo = rakedata ('todo');
+			my $num = int (keys %{$todo}) + 1;
+			storedata ('todo', $num, $data, 'never');
+			$reply = _todoPrint ();
+		} else {
+			$log->debug ('[DEBUG] got todo command with garbage');
+		}
+	}
+
+	return $reply;
+}
+
+sub B64Str {
+	my $str = shift;
+	return utf2b64 ($str);
+}
+
+sub Md5Str {
+	my $str = shift;
+	return utf2md5hex ($str);
+}
+
+sub Sha1Str {
+	my $str = shift;
+	return utf2sha1hex($str);
+}
+
+sub Sha224Str {
+	my $str = shift;
+	return utf2sha224hex($str);
+}
+
+sub Sha256Str {
+	my $str = shift;
+	return utf2sha256hex($str);
+}
+
+sub Sha384Str {
+	my $str = shift;
+	return utf2sha384hex($str);
+}
+
+sub Sha512Str {
+	my $str = shift;
+	return utf2sha512hex($str);
+}
+
+sub Crc32Str {
+	my $str = shift;
+	return utf2crc32hex($str);
+}
+
+sub MurmurhashStr {
+	my $str = shift;
+	return utf2murmurhash($str);
+}
+
+sub UrlencodeStr {
+	my $str = shift;
+	return urlencode ($str);
+}
+
+sub IrandNum {
+	my $num = shift;
+	$num = eval {$num + 0};
+
+	if (defined $num) {
+		return irandom($num);
+	} else {
+		return;
+	}
+}
+
+1;
+
+# vim: set ft=perl noet ai ts=4 sw=4 sts=4:

lib/BotLib/Conf.pm

@@ -0,0 +1,52 @@
+package BotLib::Conf;
+# loads config
+
+use 5.030; ## no critic (ProhibitImplicitImport)
+use strict;
+use warnings;
+use utf8;
+use open     qw (:std :utf8);
+use English  qw ( -no_match_vars );
+
+use Encode   qw (encode_utf8);
+use JSON::XS    ();
+use Log::Any qw ($log);
+
+use version; our $VERSION = qw (1.0);
+use Exporter qw (import);
+our @EXPORT_OK = qw (LoadConf);
+
+local $OUTPUT_AUTOFLUSH = 1;
+
+# Загружает конфиг в hashref
+# $hashref LoadConf()
+sub LoadConf {
+	my $c = 'data/config.json';
+	open my $CH, '<', $c or die "[FATA] No conf at $c: $OS_ERROR\n";
+	binmode $CH;
+	my $len = (stat $c) [7];
+	my $json;
+	my $readlen = read $CH, $json, $len;
+
+	unless ($readlen) {
+		close $CH;
+		$log->fatal ("[FATA] Unable to read $c: $OS_ERROR");
+	}
+
+	if ($readlen != $len) {
+		close $CH;
+		$log->fatal ("[FATA] File $c is $len bytes on disk, but we read only $readlen bytes");
+	}
+
+	$json = encode_utf8 ($json);
+
+	close $CH;
+	my $j = JSON::XS->new->utf8->relaxed;
+
+	# TODO: full validation of config
+	return $j->decode ($json);
+}
+
+1;
+
+# vim: set ft=perl noet ai ts=4 sw=4 sts=4:

lib/BotLib/Periodic.pm

@@ -0,0 +1,165 @@
+package BotLib::Periodic;
+
+use 5.030; ## no critic (ProhibitImplicitImport)
+use strict;
+use warnings;
+
+use utf8;
+use open                  qw (:std :utf8);
+use English               qw ( -no_match_vars );
+
+use JSON::XS              qw (decode_json);
+use Log::Any              qw ($log);
+
+use BotLib::Command       qw (PrintMsg);
+use BotLib::Conf          qw (LoadConf);
+use BotLib::Util          qw (runcmd cleanexpireddata rakedata deletedata);
+
+use version; our $VERSION = qw (1.0);
+use Exporter qw (import);
+our @EXPORT_OK = qw (PollNotifications CleanExpiredEntries);
+
+local $OUTPUT_AUTOFLUSH = 1;
+
+my $c = LoadConf ();
+
+# Регулярно выгребаем нотификашки из базы, запускаем нотификашки и пишем уведомления в канальчик с оповещениями
+# undef PollNotifications()
+sub PollNotifications {
+	# Достаём все нотифаи в формате ссылки на хэш
+	my $notification  = rakedata ('notifications');
+	$log->debug ('[DEBUG] Raked notifications from ' . $c->{db}->{notifications} . ' db');
+
+	my $deadline      = time ();
+	my @notifications = sort (keys %{$notification});
+
+	foreach my $timestamp (@notifications) {
+		if ($timestamp <= $deadline) {
+			$log->debug ("[Debug] Notification timestamp $timestamp <= $deadline, parsing");
+
+			my $alarm = eval { decode_json ($notification->{$timestamp}); };
+			deletedata ('notifications', $timestamp);
+
+			next unless ($c->{notifications}->{enabled});
+
+			# TODO: Показывать нотификации не только для mac os
+			if (defined $alarm) {
+				my $res;
+				my @cmd;
+
+				if (defined ($c->{notifications}->{sound}) && -e $c->{notifications}->{sound}) {
+					if ($OSNAME eq 'darwin') {
+						# Mac OS
+						$log->debug ("[DEBUG] use macos-specific methods of playing sounds");
+						@cmd = ('afplay', $c->{notifications}->{sound}, '--volume', '6');
+					} elsif ($OSNAME eq 'MSWin32') {
+						# Windows
+						# Хрен знает как проиграть штатными средствами, без всплывающих окон звук в windows
+						# TODO: Научиться проигрывать звук в windows :)
+						$log->debug ("[DEBUG] windows detected, i don't know how to play sounds there")
+					} elsif ($OSNAME eq 'linux' || $OSNAME eq 'freebsd') {
+						# Linux/FreeBSD
+						$log->debug ("[DEBUG] use linux/freebsd-specific methods of playing sounds");
+
+						if (-x '/usr/bin/mpg123' || -x '/bin/mpg123' || -x '/usr/local/bin/mpg123') {
+							@cmd = ('mpg123', '-q', $c->{notifications}->{sound});
+						} elsif (-x '/usr/bin/mpg321' || -x '/bin/mpg321' || -x '/usr/local/bin/mpg321') {
+							@cmd = ('mpg321', '-q', $c->{notifications}->{sound});
+						} elsif (-x '/usr/bin/madplay' || -x '/bin/madplay' || -x '/usr/local/bin/madplay') {
+							@cmd = ('madplay', '-q', '--no-tty-control', $c->{notifications}->{sound});
+						} elsif (-x '/usr/bin/mp3blaster' || -x '/bin/mp3blaster' || -x '/usr/local/bin/mp3blaster') {
+							@cmd = ('mp3blaster', $c->{notifications}->{sound});
+						}
+					} else {
+						$log->debug ("[DEBUG] don't know how to play sounds on $OSNAME");
+					}
+
+					if ($#cmd > 0) {
+						$res = runcmd (@cmd);
+					}
+
+					$#cmd = -1;
+				}
+
+				# Хрен знает, как показывать нотификашки стандартными средствами windows
+				# TODO: Научиться показывать нотификашки в windows :)
+				if ($OSNAME ne 'MSWin32') {
+					if (defined $alarm->{text} && $alarm->{text} ne '') {
+						if (defined $alarm->{title} && $alarm->{title} ne '') {
+							if ($OSNAME eq 'darwin') {
+								$log->debug ("[DEBUG] use macos-specific method of desktop notifications");
+								my $applescript = sprintf (
+									'display notification "%s" with title "%s"',
+									$alarm->{text}, $alarm->{title},
+								);
+
+								@cmd = ('osascript', '-e', "'$applescript'");
+							} else {
+								$log->debug ("[DEBUG] use linux/freebsd-specific method of desktop notifications");
+								@cmd = ('notify-send', '--expire-time=5000', $alarm->{title}, $alarm->{text});
+							}
+						} else {
+							if ($OSNAME eq 'darwin') {
+								$log->debug ("[DEBUG] use macos-specific method of desktop notifications");
+								my $applescript = sprintf (
+									'display notification "%s" with title "%s"',
+									$alarm->{text}, $alarm->{text},
+								);
+
+								@cmd = ('osascript', '-e', "'$applescript'");
+							} else {
+								$log->debug ("[DEBUG] use linux/freebsd-specific method of desktop notifications");
+								@cmd = ('notify-send', '--expire-time=5000', 'Напоминание от meow-бота', $alarm->{text});
+							}
+						}
+
+						PrintMsg($c->{channels}->{notify}, $alarm->{text});
+					} else {
+						if ($OSNAME eq 'darwin') {
+							$log->debug ("[DEBUG] use macos-specific method of desktop notifications");
+							my $applescript = 'display notification "Настало время придти времени." with title "Напоминание от meow-бота"';
+							@cmd = ('osascript', '-e', "'$applescript'");
+						} else {
+							$log->debug ("[DEBUG] use linux/freebsd-specific method of desktop notifications");
+							@cmd = ('notify-send', '--expire-time=5000', 'Напоминание от meow-бота', 'Настало время придти времени.');
+						}
+
+						PrintMsg ($c->{channels}->{notify}, 'Настало время придти времени.');
+					}
+
+					$res = runcmd (@cmd);
+				} else {
+					$log->debug ('[DEBUG] skip desktopn notification on windows');
+				}
+			} else {
+				$log->error (sprintf (
+					'[ERROR] Bad notification data in db %s: %s',
+					$c->{db}->{notifications}, $EVAL_ERROR,
+				));
+			}
+		} else {
+			$log->debug ("[Debug] Notification timestamp $timestamp > $deadline, skipping");
+		}
+
+		# Не выплёвываем все нотификации сразу, если их более одной штуки
+		if ($#notifications > -1) {
+			sleep 1;
+		}
+	}
+
+	return;
+}
+
+# Вычищает протухшие записи из всех баз
+# undef CleanExpiredEntries()
+sub CleanExpiredEntries {
+	foreach my $db (keys %{$c->{db}}) {
+		cleanexpireddata ($db);
+	}
+
+	return;
+}
+
+1;
+
+# vim: set ft=perl noet ai ts=4 sw=4 sts=4:

lib/BotLib/Util.pm

@@ -0,0 +1,410 @@
+package BotLib::Util;
+
+use 5.030; ## no critic (ProhibitImplicitImport)
+use strict;
+use warnings;
+use utf8;
+use open                 qw (:std :utf8);
+use English              qw ( -no_match_vars );
+
+use Carp                 qw (cluck);
+use CHI                     ();
+use Digest::CRC          qw (crc32_hex);
+use Digest::SHA          qw (sha1_base64 sha1_hex sha224_hex sha256_hex sha384_hex sha512_hex);
+use Digest::MD5          qw (md5_base64 md5_hex);
+use Digest::MurmurHash   qw (murmur_hash);
+use Encode               qw (encode_utf8);
+use Log::Any             qw ($log);
+use Math::Random::Secure qw (irand);
+use MIME::Base64         qw (encode_base64);
+use Time::HiRes          qw (gettimeofday);
+use URI::URL             qw (url);
+
+use BotLib::Conf         qw (LoadConf);
+
+use version; our $VERSION = qw (1.0);
+use Exporter qw (import);
+our @EXPORT_OK = qw (timems trim urlencode utf2b64 utf2sha1 utf2md5 utf2sha1hex utf2sha224hex utf2sha256hex
+	                 utf2sha384hex utf2sha512hex utf2md5hex utf2crc32hex utf2murmurhash irandom runcmd storedata
+	                 cleanexpireddata rakedata deletedata);
+
+local $OUTPUT_AUTOFLUSH = 1;
+
+my $c = LoadConf ();
+
+# Возвращает текущее время с точностью до миллисекунды
+# $string timems()
+sub timems {
+	my @time = gettimeofday ();
+	return join '', @time;
+}
+
+# Убирает пробельные символы с обоих концов даденной строки
+# $str trim($str)
+sub trim {
+	my $str = shift;
+
+	unless (defined $str) {
+		cluck '[ERROR] Str is undefined';
+		return '';
+	}
+
+	if ($str eq '') {
+		return $str;
+	}
+
+	while (substr ($str, 0, 1) =~ /^\s$/xms) {
+		$str = substr $str, 1;
+	}
+
+	while (substr ($str, -1, 1) =~ /^\s$/xms) {
+		chop $str;
+	}
+
+	return $str;
+}
+
+# Кодирует даденную строку согласно стандарту кодирования URL-ов
+# $str urlencode($url)
+sub urlencode {
+	my $str = shift;
+
+	unless (defined $str) {
+		cluck '[ERROR] Str is undefined';
+		return '';
+	}
+
+	my $urlobj = url $str;
+	return $urlobj->as_string;
+}
+
+# Кодирует даденную строку "по base64"
+# $str utf2b64($str)
+sub utf2b64 {
+	my $string = shift;
+
+	unless (defined $string) {
+		cluck '[ERROR] String is undefined';
+		return encode_base64 '';
+	}
+
+	if ($string eq '') {
+		return encode_base64 '';
+	}
+
+	my $bytes = encode_utf8 $string;
+	return encode_base64 $bytes;
+}
+
+# Берёт от даденной строки sha1 и кодирует "по base64"
+# Пример применения - имена файлов из каких-то unsafe(для файловой системы)-строк
+# $str utf2sha1($str)
+sub utf2sha1 {
+	my $string = shift;
+
+	unless (defined $string) {
+		cluck '[ERROR] String is undefined';
+		return sha1_base64 '';
+	}
+
+	if ($string eq '') {
+		return sha1_base64 '';
+	}
+
+	my $bytes = encode_utf8 $string;
+	return sha1_base64 $bytes;
+}
+
+# Берёт от даденной строки sha1 и кодирует "по base64"
+# Пример использования - имена файлов из unsafe(для файловой системы)-параметров
+# $str utf2md5($str)
+sub utf2md5 {
+	my $string = shift;
+
+	unless (defined $string) {
+		cluck '[ERROR] String is undefined';
+		return sha1_base64 '';
+	}
+
+	if ($string eq '') {
+		return sha1_base64 '';
+	}
+
+	my $bytes = encode_utf8 $string;
+	return md5_base64 $bytes;
+}
+
+# Берёт от даденной строки sha224, как утилита sha224sum
+# $str utf2sha224hex($str)
+sub utf2sha1hex {
+	my $string = shift;
+
+	unless (defined $string) {
+		cluck '[ERROR] String is undefined';
+		return sha1_hex '';
+	}
+
+	if ($string eq '') {
+		return sha1_hex '';
+	}
+
+	my $bytes = encode_utf8 $string;
+	return sha1_hex $bytes;
+}
+
+# Берёт от даденной строки sha224, как утилита sha224sum
+# $str utf2sha224hex($str)
+sub utf2sha224hex {
+	my $string = shift;
+
+	unless (defined $string) {
+		cluck '[ERROR] String is undefined';
+		return sha224_hex '';
+	}
+
+	if ($string eq '') {
+		return sha224_hex '';
+	}
+
+	my $bytes = encode_utf8 $string;
+	return sha224_hex $bytes;
+}
+
+# Берёт от даденной строки sha256, как утилита sha1sum
+# $str utf2sha256hex($str)
+sub utf2sha256hex {
+	my $string = shift;
+
+	unless (defined $string) {
+		cluck '[ERROR] String is undefined';
+		return sha256_hex '';
+	}
+
+	if ($string eq '') {
+		return sha256_hex '';
+	}
+
+	my $bytes = encode_utf8 $string;
+	return sha256_hex $bytes;
+}
+
+# Берёт от даденной строки sha1, как утилита sha384sum
+# $str utf2sha384hex($str)
+sub utf2sha384hex {
+	my $string = shift;
+
+	unless (defined $string) {
+		cluck '[ERROR] String is undefined';
+		return sha384_hex '';
+	}
+
+	if ($string eq '') {
+		return sha384_hex '';
+	}
+
+	my $bytes = encode_utf8 $string;
+	return sha384_hex $bytes;
+}
+
+# Берёт от даденной строки sha1, как утилита sha512sum
+# $str utf2sha512hex($str)
+sub utf2sha512hex {
+	my $string = shift;
+
+	unless (defined $string) {
+		cluck '[ERROR] String is undefined';
+		return sha512_hex '';
+	}
+
+	if ($string eq '') {
+		return sha512_hex '';
+	}
+
+	my $bytes = encode_utf8 $string;
+	return sha512_hex $bytes;
+}
+
+# Берёт от даденной строки md5, как утилита md5sum
+# $str utf2md5hex($str)
+sub utf2md5hex {
+	my $string = shift;
+
+	unless (defined $string) {
+		cluck '[ERROR] String is undefined';
+		return md5_hex '';
+	}
+
+	if ($string eq '') {
+		return md5_hex '';
+	}
+
+	my $bytes = encode_utf8 $string;
+	return md5_hex $bytes;
+}
+
+# Берёт от даденной строки crc32
+# $str utf2crc32hex($str)
+sub utf2crc32hex {
+	my $string = shift;
+
+	unless (defined $string) {
+		cluck '[ERROR] String is undefined';
+		return crc32_hex '';
+	}
+
+	if ($string eq '') {
+		return crc32_hex '';
+	}
+
+	my $bytes = encode_utf8 $string;
+	return crc32_hex $bytes;
+}
+
+# Берёт от даденной строки murmur_hash
+# $str utf2murmurhash($str)
+sub utf2murmurhash {
+	my $string = shift;
+
+	unless (defined $string) {
+		cluck '[ERROR] String is undefined';
+		return murmur_hash '';
+	}
+
+	if ($string eq '') {
+		return murmur_hash '';
+	}
+
+	my $bytes = encode_utf8 $string;
+	return murmur_hash $bytes;
+}
+
+# Возвращает рандомное целое число от 0 до даденного числа
+# $num irand($num)
+sub irandom {
+	my $num = shift;
+	return irand ($num);
+}
+
+# Execs command via backticks and handles errors in generic way
+# Returns hashref
+# $ret runcmd($cmd, @args)
+sub runcmd {
+	my @cmd = @_;
+
+	my $out = '';
+	my $ret->{error} = 0;
+	$ret->{success}  = 1;
+	my $err_msg = '';
+
+	$out = `@cmd`;
+
+	if ($CHILD_ERROR != 0) {
+		$err_msg = sprintf 'Unable to run %s', join (' ', @cmd);
+		$log->err ("[ERROR] $err_msg");
+		$ret->{error}   = 1;
+		$ret->{success} = 0;
+		$ret->{err_msg} = $err_msg;
+	} else {
+		$ret->{text} = $out;
+	}
+
+	return $ret;
+}
+
+# Сохраняет данные в указанной БД с указанным expiration time. Expiration time может быть never, unixtimestamp, relative.
+# Где unixtimestmp в секундах (с 1970 года), relative - это например 2 days.
+# undef storedata($dbname, $key, $value, $time)
+sub storedata {
+	my $dbname = shift;
+	my $key    = shift;
+	my $value  = shift;
+	my $time   = shift;
+
+	cluck "[ERROR] datadir undefined in config"    unless (defined $c->{datadir});
+	cluck "[ERROR] database not defined in config" unless (defined $c->{db}->{$dbname});
+
+	my $db_path = sprintf '%s/%s', $c->{datadir}, $c->{db}->{$dbname};
+
+	my $cache = CHI->new (
+		driver   => 'BerkeleyDB',
+		root_dir => $db_path,
+	);
+
+	$cache->set ($key, $value, $time);
+	$log->debug ("[DEBUG] key $key with value $value and exp $time stored to $dbname");
+
+	return;
+}
+
+# Удаляет протухшие ключи из указанной бд
+# undef cleanexpireddata($dbname)
+sub cleanexpireddata {
+	my $dbname = shift;
+
+	# TODO: check that db defined in config
+	my $db_path = sprintf '%s/%s', $c->{datadir}, $c->{db}->{$dbname};
+
+	my $cache = CHI->new (
+		driver   => 'BerkeleyDB',
+		root_dir => $db_path,
+	);
+
+	foreach my $entry ($cache->get_keys ()) {
+		unless ($cache->is_valid ($entry)) {
+			$cache->remove ($entry);
+			$log->debug ("[DEBUG] Expired key $entry removed from $dbname");
+		}
+	}
+
+	return;
+}
+
+# Выгребает ключ-значение из указанной БД в формате ссылочной структуры. Ключ гарантированно не протухший
+# dataref rakedata($dbname)
+sub rakedata {
+	my $dbname = shift;
+
+	# TODO: check if db exist
+	my $db_path = sprintf '%s/%s', $c->{datadir}, $c->{db}->{$dbname};
+
+	cluck unless defined $c->{db}->{$dbname};
+	cluck unless defined $c->{datadir};
+	my $cache = CHI->new (
+		driver   => 'BerkeleyDB',
+		root_dir => $db_path,
+	);
+
+	my $hashref;
+
+	foreach ($cache->get_keys()) {
+		my $cache_object = $cache->get_object ($_);
+		$hashref->{$cache_object->key ()} = $cache_object->value ();
+	}
+
+	return $hashref;
+}
+
+# Удаляет ключ и ассоциированные с ним данные из указанной бд
+# undef deletedata($dbname, $key)
+sub deletedata {
+	my $dbname = shift;
+	my $key    = shift;
+
+	cluck unless defined $c->{db}->{$dbname};
+	cluck unless defined $c->{datadir};
+	my $db_path = sprintf '%s/%s', $c->{datadir}, $c->{db}->{$dbname};
+
+	my $cache = CHI->new (
+		driver   => 'BerkeleyDB',
+		root_dir => $db_path,
+	);
+
+	$cache->remove ($key);
+	$log->debug ("[DEBUG] Key $key removed from $dbname");
+
+	return;
+}
+
+1;
+
+# vim: set ft=perl noet ai ts=4 sw=4 sts=4: