From 406679ae2e9ca1f7c738e175c06056542f0a5e97 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20H=C3=A4rter?= Date: Sun, 12 Nov 2023 18:20:06 +0100 Subject: [PATCH] Added initial bot module. --- TelegramBot.pm | 285 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 285 insertions(+) create mode 100644 TelegramBot.pm diff --git a/TelegramBot.pm b/TelegramBot.pm new file mode 100644 index 0000000..e27d4b8 --- /dev/null +++ b/TelegramBot.pm @@ -0,0 +1,285 @@ +# Important for switch feature +use v5.32; + +use utf8; +use strict; +use warnings; + +no warnings qw(experimental); + +# core packages +use Encode; +use FindBin; + +# CPAN packages +use Cache::FastMmap; +use JSON; +use Log::Log4perl; +use YAML; + +# Package name +package TelegramBot; + +# Constants and initalisations +Log::Log4perl->init("$FindBin::Bin/log.conf"); +my $CACHE = Cache::FastMmap->new( + share_file => '/tmp/telegram_bot', + serializer => 'json', + unlink_on_exit => 0, + expire_time => 86400, +); + +sub new { + my ( $Type, %Param ) = @_; + + # allocate new hash for object + my $Self = {}; + bless( $Self, $Type ); + + $Self->{LogLevel} = $Param{LogLevel} || 'info'; + $Self->{LogObject} = Log::Log4perl->get_logger('TelegramBot'); + $Self->{Token} = 'bot5868933096:AAE8Oe-AxU6m_yCWfpqTqwwjERqnRpBGJtE'; + $Self->{URL} = { + Telegram => 'https://api.telegram.org', + }; + + # load remembered update ids + $Self->{MessageIDs} = YAML::LoadFile("$FindBin::Bin/message_ids.yml"); + + # whitelist + $Self->{Whitelist} = $Param{Whitelist}; + + return $Self; +} + +=head1 greet + + Merely a dummy routine to test the bot's functionallity. Maybe using it for easter eggs or some kind of fun later. + +=cut + +sub greet { + + my ( $Self, %Param ) = @_; + + $Self->{LogObject}->info('greet: Initiating greet routine'); + + if ( !defined $Param{Message} ) { + $Self->{LogObject}->error('greet: Message not defined!'); + return; + } + + my @Greetings = + qw(Hallo Gruezi Hello Holá Bonjour Konichiwa Shalom Godmorgen); + my $Greet = $Greetings[ int( rand(7) ) ] || ''; + $Self->{LogObject}->debug( 'Random Greet is ' . $Greet ); + my $ReturnContent = + $Greet . ', ' + . ( $Param{Message}->{chat}->{first_name} + ? $Param{Message}->{chat}->{first_name} + : $Param{Message}->{chat}->{username} ) + . '!'; + $Self->{LogObject}->debug( 'ReturnContent is ' . $ReturnContent ); + return { text => $ReturnContent, }; +} + +=head1 build + + Sub which is used to offer custom query building to the user by offering a decision tree of options via inline keyboard. + +=cut + +sub build { + + my ( $Self, %Param ) = @_; + use Data::Dumper; + use JSON; + use LWP::Simple::REST qw(POST plain); + + my $KeyboardData; + my $KeyboardMessage; + if ( $Param{QueryStep} ) { + if ( $Param{QueryStep} eq 'hist' ) { + # show next selection + } + else { + # for now, testing fallback + my $ResponseResult = plain POST( + join( '/', ( $Self->{URL}{Telegram}, $Self->{Token}, 'sendMessage' ) ), + { + 'chat_id' => $Param{Message}->{callback_query}->{from}->{id}, + 'reply_to_message_id' => $Param{Message}->{callback_query}->{message}->{message_id}, + 'text' => "Kommando $Param{QueryStep} erkannt", + } + ); + $Self->{LogObject}->info( 'build: Sending result is ' . $ResponseResult ); + return {}; + } + + } + else { + $KeyboardData = { + 'inline_keyboard' => [ + [ + { + 'text' => 'Grüßen', + 'callback_data' => 'greet' + }, + { + 'text' => 'Statistik', + 'callback_data' => 'statistics' + }, + ], + ], + 'resize' => 1, + 'single_use' => 1, + 'placeholder' => 'test', + }; + $KeyboardMessage = "Hallo $Param{Message}->{chat}->{first_name}, über die folgenden Fragen kannst du auswählen, welche Interaktion du ausführen möchtest. Was möchtest du tun?"; + } + my $EncodedKeyboard = JSON::encode_json( + $KeyboardData, + ); + my $ResponseResult = plain POST( + join( '/', ( $Self->{URL}{Telegram}, $Self->{Token}, 'sendMessage' ) ), + { + 'chat_id' => $Param{Message}->{chat}->{id}, + 'reply_to_message_id' => $Param{Message}->{id}, + 'text' => $KeyboardMessage, + 'reply_markup' => $EncodedKeyboard, + } + ); + $Self->{LogObject}->info( 'build: Sending result is ' . $ResponseResult ); + + return {}; + +} + +=head1 processMessage + + Function which receives a single message and decides what to to based on message content and attributes. + +=cut + +sub processMessage { + + my ( $Self, %Param ) = @_; + use Data::Dumper; + use LWP::Simple::REST qw(POST plain json); + + if ( !defined $Param{Message} ) { + $Self->{LogObject}->error('processMessage: Message not defined!'); + return; + } + + $Self->{LogObject}->info('processMessage: Starting to process message'); + $Self->{LogObject} + ->info( 'processMessage: Message is ' . Dumper( $Param{Message} ) ); + + + my $ResponseData = {}; + if ( defined $Param{Message}->{message} && $Param{Message}->{message}->{text} =~ + /\/(?greet|statistics|build)\s?(?.*)?/ ) + { + my $Message = $Param{Message}->{message}; + my $Command = $+{command}; + my $ArgumentsString = $+{arguments}; + $ResponseData = $Self->$Command( + Message => $Message, + Arguments => $ArgumentsString, + ); + if ( !keys $ResponseData->%* ) { + return; + } + } + elsif ( defined $Param{Message}->{callback_query} ) { + $Self->build( + Message => $Param{Message}, + QueryStep => $Param{Message}->{callback_query}->{data}, + ); + } + else { + $Self->{LogObject} + ->debug( 'Command not recognized. Data: ' . $Param{Message}->{message}->{text} ); + if ( $Self->{Whitelist}->{$Param{Message}->{message}->{from}->{id}} eq 'Sarah' + || $Self->{Whitelist}->{$Param{Message}->{message}->{from}->{id}} eq 'Stefan' ) { + $ResponseData = $Self->replyLoveQuote( Message => $Param{Message}->{message} ); + } + else { + $ResponseData->{text} = + "I'm sorry, " + . ( $Param{Message}->{message}->{chat}->{first_name} + ? $Param{Message}->{message}->{chat}->{first_name} + : $Param{Message}->{message}->{chat}->{username} ) + . ", I couldn't understand your request. Currently I can process the commands:\n\n\t\/greet\n\t\/statistics driver standings\n\t\/statistics constructor standings"; + } + + } + + my $ResponseResult = plain POST( + join( '/', ( $Self->{URL}{Telegram}, $Self->{Token}, 'sendMessage' ) ), + { + chat_id => $Param{Message}->{message}->{chat}->{id}, + $ResponseData->%*, + } + ); + my $Response = JSON::decode_json($ResponseResult); + $Self->{LogObject} + ->info( 'processMessage: Answering result is ' . Dumper($Response) ); + + # mark message as read + my $SeenResult = plain POST( + join( '/', ( $Self->{URL}{Telegram}, $Self->{Token}, 'readMessageContents' ) ), + { + id => $Param{Message}->{message}->{id}, + } + ); + +} + +=head1 fetchMessages + + Requesting messages from Telegram API and passing them one by one to processMessage. + +=cut + +sub fetchMessages { + + my ( $Self, %Param ) = @_; + use Data::Dumper; + use LWP::Simple::REST qw(GET json); + + my $Method = 'getUpdates'; + $Self->{LogObject}->info('fetchMessages: Initiating getUpdates'); + + my $MessageDataRaw = + json GET( join( '/', ( $Self->{URL}{Telegram}, $Self->{Token}, $Method ) ), {} ); + $Self->{LogObject} + ->info( 'fetchMessages: Messages raw are ' . Dumper($MessageDataRaw) ); + my @Messages = $MessageDataRaw->{result}->@*; + $Self->{LogObject} + ->info( 'fetchMessages: Messages returned are ' . Dumper( \@Messages ) ); + + MESSAGE: + for my $Message (@Messages) { + if ( !$Self->{Whitelist}{$Message->{message}{from}{id}} ) { + $Self->{LogObject} + ->info( 'fetchMessages: User not whitelisted, skipping message ' . Dumper($MessageDataRaw) ); + + $Self->{MessageIDs}{$Message->{message}{message_id}} = 1; + next MESSAGE; + } + if ($Self->{MessageIDs}{$Message->{message}{message_id}}) { + $Self->{LogObject}->info('fetchMessages: Skipping known message_id'); + next MESSAGE; + } + else { + $Self->{LogObject}->info('fetchMessages: Calling processMessage'); + $Self->{MessageIDs}{$Message->{message}{message_id}} = 1; + $Self->processMessage( Message => $Message, ); + } + } + YAML::DumpFile("$FindBin::Bin/message_ids.yml", $Self->{MessageIDs}); +} + +1;