From a1a4a5804889d67a4d02c1e01af976eaff5392ca Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20H=C3=A4rter?= Date: Mon, 22 May 2023 18:10:51 +0200 Subject: [PATCH] Switched to object usage of f1 perl libary. Accepted perltidy suggestions. --- F1DataBot.pm | 411 +++++++++++++++++++++++++++++++++++--------------- bot_script.pl | 3 +- 2 files changed, 290 insertions(+), 124 deletions(-) diff --git a/F1DataBot.pm b/F1DataBot.pm index 69f030b..b1608c2 100644 --- a/F1DataBot.pm +++ b/F1DataBot.pm @@ -1,12 +1,17 @@ -#!/usr/bin/perl - # Important for switch feature use v5.34; +use utf8; use strict; use warnings; +no warnings qw(experimental); + +# core packages +use Encode; + # CPAN packages +use JSON; use Log::Log4perl; # Package name @@ -14,161 +19,321 @@ package F1DataBot; # Constants and initalisations Log::Log4perl->init('log.conf'); -my $ERGAST_URL = 'http://ergast.com/api/f1'; -my $TELEGRAM_URL = 'https://api.telegram.org'; -my $TOKEN = 'bot5868933096:AAE8Oe-AxU6m_yCWfpqTqwwjERqnRpBGJtE'; + +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('F1DataBot'); + $Self->{Token} = 'bot5868933096:AAE8Oe-AxU6m_yCWfpqTqwwjERqnRpBGJtE'; + $Self->{URL} = { + Ergast => 'http://ergast.com/api/f1', + Telegram => 'https://api.telegram.org', + }; + + return $Self; +} sub greet { - my %Param = @_; - my $LogObject = Log::Log4perl->get_logger('F1DataBot'); - use Data::Dumper; + my ( $Self, %Param ) = @_; - $LogObject->info('greet: Initiating greet routine'); + $Self->{LogObject}->info('greet: Initiating greet routine'); - if ( !defined $Param{Message} ) { - $LogObject->error('greet: Message not defined!'); - return; - } + 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)) ] || ''; - $LogObject->debug('Random Greet is ' . $Greet); - my $ReturnContent = $Greet . ', ' . ($Param{Message}->{chat}->{first_name} ? $Param{Message}->{chat}->{first_name} : $Param{Message}->{chat}->{username}) . '!'; - $LogObject->debug('ReturnContent is ' . $ReturnContent); - return $ReturnContent; + 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, }; + +} + +sub build { + + my ( $Self, %Param ) = @_; + use Data::Dumper; + use JSON; + use LWP::Simple::REST qw(POST plain); + + my $EncodedKeyboard = JSON::encode_json( + { + 'inline_keyboard' => [ + [ + { + 'text' => 'Grüßen', + 'callback_data' => 'greet' + }, + { + 'text' => 'Statistik', + 'callback_data' => 'statistics' + }, + ], + ], + 'resize' => 1, + 'single_use' => 1, + 'placeholder' => 'test', + }, + ); + my $ResponseResult = plain POST( + join( '/', ( $TELEGRAM_URL, $TOKEN, 'sendMessage' ) ), + { + 'chat_id' => $Param{Message}->{chat}->{id}, + 'reply_to_message_id' => $Param{Message}->{id}, + 'text' => +"Hallo $Param{Message}, über die folgenden Fragen kannst du auswählen, welche Interaktion du ausführen möchtest. Was möchtest du tun?", + 'reply_markup' => $EncodedKeyboard, + } + ); + $Self->{LogObject}->info( 'build: Sending result is ' . $ResponseResult ); + + return {}; } sub statistics { - my %Param = @_; - my $LogObject = Log::Log4perl->get_logger('F1DataBot'); - use Data::Dumper; - use LWP::Simple::REST qw(GET json); - use XML::Parser; + my ( $Self, %Param ) = @_; + use Data::Dumper; + use LWP::Simple::REST qw(GET json); - $LogObject->info('statistics: Initiating statistics routine'); + $Self->{LogObject}->info('statistics: Initiating statistics routine'); - if ( !defined $Param{Message} ) { - $LogObject->error('statistics: Message not defined!'); - return; - } + if ( !defined $Param{Message} ) { + $Self->{LogObject}->error('statistics: Message not defined!'); + return; + } - # Parse arguments - # Expected format: driver | constructor | circuit - # Circuit: [name] [statistics identifier] [individual parameters] - $Param{Message}->{text} =~ /^(\/statistics)\s(?driver|constructor|circuit)/; - my $StatClass = $+{statclass}; - given ( $StatClass ) { + # Parse arguments + # Expected format: driver | constructor | circuit + # Circuit: [name] [statistics identifier] [individual parameters] + $Param{Message}->{text} =~ + /^(\/statistics)\s(?driver|constructor|circuit)/; + my $StatClass = $+{statclass}; + my %ReturnData; + given ($StatClass) { - when ( 'driver' ) { - $LogObject->info('statistics: Recognizing driver command'); - $Param{Message}->{text} =~ /^(\/statistics)\s$StatClass\s(?\w+)/; - my $StatIdentifier = $+{statidentifier}; - given ( $StatIdentifier ) { - when ( 'standings' ) { - my $Standings = json POST ( join('/', ($ERGAST_URL, 'current', 'driverStandings.json')), {} ); - $LogObject->info('statistics: Fetched standings are ' . Dumper($Standings)); - my %DriverStandings; - my $DriverStandingsFormatted = ''; - for my $Driver ( $Standings->{MRData}->{StandingsTable}->{StandingsLists}->[0]->{DriverStandings}->@* ) { - $DriverStandingsFormatted .= "Position: $Driver->{positionText}, Name: $Driver->{Driver}->{code} - Points: $Driver->{points}\n"; - } - return $DriverStandingsFormatted; - } - default { - return "I'm sorry, " . ($Param{Message}->{chat}->{first_name} ? $Param{Message}->{chat}->{first_name} : $Param{Message}->{chat}->{username}) . ", I recognized you wanted to fetch a statistic about drivers, but I couldn't determine which one. Maybe you want to try again? Currently available are:\n\tstandings"; - } - } - } - when ( 'constructor' ) { - $LogObject->info('statistics: Recognizing constructor command'); - } - when ( 'circuit' ) { - $LogObject->info('statistics: Recognizing circuit command'); - } - # Statistics class not recognized - default { - return "I'm sorry, " . ($Param{Message}->{chat}->{first_name} ? $Param{Message}->{chat}->{first_name} : $Param{Message}->{chat}->{username}) . ", I recognized you wanted to fetch a statistic, but I couldn't determine which one. Maybe you want to try again? Currently available are:\n\tdriver\n\tconstructor\n\tcircuit"; - } + when ('driver') { + $Self->{LogObject}->info('statistics: Recognizing driver command'); + $Param{Message}->{text} =~ + /^(\/statistics)\s$StatClass\s(?\w+)/; + my $StatIdentifier = $+{statidentifier}; + given ($StatIdentifier) { + when ('standings') { + my $Standings = json POST( + join( '/', + ( $ERGAST_URL, 'current', 'driverStandings.json' ) + ), + {} + ); + my %DriverStandings; + my $DriverStandingsFormatted = sprintf( "%-3s%-4s%-5s%7s\n", + "#", "No.", "Code", "Points" ); + for my $Driver ( $Standings->{MRData}->{StandingsTable} + ->{StandingsLists}->[0]->{DriverStandings}->@* ) + { + $DriverStandingsFormatted .= sprintf( + "%-3d%-4d%-5s%7d\n", + $Driver->{positionText}, + $Driver->{Driver}->{permanentNumber}, + $Driver->{Driver}->{code}, + $Driver->{points} + ); + } + $DriverStandingsFormatted =~ s/^/
/;
+                    $DriverStandingsFormatted =~ s/$/<\/pre>/;
+                    $Self->{LogObject}
+                      ->info( 'statistics: DriverStandingsFormatted are '
+                          . $DriverStandingsFormatted );
+                    $Self->{LogObject}
+                      ->info( 'statistics: DriverStandingsFormattedLength is '
+                          . length($DriverStandingsFormatted) );
+                    $ReturnData{text}       = $DriverStandingsFormatted;
+                    $ReturnData{parse_mode} = 'HTML';
+                }
+                default {
+                    $ReturnData{text} =
+                      "I'm sorry, "
+                      . ( $Param{Message}->{chat}->{first_name}
+                        ? $Param{Message}->{chat}->{first_name}
+                        : $Param{Message}->{chat}->{username} )
+                      . ", I recognized you wanted to fetch a statistic about drivers, but I couldn't determine which one. Maybe you want to try again? Currently available are:\n\tstandings";
+                }
+            }
+        }
+        when ('constructor') {
+            $Self->{LogObject}
+              ->info('statistics: Recognizing constructor command');
+            $Param{Message}->{text} =~
+              /^(\/statistics)\s$StatClass\s(?\w+)/;
+            my $StatIdentifier = $+{statidentifier};
+            given ($StatIdentifier) {
+                when ('standings') {
+                    my $Standings = json POST(
+                        join(
+                            '/',
+                            (
+                                $ERGAST_URL, 'current',
+                                'constructorStandings.json'
+                            )
+                        ),
+                        {}
+                    );
+                    $Self->{LogObject}
+                      ->info( 'statistics: Fetched standings are '
+                          . Dumper($Standings) );
+                    my %ConstructorStandings;
+                    my $ConstructorStandingsFormatted = '';
+                    for my $Constructor ( $Standings->{MRData}->{StandingsTable}
+                        ->{StandingsLists}->[0]->{ConstructorStandings}->@* )
+                    {
+                        $ConstructorStandingsFormatted .=
+"Position: $Constructor->{positionText}, Name: $Constructor->{Constructor}->{name} - Points: $Constructor->{points}\n";
+                    }
+                    $ConstructorStandingsFormatted =~ s/^/
/;
+                    $ConstructorStandingsFormatted =~ s/$/<\/pre>/;
 
-	}
-	
-	# Use system to call the python script (big shame, but nothing to do about it)
-	return '';
+                    $ReturnData{parse_mode} = 'HTML';
+                }
+                default {
+                    $ReturnData{text} =
+                      "I'm sorry, "
+                      . ( $Param{Message}->{chat}->{first_name}
+                        ? $Param{Message}->{chat}->{first_name}
+                        : $Param{Message}->{chat}->{username} )
+                      . ", I recognized you wanted to fetch a statistic about constructors, but I couldn't determine which one. Maybe you want to try again? Currently available are:\n\tstandings";
+                }
+            }
+        }
+        when ('circuit') {
+            $Self->{LogObject}->info('statistics: Recognizing circuit command');
+        }
+
+        # Statistics class not recognized
+        default {
+            $ReturnData{text} =
+              "I'm sorry, "
+              . ( $Param{Message}->{chat}->{first_name}
+                ? $Param{Message}->{chat}->{first_name}
+                : $Param{Message}->{chat}->{username} )
+              . ", I recognized you wanted to fetch a statistic, but I couldn't determine which one. Maybe you want to try again? Currently available are:\n\tdriver\n\tconstructor\n\tcircuit";
+        }
+
+    }
+
+    return \%ReturnData;
+
+  # Use system to call the python script (big shame, but nothing to do about it)
 
 }
 
 sub processMessage {
 
-	my %Param     = @_;
-	my $LogObject = Log::Log4perl->get_logger('F1DataBot');
-	use Data::Dumper;
-	use LWP::Simple::REST qw(POST plain);
+    my ( $Self, %Param ) = @_;
+    use Data::Dumper;
+    use LWP::Simple::REST qw(POST plain json);
 
-	my %Commands = (
-		'greet'      => \&greet,
-		'statistics' => \&statistics,
-	);
+    my %Commands = (
+        'greet'      => \&greet,
+        'statistics' => \&statistics,
+        'build'      => \&build,
+    );
 
-	if ( !defined $Param{Message} ) {
-		$LogObject->error('processMessage: Message not defined!');
-		return;
-	}
+    if ( !defined $Param{Message} ) {
+        $Self->{LogObject}->error('processMessage: Message not defined!');
+        return;
+    }
 
-	$LogObject->info('processMessage: Starting to process message');
-	$LogObject->info('processMessage: Message is ' . Dumper($Param{Message}));
+    $Self->{LogObject}->info('processMessage: Starting to process message');
+    $Self->{LogObject}
+      ->info( 'processMessage: Message is ' . Dumper( $Param{Message} ) );
 
-	my $Message = $Param{Message}->{message};
+    my $Message = $Param{Message}->{message};
+    if ( $Message->{from}->{id} eq '587238001' ) {
+        return;
+    }
 
-	my $ResponseContent;
-	if ( $Message->{text} =~ /\/(?greet|statistics)\s?(?.*)?/ ) {
-		my $Command         = $+{command};
-		my $ArgumentsString = $+{arguments};
-		$ResponseContent    = $Commands{$Command}(
-			Message   => $Message,
-			Arguments => $ArgumentsString,
-		); 
-	}
-	else {
-		$LogObject->debug('Command not recognized. Data: ' . $Message->{text});
-		$ResponseContent = "I'm sorry, " . ($Message->{chat}->{first_name} ? $Message->{chat}->{first_name} : $Message->{chat}->{username}) . ", I couldn't understand your request. Currently I can process the commands:\n\n\t\/greet";
-	}
+    my $ResponseData = {};
+    if ( $Message->{text} =~
+        /\/(?greet|statistics|build)\s?(?.*)?/ )
+    {
+        my $Command         = $+{command};
+        my $ArgumentsString = $+{arguments};
+        $ResponseData = $Commands{$Command}(
+            Message   => $Message,
+            Arguments => $ArgumentsString,
+        );
+        if ( !keys $ResponseData->%* ) {
+            return;
+        }
+    }
+    else {
+        $Self->{LogObject}
+          ->debug( 'Command not recognized. Data: ' . $Message->{text} );
+        $ResponseData->{text} =
+          "I'm sorry, "
+          . ( $Message->{chat}->{first_name}
+            ? $Message->{chat}->{first_name}
+            : $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('/', ($TELEGRAM_URL, $TOKEN, 'sendMessage')), {
- 				chat_id => $Message->{chat}->{id},
- 				text    => $ResponseContent,
- 			} );
- 	$LogObject->info('processMessage: Answering result is ' . Dumper($ResponseResult));
- 
- 	# mark message as read
- 	my $SeenResult = plain POST ( join('/', ($TELEGRAM_URL, $TOKEN, 'readMessageContents')), {
- 			id => $Message->{id},
- 		} );
+    my $ResponseResult = plain POST(
+        join( '/', ( $TELEGRAM_URL, $TOKEN, 'sendMessage' ) ),
+        {
+            chat_id => $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( '/', ( $TELEGRAM_URL, $TOKEN, 'readMessageContents' ) ),
+        {
+            id => $Message->{id},
+        }
+    );
 
 }
 
 sub fetchMessages {
 
-	my %Param = @_;
-	my $LogObject = Log::Log4perl->get_logger('F1DataBot');
-	use Data::Dumper;
-	use LWP::Simple::REST qw(GET json);
+    my ( $Self, %Param ) = @_;
+    use Data::Dumper;
+    use LWP::Simple::REST qw(GET json);
 
-	my $Method = 'getUpdates';
-	$LogObject->info('fetchMessages: Initiating getUpdates');
+    my $Method = 'getUpdates';
+    $Self->{LogObject}->info('fetchMessages: Initiating getUpdates');
 
-	my $MessageDataRaw = json GET ( join('/', ($TELEGRAM_URL, $TOKEN, $Method)), {} );
-	$LogObject->info('fetchMessages: Messages raw are ' . Dumper($MessageDataRaw));
-	my @Messages = $MessageDataRaw->{result}->@*;
-	$LogObject->info('fetchMessages: Messages returned are ' . Dumper(\@Messages));
-	for my $Message ( @Messages ) {
-		$LogObject->info('fetchMessages: Calling processMessage');
-		processMessage(
-			Message => $Message,
-		);
-	}
+    my $MessageDataRaw =
+      json GET( join( '/', ( $TELEGRAM_URL, $TOKEN, $Method ) ), {} );
+    $Self->{LogObject}
+      ->info( 'fetchMessages: Messages raw are ' . Dumper($MessageDataRaw) );
+    my @Messages = $MessageDataRaw->{result}->@*;
+    $Self->{LogObject}
+      ->info( 'fetchMessages: Messages returned are ' . Dumper( \@Messages ) );
+    for my $Message (@Messages) {
+        $Self->{LogObject}->info('fetchMessages: Calling processMessage');
+        processMessage( Message => $Message, );
+    }
 
 }
 
diff --git a/bot_script.pl b/bot_script.pl
index 42e87c3..0d5430d 100644
--- a/bot_script.pl
+++ b/bot_script.pl
@@ -4,4 +4,5 @@ use lib '/home/demiguise/telegram_bot';
 
 use F1DataBot;
 
-F1DataBot::fetchMessages();
+my $F1DataBotObject = F1DataBot->new();
+$F1DataBotObject->fetchMessages();