Do not manipulate lib path directly.

Perl is a bit fucky about addng paths to @INC directly or via use lib; Also update .gitignore.
Add export_settings.pl to save chat settings in json
2026-01-02 16:16:22 +03:00 · 2026-01-02 15:56:08 +03:00 · 2025-05-19 22:08:26 +03:00 · 2025-05-10 00:44:31 +03:00 · 2025-05-09 16:19:49 +03:00 · 2025-05-09 11:59:18 +03:00
13 changed files with 707 additions and 52 deletions
--- a/.gitignore
+++ b/.gitignore
@@ -4,5 +4,7 @@ _Deparsed_XSubs.pm
 .vstags
 aleesa-telegram.pid
 data/cache/**
+data/admin/**
 data/config.json
+data/chatlist.txt
 vendor_perl/**
--- a/export_settings.pl
+++ b/export_settings.pl
@@ -0,0 +1,168 @@
+#!/usr/bin/perl
+
+# Плагин для сохранения настроек чатов. Экспортирует настройки в json, который можно использовать для импорта в другого
+# бота.
+#
+# Файлик data/chatlist.txt придётся добывать грепаньем дебаг-логов (через скрипт extract_chatlist.txt.pl).
+# Формат 1 chatid на строку.
+
+
+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 - 1;
+	}
+
+	$workdir = join '/', @CWD;
+	chdir $workdir;
+}
+
+use lib ("$workdir/lib", "$workdir/vendor_perl", "$workdir/vendor_perl/lib/perl5");
+no Cwd;
+
+
+use Data::Dumper qw(Dumper);
+use JSON::XS ();
+
+use BotLib::Admin qw(
+	FortuneToggleList FortuneEnabled
+	ChanMsgToggleList ChanMsgEnabled
+	GreetMsgToggleList GreetMsgEnabled
+	GoodbyeMsgToggleList GoodbyeMsgEnabled
+	MuteByAdminToggleList MuteByAdminEnabled
+	PluginEnabled);
+use BotLib::Conf qw(LoadConf);
+
+my $settings;
+
+my $chatlistfile = 'data/chatlist.txt';
+
+my $c = LoadConf('data/config.json');
+
+my $admin_dir = $c->{admin}->{dir};
+my $cachedir = $c->{cachedir};
+
+# Достаём список чатов, где настроена fortune-ка по утрам.
+my @fortune_chats = FortuneToggleList();
+
+foreach my $chatid (@fortune_chats) {
+	$settings->{$chatid}->{fortune} = FortuneEnabled($chatid);
+}
+
+# Достаём список чатов, где настроена возможность удаления сообщений, отправленных от имени другого калана.
+my @chanmsg_chats = ChanMsgToggleList();
+
+foreach my $chatid (@chanmsg_chats) {
+	$settings->{$chatid}->{chanmsg} = ChanMsgEnabled($chatid);
+}
+
+# Достаём список чатов, где настроены приветственные сообщения.
+my @greetmsg_chats = GreetMsgToggleList();
+
+foreach my $chatid (@greetmsg_chats) {
+	$settings->{$chatid}->{greetmsg} = GreetMsgEnabled($chatid);
+}
+
+# Достаём список чатов, где настроены прощальные сообщения.
+my @goodbyemsg_chats = GoodbyeMsgToggleList();
+
+foreach my $chatid (@goodbyemsg_chats) {
+	$settings->{$chatid}->{goodbyemsg} = GoodbyeMsgEnabled($chatid);
+}
+
+# Достаём список чатов, где настроена возможность мута администратором.
+my @adminmute_chats = MuteByAdminToggleList();
+
+foreach my $chatid (@adminmute_chats) {
+	$settings->{$chatid}->{adminmute} = MuteByAdminEnabled($chatid);
+}
+
+open my $F, '<', $chatlistfile or die "Unable to open $chatlistfile\n"; ## no critic (ErrorHandling::RequireUseOfExceptions,InputOutput::RequireBriefOpen)
+
+foreach my $chatid (<$F>) { ## no critic (InputOutput::ProhibitReadlineInForLoop)
+	chomp $chatid;
+	next if $chatid eq '';
+
+	if (PluginEnabled($chatid, 'oboobs')) {
+		$settings->{$chatid}->{plugins}->{oboobs} = 1;
+	}
+	if (PluginEnabled($chatid, 'obutts')) {
+		$settings->{$chatid}->{plugins}->{obutts} = 1;
+	}
+}
+
+close $F;
+
+my $data;
+
+foreach my $chatid (keys %$settings) {
+	my $item->{id} = $chatid;
+
+	if ($settings->{$chatid}->{fortune}) {
+		$item->{fortune} = 1;
+	} else {
+		$item->{fortune} = 0;
+	}
+
+	if ($settings->{$chatid}->{chanmsg}) {
+		$item->{chanmsg} = 1;
+	} else {
+		$item->{chanmsg} = 0;
+	}
+
+	if ($settings->{$chatid}->{greetmsg}) {
+		$item->{greetmsg} = 1;
+	} else {
+		$item->{greetmsg} = 0;
+	}
+
+	if ($settings->{$chatid}->{goodbyemsg}) {
+		$item->{goodbyemsg} = 1;
+	} else {
+		$item->{goodbyemsg} = 0;
+	}
+
+	if ($settings->{$chatid}->{adminmute}) {
+		$item->{adminmute} = 1;
+	} else {
+		$item->{adminmute} = 0;
+	}
+
+	if ($settings->{$chatid}->{plugins}->{obutts}) {
+		$item->{plugins}->{obutts} = 1;
+	} else {
+		$item->{plugins}->{obutts} = 0;
+	}
+
+	if ($settings->{$chatid}->{plugins}->{oboobs}) {
+		$item->{plugins}->{oboobs} = 1;
+	} else {
+		$item->{plugins}->{oboobs} = 0;
+	}
+
+	push @{$data}, $item;
+}
+
+my $json = eval { JSON::XS->new->utf8(1)->pretty(1)->encode($data) };
+
+if (defined $json) {
+	print $json . "\n";
+} else {
+	die "Unable to generate json, something went wrong: $EVAL_ERROR\n"; ## no critic (ErrorHandling::RequireUseOfExceptions)
+}
+
+# vim: set ft=perl noet ai ts=4 sw=4 sts=4:
--- a/extract_chatlist.txt.pl
+++ b/extract_chatlist.txt.pl
@@ -0,0 +1,28 @@
+#!/usr/bin/perl
+#
+use strict;
+use warnings;
+
+my %chats;
+open my $F, '<', 'debug.log' or die "Unable to open debug.log: $!\n"; ## no critic (ErrorHandling::RequireUseOfExceptions, InputOutput::RequireBriefOpen)
+
+foreach my $line (<$F>) { ## no critic (InputOutput::ProhibitReadlineInForLoop)
+	if ($line =~ /.DEBUG. In public chat .* \(\-(\d+)\) .* say:/) {
+			next unless defined $1;
+			next if $1 eq '';
+
+			$chats{$1} = 1;
+	}
+}
+
+close $F;
+
+open $F, '>', 'chatlist.txt' or die "Unable to open chatlist.txt: $!\n"; ## no critic (ErrorHandling::RequireUseOfExceptions)
+
+foreach my $chat (keys %chats) {
+	print $F "$chat\n";
+}
+
+close $F;
+
+# vim: set ft=perl noet ai ts=4 sw=4 sts=4:
--- a/lib/BotLib.pm
+++ b/lib/BotLib.pm
@@ -10,6 +10,7 @@ use English qw ( -no_match_vars );

 use Clone qw (clone);
 use Data::Dumper qw (Dumper);
+use JSON::PP ();
 use Log::Any qw ($log);
 use Math::Random::Secure qw (irand);

@@ -88,7 +89,7 @@ sub Command {
 	            лат friday пятница proverb пословица пословиться fortune фортунка f ф anek анек анекдот buni cat кис
 	            drink праздник fox лис frog лягушка horse лошадь лошадка monkeyuser owl сова сыч rabbit bunny кролик
 	            snail улитка tits boobs tities boobies сиси сисечки butt booty ass попа попка xkcd dig копать fish
-	            fishing рыба рыбка рыбалка karma карма fuck);
+	            fishing рыба рыбка рыбалка karma карма fuck w п weather погода погодка погадка);

 	my $bingo = 0;

@@ -185,11 +186,11 @@ ${csign}ping | ${csign}пинг               - попинговать бота
 ${csign}roll | ${csign}dice | ${csign}кости      - бросить кости
 ${csign}snail | ${csign}улитка            - улитка
 ${csign}ver | ${csign}version | ${csign}версия   - что-то про версию ПО
-${csign}w город | ${csign}п город         - погода в указанном городе
-${csign}weather город              - погода в указанном городе
-${csign}погода город               - погода в указанном городе
-${csign}погодка город              - погода в указанном городе
-${csign}погадка город              - погода в указанном городе
+${csign}w <город> | ${csign}п <город>     - погода в указанном городе
+${csign}weather <город>            - погода в указанном городе
+${csign}погода <город>             - погода в указанном городе
+${csign}погодка <город>            - погода в указанном городе
+${csign}погадка <город>            - погода в указанном городе
 ${csign}xkcd                       - рандомный стрип с сайта xkcd.ru
 ${csign}karma фраза | ${csign}карма фраза - посмотреть карму фразы
 фраза-- | фраза++           - убавить или добавить карму фразе
@@ -424,7 +425,7 @@ MYADMIN
 			my $arg = $1;
 			$arg = trim $1 if (defined $1);

-			if (defined $arg && $arg !~ /^\s*$/) {
+			if (defined ($arg) && $arg !~ /^\s*$/) {
 				if ($arg == 1) {
 					$reply = ChanMsgToggle ($chatid, 1);
 				} elsif ($arg == 0) {
@@ -437,7 +438,7 @@ MYADMIN
 			my $arg = $2;
 			$arg = trim $2 if (defined $2);

-			if (defined $arg &&  $arg !~ /^\s*$/) {
+			if (defined ($arg) && $arg !~ /^\s*$/) {
 				if ($arg == 1) {
 					$reply = GreetMsgToggle ($chatid, 1);
 				} elsif ($arg == 0) {
@@ -450,7 +451,7 @@ MYADMIN
 			my $arg = $2;
 			$arg = trim $2 if (defined $2);

-			if (defined $arg &&  $arg !~ /^\s*$/) {
+			if (defined ($arg) && $arg !~ /^\s*$/) {
 				if ($arg == 1) {
 					$reply = GoodbyeMsgToggle ($chatid, 1);
 				} elsif ($arg == 0) {
@@ -463,7 +464,7 @@ MYADMIN
 			my $arg = $1;
 			$arg = trim $1 if (defined $1);

-			if (defined $arg) {
+			if (defined ($arg) && $arg !~ /^\s*$/) {
 				if ($arg == 1) {
 					$reply = PluginToggle ($chatid, 'oboobs', 1);
 				} elsif ($arg == 0) {
@@ -476,7 +477,7 @@ MYADMIN
 			my $arg = $1;
 			$arg = trim $1 if (defined $1);

-			if (defined $arg) {
+			if (defined ($arg) && $arg !~ /^\s*$/) {
 				if ($arg == 1) {
 					$reply = PluginToggle ($chatid, 'obutts', 1);
 				} elsif ($arg == 0) {
--- a/lib/BotLib/Admin.pm
+++ b/lib/BotLib/Admin.pm
@@ -15,11 +15,19 @@ use version; our $VERSION = qw (1.1);
 use Exporter qw (import);
 # to export array we need @ISA here
 our @ISA    = qw / Exporter /; ## no critic (ClassHierarchies::ProhibitExplicitISA)
-our @EXPORT_OK = qw (@ForbiddenMessageTypes @PluginList GetForbiddenTypes AddForbiddenType DelForbiddenType
-                     ListForbidden FortuneToggle FortuneToggleList FortuneStatus PluginToggle PluginStatus
-                     PluginEnabled ChanMsgToggle ChanMsgStatus ChanMsgEnabled GreetMsgToggle GreetMsgStatus
-                     GreetMsgEnabled GoodbyeMsgToggle GoodbyeMsgStatus GoodbyeMsgEnabled MuteByAdminToggle
-                     MuteByAdminStatus MuteByAdminEnabled MigrateSettingsToNewChatID IsCensored);
+our @EXPORT_OK = qw (@ForbiddenMessageTypes @PluginList
+                     GetForbiddenTypes  AddForbiddenType  DelForbiddenType   ListForbidden EnabledForbidden
+                     FortuneToggle      FortuneStatus     FortuneEnabled     FortuneToggleList
+                     ChanMsgToggle      ChanMsgStatus     ChanMsgEnabled     ChanMsgToggleList
+                     GreetMsgToggle     GreetMsgStatus    GreetMsgEnabled    GreetMsgToggleList
+                     GoodbyeMsgToggle   GoodbyeMsgStatus  GoodbyeMsgEnabled  GoodbyeMsgToggleList
+                     PluginToggle       PluginStatus      PluginEnabled
+                     MuteByAdminToggle  MuteByAdminStatus MuteByAdminEnabled MuteByAdminToggleList
+                     MigrateSettingsToNewChatID
+                     IsCensored
+                     GetSlackGreetRememberId
+                     SetSlackGreetRememberId
+                    );

 my $c = LoadConf ();
 my $cachedir = $c->{cachedir};
@@ -405,6 +413,16 @@ sub GreetMsgEnabled ($) {
 	}
 }

+sub GreetMsgToggleList () {
+	my $cache = CHI->new (
+		driver => 'BerkeleyDB',
+		root_dir => $cachedir,
+		namespace => __PACKAGE__ . '_' . 'greet_msg',
+	);
+
+	return $cache->get_keys ();
+}
+
 sub GoodbyeMsgToggle (@) {
 	my $chatid = shift;
 	my $action = shift // undef;
@@ -491,6 +509,16 @@ sub GoodbyeMsgEnabled ($) {
 	}
 }

+sub GoodbyeMsgToggleList () {
+	my $cache = CHI->new (
+		driver => 'BerkeleyDB',
+		root_dir => $cachedir,
+		namespace => __PACKAGE__ . '_' . 'goodbye_msg',
+	);
+
+	return $cache->get_keys ();
+}
+
 sub PluginStatus (@) {
 	my $chatid = shift;
 	my $plugin = shift;
@@ -662,6 +690,16 @@ sub MuteByAdminEnabled ($) {
 	}
 }

+sub MuteByAdminToggleList () {
+	my $cache = CHI->new (
+		driver => 'BerkeleyDB',
+		root_dir => $cachedir,
+		namespace => __PACKAGE__ . '_' . 'admin_mute',
+	);
+
+	return $cache->get_keys ();
+}
+
 sub MigrateSettingsToNewChatID {
 	my $old_id = shift;
 	my $new_id = shift;
@@ -732,6 +770,43 @@ sub IsCensored {
 	return 0;
 }

+sub GetSlackGreetRememberId ($) {
+	my $userid = shift;
+
+	my $cache = CHI->new (
+		driver => 'BerkeleyDB',
+		root_dir => $cachedir,
+		namespace => __PACKAGE__ . '_' . 'slack_greet_remember_id',
+	);
+
+	my $state = $cache->get ($userid);
+
+	if (defined $state) {
+		if ($state) {
+			return 1;
+		} else {
+			return 0;
+		}
+	} else {
+		return 0;
+	}
+}
+
+sub SetSlackGreetRememberId ($) {
+	my $userid = shift;
+
+	my $cache = CHI->new (
+		driver => 'BerkeleyDB',
+		root_dir => $cachedir,
+		namespace => __PACKAGE__ . '_' . 'slack_greet_remember_id',
+	);
+
+	$cache->set ($userid, 1, 'never');
+
+	return;
+}
+
+
 1;

 # vim: set ft=perl noet ai ts=4 sw=4 sts=4:
--- a/lib/BotLib/Util.pm
+++ b/lib/BotLib/Util.pm
@@ -89,6 +89,7 @@ sub Highlight {
 		return ($userid, $username, $fullname, $highlight, undef);
 	}

+	if ($msg->can ('from')) {
 		$userid = $msg->from->id;

 		if ($msg->from->can ('username') && defined $msg->from->username ) {
@@ -104,6 +105,24 @@ sub Highlight {
 		} elsif ($msg->from->can ('last_name') && defined $msg->from->last_name) {
 			$fullname .= $msg->from->last_name;
 		}
+	} else {
+		# Reacions case.
+		$userid = $msg->user->id;
+
+		if ($msg->user->can ('username') && defined $msg->user->username ) {
+			$username = $msg->user->username;
+		}
+
+		if ($msg->user->can ('first_name') && defined $msg->user->first_name) {
+			$fullname = $msg->user->first_name;
+
+			if ($msg->user->can ('last_name') && defined $msg->user->last_name) {
+				$fullname .= ' ' . $msg->user->last_name;
+			}
+		} elsif ($msg->user->can ('last_name') && defined $msg->user->last_name) {
+			$fullname .= $msg->user->last_name;
+		}
+	}

 	if (defined $username) {
 		$visavi .= '@' . $username;
--- a/lib/RedisLib.pm
+++ b/lib/RedisLib.pm
@@ -71,14 +71,12 @@ sub redis_parse_message {

 		if ($r->{error}) {
 			# TODO: handle 50x errors? They occur when api servers being updated.
-			$log->error ('[ERROR] Unable to call sendMessage() BotAPI method: ' . Dumper ($r));
-
 			my $resp = eval { $r->{debug}->json };

 			if (defined $resp) {
 				if (defined ($resp->{error_code}) && $resp->{error_code} == 400) {
 					if (defined $resp->{description}) {
-						if ($resp->{description} eq 'Bad Request: have no rights to send a message') {
+						if ($resp->{description} eq 'Bad Request: not enough rights to send text messages to the chat') {
 							$log->notice ("[NOTICE] Have no rights to send message to $m->{chatid}");
 							# TODO: disable fortune if message is good morning fortune
 						} elsif ($resp->{description} eq 'Bad Request: chat not found') {
@@ -112,6 +110,8 @@ sub redis_parse_message {
 				} else {
 					$log->error ('[ERROR] Unable to handle BotAPI error: ' . Dumper ($resp));
 				}
+			} else {
+				$log->error ('[ERROR] Unable to call sendMessage() BotAPI method: ' . Dumper ($r));
 			}
 		}
 	}
--- a/lib/Teapot/Bot/Brain.pm
+++ b/lib/Teapot/Bot/Brain.pm
@@ -11,8 +11,9 @@ use utf8;
 use English                             qw ( -no_match_vars );

 use Mojo::IOLoop                           ();
-use Mojo::JSON                          qw (true false);
+use Mojo::JSON                          qw (true false encode_json);
 use Mojo::UserAgent                        ();
+use Mojo::Parameters                       ();
 use Carp                                qw (carp croak cluck confess);
                                        # use croak where we return error up to app that supply something wrong
                                        # use cluck where we want to say that something bad but non-critical happen in
@@ -32,6 +33,7 @@ use Teapot::Bot::Object::User              ();
 use Teapot::Bot::Object::Chat                   ();
 use Teapot::Bot::Object::ChatMember             ();
 use Teapot::Bot::Object::ChatInviteLink         ();
+use Teapot::Bot::Object::MessageReactionUpdated ();

 $Teapot::Bot::Brain::VERSION = '0.026';

@@ -845,13 +847,41 @@ sub _add_getUpdates_handler {
  my $last_update_id = -1;
  my $token          = $self->token;

+  my $timeout = 60;
+  my $limit   = 10;
+
+  my $au->[0] = 'message';
+  push @{$au}, 'edited_message';
+  push @{$au}, 'channel_post';
+  push @{$au}, 'edited_channel_post';
+  push @{$au}, 'message_reaction';
+  push @{$au}, 'message_reaction_count';
+  push @{$au}, 'inline_query';
+  push @{$au}, 'chosen_inline_result';
+  push @{$au}, 'callback_query';
+  push @{$au}, 'poll';
+  push @{$au}, 'poll_answer';
+  push @{$au}, 'my_chat_member';
+  push @{$au}, 'chat_member';
+  push @{$au}, 'chat_join_request';
+  push @{$au}, 'chat_boost';
+  push @{$au}, 'removed_chat_boost';
+  my $allowed_updates = encode_json ($au);
+
+  my $params = Mojo::Parameters->new();
+	$params = $params->append(limit           => $limit);
+  $params = $params->append(timeout         => $timeout);
+  $params = $params->append(allowed_updates => $allowed_updates);
+
  Mojo::IOLoop->recurring(
    0.1 => sub {
      # do nothing if our previous longpoll is still going
      return if $http_active;

      my $offset = $last_update_id + 1;
-      my $updateURL = "https://api.telegram.org/bot${token}/getUpdates?offset=${offset}&timeout=60";
+
+      my $updateURL = "https://api.telegram.org/bot${token}/getUpdates?offset=$offset&$params";
+
      $http_active = 1;

      $self->ua->get(
@@ -909,7 +939,7 @@ sub _process_message {
    $update = Teapot::Bot::Object::PollAnswer->create_from_hash($item->{poll_answer}, $self)                  if $item->{poll_answer};
    $update = Teapot::Bot::Object::ChatMemberUpdated->create_from_hash($item->{my_chat_member}, $self)        if $item->{my_chat_member};
    $update = Teapot::Bot::Object::ChatMemberUpdated->create_from_hash($item->{chat_member}, $self)           if $item->{chat_member};
-
+    $update = Teapot::Bot::Object::MessageReactionUpdated->create_from_hash($item->{message_reaction}, $self) if $item->{message_reaction};
    # if we got to this point without creating a response, it must be a type we
    # don't handle yet
    if (! $update) {
@@ -958,6 +988,41 @@ sub _post_request {
  return $result;
 }

+sub logOut {
+  my $self = shift;
+
+  my $send_args = {};
+  my $ret;
+
+  if (! defined($self->token) || $self->token eq '') {
+    $ret->{error}   = 1;
+    $ret->{message} = 'No token supplied to logOut()';
+
+    return $ret;
+  }
+
+  my $url               = sprintf 'https://api.telegram.org/bot%s/logOut', $self->token;
+
+  return $self->_post_request($url, $send_args);
+}
+
+sub Close {
+  my $self = shift;
+
+  my $send_args = {};
+  my $ret;
+
+  if (! defined($self->token) || $self->token eq '') {
+    $ret->{error}   = 1;
+    $ret->{message} = 'No token supplied to Close()';
+
+    return $ret;
+  }
+
+  my $url               = sprintf 'https://api.telegram.org/bot%s/close', $self->token;
+
+  return $self->_post_request($url, $send_args);
+}

 1;

--- a/lib/Teapot/Bot/Object/MessageReaction.pm
+++ b/lib/Teapot/Bot/Object/MessageReaction.pm
@@ -0,0 +1,60 @@
+package Teapot::Bot::Object::MessageReaction;
+# ABSTRACT: The base class for Telegram message 'Reaction' type.
+
+use strict;
+use warnings;
+use 5.018; ## no critic (ProhibitImplicitImport)
+use utf8;
+
+use Mojo::Base 'Teapot::Bot::Object::Base';
+
+$Teapot::Bot::Object::MessageReaction::VERSION = '0.026';
+
+has 'type';            # Type of the reaction, always “emoji”
+has 'emoji';           # Reaction emoji. Currently, it can be one of "👍", "👎", "❤", "🔥", "🥰", "👏", "😁", "🤔",
+# "🤯", "😱", "🤬", "😢", "🎉", "🤩", "🤮", "💩", "🙏", "👌", "🕊", "🤡", "🥱", "🥴", "😍", "🐳", "❤‍🔥", "🌚", "🌭",
+# "💯", "🤣", "⚡", "🍌", "🏆", "💔", "🤨", "😐", "🍓", "🍾", "💋", "🖕", "😈", "😴", "😭", "🤓", "👻", "👨‍💻", "👀",
+# "🎃", "🙈", "😇", "😨", "🤝", "✍", "🤗", "🫡", "🎅", "🎄", "☃", "💅", "🤪", "🗿", "🆒", "💘", "🙉", "🦄", "😘",
+# "💊", "🙊", "😎", "👾", "🤷‍♂", "🤷", "🤷‍♀", "😡"
+has 'custom_emoji_id'; # Only for ReactionTypeCustomEmoji. Custom emoji identifier.
+
+sub fields {
+  return {
+    'scalar'                    => [qw/type emoji custom_emoji_id total_count/],
+  };
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding utf8
+
+=head1 NAME
+
+Teapot::Bot::Object::MessageReaction - The base class for Telegram message 'Reaction' type
+
+=head1 VERSION
+
+version 0.026
+
+=head1 DESCRIPTION
+The base class for Telegram message 'Reaction' type.
+
+See L<https://core.telegram.org/bots/api#reactiontype> for details of the
+attributes available for C<Teapot::Bot::Object::MessageReaction> objects.
+
+=head1 AUTHOR
+
+Sergei Fedosov <eleksir@gmail.com>
+
+=head1 LICENSE AND COPYRIGHT
+
+This software is copyright (c) 2025 Sergei Fedosov <eleksir@gmail.com>.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut
--- a/lib/Teapot/Bot/Object/MessageReactionCount.pm
+++ b/lib/Teapot/Bot/Object/MessageReactionCount.pm
@@ -0,0 +1,58 @@
+package Teapot::Bot::Object::MessageReactionCount;
+# ABSTRACT: The base class for Telegram message 'Reaction' type.
+
+use strict;
+use warnings;
+use 5.018; ## no critic (ProhibitImplicitImport)
+use utf8;
+
+use Mojo::Base 'Teapot::Bot::Object::Base';
+
+use Teapot::Bot::Object::MessageReaction ();
+
+$Teapot::Bot::Object::MessageReactionCount::VERSION = '0.026';
+
+has 'type';        # Type of the reaction
+has 'total_count'; # Number of times the reaction was added
+
+sub fields {
+  return {
+    'Teapot::Bot::Object::MessageReaction' => [qw/type/],
+    'scalar'                               => [qw/total_count/],
+  };
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding utf8
+
+=head1 NAME
+
+Teapot::Bot::Object::MessageReactionCount - The base class for Telegram message 'Reaction' type
+
+=head1 VERSION
+
+version 0.026
+
+=head1 DESCRIPTION
+The base class for Telegram message 'Reaction' type.
+
+See L<https://core.telegram.org/bots/api#reactiontype> for details of the
+attributes available for C<Teapot::Bot::Object::MessageReactionCount> objects.
+
+=head1 AUTHOR
+
+Sergei Fedosov <eleksir@gmail.com>
+
+=head1 LICENSE AND COPYRIGHT
+
+This software is copyright (c) 2025 Sergei Fedosov <eleksir@gmail.com>.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut
--- a/lib/Teapot/Bot/Object/MessageReactionCountUpdated.pm
+++ b/lib/Teapot/Bot/Object/MessageReactionCountUpdated.pm
@@ -0,0 +1,61 @@
+package Teapot::Bot::Object::MessageReactionCountUpdated;
+# ABSTRACT: The base class for Telegram message 'Reaction' type.
+
+use strict;
+use warnings;
+use 5.018; ## no critic (ProhibitImplicitImport)
+use utf8;
+
+use Mojo::Base 'Teapot::Bot::Object::Base';
+
+use Teapot::Bot::Object::MessageReactionCount ();
+
+$Teapot::Bot::Object::MessageReactionCountUpdated::VERSION = '0.026';
+
+has 'chat';
+has 'message_id';
+has 'date';
+has 'reactions';
+
+sub fields {
+  return {
+    'Teapot::Bot::Object::Chat'                 => [qw/chat actor_chat/],
+    'Teapot::Bot::Object::MessageReactionCount' => [qw/reactions/],
+    'scalar'                                    => [qw/message_id date/],
+  };
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding utf8
+
+=head1 NAME
+
+Teapot::Bot::Object::MessageReactionCountUpdated - The base class for Telegram message 'Reaction' type
+
+=head1 VERSION
+
+version 0.026
+
+=head1 DESCRIPTION
+The base class for Telegram message 'Reaction' type.
+
+See L<https://core.telegram.org/bots/api#reactiontype> for details of the
+attributes available for C<Teapot::Bot::Object::MessageReactionCountUpdated> objects.
+
+=head1 AUTHOR
+
+Sergei Fedosov <eleksir@gmail.com>
+
+=head1 LICENSE AND COPYRIGHT
+
+This software is copyright (c) 2025 Sergei Fedosov <eleksir@gmail.com>.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut
--- a/lib/Teapot/Bot/Object/MessageReactionUpdated.pm
+++ b/lib/Teapot/Bot/Object/MessageReactionUpdated.pm
@@ -0,0 +1,67 @@
+package Teapot::Bot::Object::MessageReactionUpdated;
+# ABSTRACT: The base class for Telegram message 'ReactionUpdated' type.
+
+use strict;
+use warnings;
+use 5.018; ## no critic (ProhibitImplicitImport)
+use utf8;
+
+use Mojo::Base 'Teapot::Bot::Object::Base';
+
+use Teapot::Bot::Object::Chat ();
+use Teapot::Bot::Object::Chat ();
+use Teapot::Bot::Object::MessageReaction ();
+
+$Teapot::Bot::Object::MessageReactionUpdated::VERSION = '0.026';
+
+has 'chat';         # The chat containing the message the user reacted to
+has 'message_id';   # Unique identifier of the message inside the chat
+has 'user';         # Optional. The user that changed the reaction, if the user isn't anonymous
+has 'actor_chat';   # Optional. The chat on behalf of which the reaction was changed, if the user is anonymous
+has 'date';         # Date of the change in Unix time
+has 'old_reaction'; # Previous list of reaction types that were set by the user
+has 'new_reaction'; # New list of reaction types that have been set by the user
+
+sub fields {
+  return {
+    'Teapot::Bot::Object::Chat'            => [qw/chat actor_chat/],
+    'Teapot::Bot::Object::User'            => [qw/user/],
+    'Teapot::Bot::Object::MessageReaction' => [qw/old_reaction new_reaction/],
+    'scalar'                               => [qw/message_id date/],
+  };
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding utf8
+
+=head1 NAME
+
+Teapot::Bot::Object::MessageReaction - The base class for Telegram message 'ReactionUpdated' type
+
+=head1 VERSION
+
+version 0.026
+
+=head1 DESCRIPTION
+The base class for Telegram message 'ReactionUpdated' type.
+
+See L<https://core.telegram.org/bots/api#messagereactionupdated> for details of the
+attributes available for C<Teapot::Bot::Object::MessageReactionUpdated> objects.
+
+=head1 AUTHOR
+
+Sergei Fedosov <eleksir@gmail.com>
+
+=head1 LICENSE AND COPYRIGHT
+
+This software is copyright (c) 2025 Sergei Fedosov <eleksir@gmail.com>.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut
--- a/lib/TelegramBot.pm
+++ b/lib/TelegramBot.pm
@@ -15,10 +15,10 @@ use Math::Random::Secure qw (irand);
 use Mojo::Base              'Teapot::Bot::Brain';

 use BotLib::Admin        qw (FortuneToggleList ChanMsgEnabled GreetMsgEnabled GoodbyeMsgEnabled
-                             MigrateSettingsToNewChatID IsCensored);
+                             MigrateSettingsToNewChatID IsCensored GetSlackGreetRememberId SetSlackGreetRememberId);
 use BotLib               qw (Command);
 use BotLib::Conf         qw (LoadConf);
-use BotLib::Util         qw (trim fmatch BotSleep Highlight RandomCommonPhrase);
+use BotLib::Util         qw (trim fmatch Highlight RandomCommonPhrase);
 use RedisLib             qw (redis_events_listener);

 use version; our $VERSION = qw (1.0);
@@ -188,6 +188,10 @@ sub __on_msg {
 				}
 			}

+			# Remember user id, to check it later, in next event.
+			SetSlackGreetRememberId ($member->id);
+			$log->info (sprintf ("[INFO] New chat member %s (%s)", $member_str, $member->id));
+
 			push @members, sprintf '[%s](tg://user?id=%s)', $member_str, $member->id;
 		}

@@ -207,11 +211,53 @@ sub __on_msg {
 			);
 		}

-		BotSleep $msg;
-		my $res = $msg->replyMd ($phrase);
+		sleep 2;
+		my $m->{text} = $phrase;
+		$m->{chat_id} = $chatid;
+		$m->{disable_notification} = 1;
+		$m->{parse_mode} = 'Markdown';
+
+		my $res = $main::TGM->sendMessage ($m);

 		if ($res->{error}) {
-			$log->error ("Unable to call sendMessage BotAPI method: " . Dumper ($res));
+			$log->error ("[ERROR] Unable to call sendMessage BotAPI method: " . Dumper ($res));
+		}
+
+		return;
+	}
+
+	# Bots have non-0% tendency to appear with this kind of updates.
+	if ($msg->can ('new_chat_member') && defined ($msg->new_chat_member)) {
+		return;
+		# slackware_ru
+		unless ($chatid == -1001332512695) {
+			return;
+		}
+
+		sleep 2;
+
+		# Can be racy, but hope for best.
+		unless (GetSlackGreetRememberId($msg->new_chat_member->user->id)) {
+			$log->info ("[INFO] $vis_a_vi entered to chat without prior notice event");
+
+			# if earlier we did not get new chat member event, it looks like we have spammer here. Ban it.
+			my $send_args = undef;
+			$send_args->{chat_id}    = 0 + $chatid;
+			$send_args->{user_id}    = 0 + $msg->new_chat_member->user->id;
+
+			# According to docs if user banned for <30 seonds || >366 days it banned forever.
+			# Some bots have annoying behavior to constantly try to join chat.
+			$send_args->{until_date} = 10 + time ();
+			$send_args->{until_date} = 10 + time ();
+
+			my $result = $self->banChatMember ($send_args);
+
+			if ((ref ($result) eq 'JSON::PP::Boolean') && ($result == JSON::PP::true)) {
+				$log->info ("[INFO] $vis_a_vi banned");
+				return;
+			} else {
+				$log->error ("[ERROR] Unable to ban user: " . Dumper ($result));
+			}
 		}

 		return;
@@ -259,12 +305,17 @@ sub __on_msg {
 		my $res = $msg->replyMd ($phrase);

 		if ($res->{error}) {
-			$log->error ("Unable to call sendMessage BotAPI method: " . Dumper ($res));
+			$log->error ("[ERROR] Unable to call sendMessage BotAPI method: " . Dumper ($res));
 		}

 		return;
 	}

+	if ($msg->can ('old_reaction') || $msg->can ('new_reaction')) {
+		$log->debug (sprintf ('[DEBUG] user %s in %s posts reaction to message', $vis_a_vi, $chatname));
+		return;
+	}
+
 	# is this a 1-on-1 ?
 	if ($msg->chat->type eq 'private') {
 		unless (defined $msg->text) {
@@ -324,7 +375,7 @@ sub __on_msg {
 			my $res = $self->deleteMessage ({chat_id => $chatid, message_id => $msg->{message_id}});

 			if ($res->{error}) {
-				$log->error ("Unable to call sendMessage BotAPI method: " . Dumper ($res));
+				$log->error ("[ERROR] Unable to call sendMessage BotAPI method: " . Dumper ($res));
 			}
 		}

@@ -340,7 +391,7 @@ sub __on_msg {
 					my $res = $self->deleteMessage ({chat_id => $chatid, message_id => $msg->{message_id}});

 					if ($res->{error}) {
-						$log->error ("Unable to call sendMessage BotAPI method: " . Dumper ($res));
+						$log->error ("[ERROR] Unable to call sendMessage BotAPI method: " . Dumper ($res));
 					}
 				}
 			}
@@ -512,7 +563,7 @@ sub __on_msg {
 			my $res = $msg->reply ($reply);

 			if ($res->{error}) {
-				$log->error ("Unable to call sendMessage BotAPI method: " . Dumper ($res));
+				$log->error ("[ERROR] Unable to call sendMessage BotAPI method: " . Dumper ($res));
 			}
 		} else {
 			$log->debug (
Author	SHA1	Message	Date
eleksir	65a3382bb0	Do not manipulate lib path directly. Perl is a bit fucky about addng paths to @INC directly or via use lib; Also update .gitignore.	2026-01-02 16:16:22 +03:00
eleksir	8f6ccfba04	Add export_settings.pl to save chat settings in json Add missing functions to lib/BotLib/Admin.pm to be able to expoprt chat settings for for particular chats. Add extract_chatlist.txt.pl to extract chat list from debug.log	2026-01-02 15:56:08 +03:00
eleksir	2d0ad8560d	Enhance logging, disable autoban spammers	2025-05-19 22:08:26 +03:00
eleksir	c24644b10e	Ban spammers in slackware_ru chat automatically	2025-05-10 00:44:31 +03:00
eleksir	f97557868b	User sendMessage directly via global object, without sugar	2025-05-09 16:19:49 +03:00
eleksir	b024d5f13a	Do not send "Typing" as it cause errors, replace it with sleep.	2025-05-09 11:59:18 +03:00
eleksir	bc270457a4	Use correct fields for last_name and user id in updated member event (when new user joins)	2025-05-08 21:16:29 +03:00
eleksir	ba4ff36daf	Solve myterious riddle with users some sneaking unnoted by bot, which is a bummer!	2025-05-08 17:51:41 +03:00
eleksir	ec59703000	Fix reaction username in logs	2025-05-08 17:27:52 +03:00
eleksir	59a1a3538b	I have nothing to do with chat reactions, so log it and skip	2025-05-08 17:20:50 +03:00
eleksir	6e76d85899	Add quirk for api incosistency in reactions	2025-05-08 17:11:16 +03:00
eleksir	d21bab68ef	Make proper use of Reaction stuff in Teapot lib	2025-05-08 15:49:25 +03:00
eleksir	408dccd1b5	Fix variable name in Brain.pm that explodes bot	2025-05-08 15:06:12 +03:00
eleksir	a568c6f146	Do not include in repo data/Admin directory	2025-05-08 15:03:45 +03:00
eleksir	5448c9bfdb	Add type Reaction	2025-05-08 14:56:25 +03:00
eleksir	da182ae62f	Do not call logOut() since we have no webhooks and for faster restarts.	2025-04-27 13:07:15 +03:00
eleksir	82df563f40	Add list of allowed updates explicitly, add Close() method for telegram connection	2025-04-27 13:05:31 +03:00
eleksir	7bd0c3428f	Set explicitly ["chat_member","message_reaction","message_reaction_count"] as additional updates i want to receive	2025-04-24 22:01:29 +03:00
eleksir	7904957aaa	Implement commands w п weather погода погодка погадка without arguments	2025-02-09 14:51:10 +03:00
eleksir	132ebeffa4	Fix crash on condition check in !admin {obutts,oboobs} # command	2024-10-25 09:44:37 +03:00
eleksir	4f9675f1d2	Import JSON::PP explicitly in lib/BotLib.pm	2024-08-22 21:44:09 +03:00
eleksir	1667772268	Make use of logOut() method	2024-08-22 21:42:58 +03:00
eleksir	ebaf2c9b38	Add logOut() method to Teapot lib	2024-08-22 21:29:49 +03:00
eleksir	b9c88ad4e7	Dump SendMessage() error only if we not handle it properly	2023-08-29 17:28:35 -07:00