Add utility script

bin/aleesa-telegram

@@ -46,7 +46,12 @@ my $runAsUid = $UID;
 
 my $piddir = '/var/run/' . basename (abs_path ($PROGRAM_NAME));
 my $C = LoadConf ();
-my $loglevel = $C->{'loglevel'} // 'notice';
+my $loglevel = 'notice';
+
+if (defined $C->{'loglevel'}) {
+	$loglevel = $C->{'loglevel'};
+}
+
 my $logfile;
 
 if (defined $C->{'log'}) {

cpanfile

@@ -36,7 +36,8 @@ requires 'Mojo::Redis',             '==3.27';
 requires 'Mojo::Redis::Connection', '0';
 # part of Mojolicious
 requires 'Mojo::UserAgent',         '0';
-requires 'open',                    '==1.12';
+# part of perl distribution
+requires 'open',                    '0';
 # part of perl distribution
 requires 'POSIX',                   '0';
 requires 'Text::Fuzzy',             '==0.29';

lib/BotLib/Conf.pm

@@ -14,7 +14,7 @@ use Exporter qw (import);
 our @EXPORT_OK = qw (LoadConf);
 
 sub LoadConf {
-	my $c = 'data/config.json';
+	my $c = shift // 'data/config.json';
 	my $CH;
 
 	unless (open $CH, '<', $c) {

lib/TelegramBot.pm

@@ -85,6 +85,9 @@ sub __cron {
 			$pubsub->json ($c->{'redis_router_channel'})->notify (
 				$c->{'redis_router_channel'} => $rmsg,
 			);
+
+			# Ratelimit this, just in case
+			sleep (1);
 		}
 	}
 

util/get_chat_users_by_id.pl

@@ -0,0 +1,101 @@
+#!/usr/bin/perl
+# По соглашению, рабочим каталогом является каталог с приложением, то есть запускать этот скрипт надо как
+# util/get_chat_users_by_id.pl
+
+# Для запуска этого скрипта нам понадобится список id пользователей и id чата, для которого мы дампим информацию о
+# пользователях. Входные данные мы складываем в файл get_chat_users_by_id.json.
+
+# На выходе в каталоге c->{cachedir} мы получим каталог get_chat_users_by_id/chat_id с кучей json-чиков, по одному на
+# каждого пользователя.
+
+use 5.018; ## no critic (ProhibitImplicitImport)
+use strict;
+use warnings;
+use utf8;
+use open qw (:std :utf8);
+use English qw ( -no_match_vars );
+
+use version; our $VERSION = qw (1.0);
+
+my $workdir;
+
+# before we run, change working dir
+BEGIN {
+	use Cwd qw (chdir abs_path);
+	my @CWD = split /\//xms, abs_path ($PROGRAM_NAME);
+
+	if ($#CWD > 1) {
+		$#CWD = $#CWD - 2;
+	}
+
+	$workdir = join '/', @CWD;
+	chdir $workdir;
+}
+
+use lib ("$workdir/lib", "$workdir/vendor_perl", "$workdir/vendor_perl/lib/perl5");
+no Cwd;
+use Cwd::utf8 qw (chdir abs_path);
+use Data::Dumper qw (Dumper);
+use File::Path qw(make_path);
+use JSON::XS qw (decode_json);
+# Грех не воспользоваться, если у нас оно есть под рукой, хотя по мне тут достаточно Http::Tiny
+use Mojo::UserAgent ();
+
+use BotLib::Conf qw (LoadConf);
+
+# Поехали!
+my $c = LoadConf ();
+
+# Пример содержимого файлика: {"chatid": -номер, "users": ["id1", "id2"]}
+my $data = LoadConf ("$workdir/get_chat_users_by_id.json");
+
+unless (defined $c->{cachedir}) {
+	die "Please define cachedir in data/config.jason\n";
+}
+
+unless (defined $data->{chatid}) {
+	die "Please define chatid in get_chat_users_by_id.json\n";
+}
+
+my $targetDir = sprintf ("%s/get_chat_users_by_id/%s", $c->{cachedir}, $data->{chatid});
+
+make_path ($targetDir) or die "Unable to create $targetDir: $OS_ERROR\n";
+
+my $url = sprintf (
+	"https://api.telegram.org/bot%s/getChatMember",
+	$c->{telegrambot}->{token},
+);
+
+while (my $userid = pop @{$data->{users}}) {
+	my $ua  = Mojo::UserAgent->new->connect_timeout (3);
+	my $r = $ua->post ($url => form => {chat_id => $data->{chatid}, user_id => $userid} )->result;
+
+	# Do not flood api with requests!
+	sleep 1;
+
+	unless ($r->is_success) {
+		warn sprintf ("Unable to get info about user: http status %s\n%s\n", $r->{code}, $r->body);
+		next;
+	}
+
+	my $j = eval { decode_json ($r->body) };
+
+	if (defined $j) {
+		my $jobj = JSON::XS->new ();
+		$jobj = $jobj->pretty (1);
+		$jobj = $jobj->canonical (1);
+		my $json = $jobj->encode ($j);
+
+		my $file = sprintf "%s/%s.json", $targetDir, $userid;
+
+		open (my $FH, '>', $file) or do {
+			warn "Unable to write to $file: $OS_ERROR\n";
+			next;
+		};
+
+		print $FH $json . "\n";
+		close $FH;
+	} else {
+		warn sprintf ("Telegram bot api returns corrupted json: %s,\n%s\n", $r->body, $@);
+	}
+}