Added initial bot module.

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} =~
+        /\/(?<command>greet|statistics|build)\s?(?<arguments>.*)?/ )
+    {
+        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;

bot_script.pl

@@ -0,0 +1,26 @@
+#/usr/bin/perl
+
+use v5.32;
+
+use strict;
+use warnings;
+
+use FindBin;
+use YAML;
+
+my $Conf;
+BEGIN { $Conf = YAML::LoadFile("$FindBin::Bin/.bot.cnf"); }
+
+if ( !$Conf->%* ) {
+    print STDERR "No valid config was found. Exiting...\n";
+    exit;
+}
+
+use lib $Conf->{Lib};
+
+use TelegramBot;
+
+my $BotObject = TelegramBot->new($Conf->%*);
+$BotObject->fetchMessages();
+
+exit;

log.conf

@@ -0,0 +1,9 @@
+# Config file for Log4perl
+log4perl.rootLogger=DEBUG, LOGFILE
+
+log4perl.appender.LOGFILE=Log::Log4perl::Appender::File
+log4perl.appender.LOGFILE.filename=log4perl.log
+log4perl.appender.LOGFILE.mode=append
+
+log4perl.appender.LOGFILE.layout=PatternLayout
+log4perl.appender.LOGFILE.layout.ConversionPattern=[%r] %F %L %c - %m%n