Do not manipulate lib path directly.

Perl is a bit fucky about addng paths to @INC directly or via use lib;
Also update .gitignore.

.gitignore

@@ -4,5 +4,7 @@ _Deparsed_XSubs.pm
 .vstags
 aleesa-telegram.pid
 data/cache/**
+data/admin/**
 data/config.json
+data/chatlist.txt
 vendor_perl/**

bin/aleesa-telegram

@@ -193,10 +193,6 @@ sub __fork {
 sub __signal_handler {
 	$log->info ("[INFO] Caught a signal $OS_ERROR");
 
-	eval {
-		$main::TGM->logOut();
-	};
-
 	if (-e $pidfile) {
 		unlink $pidfile;
 	}

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:

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:

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:

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;

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&allowed_updates=%5B%22message%22%2C%22edited_message%22%2C%22channel_post%22%2C%22edited_channel_post%22%2C%22poll%22%2C%22chat_member%22%2C%22message_reaction%22%2C%22message_reaction_count%22%2C%22poll_answer%22%2C%22my_chat_member%22%2C%22chat_join_request%22%2C%22chat_boost%22%2C%22removed_chat_boost%22%5D";
+
+      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) {
@@ -976,6 +1006,24 @@ sub logOut {
   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;
 
 __END__

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

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

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

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

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 (