Initial version
This commit is contained in:
eleksir
410
lib/BotLib/Util.pm
Normal file
410
lib/BotLib/Util.pm
Normal file
@@ -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:
|
||||
Reference in New Issue
Block a user