Switched to object usage of f1 perl libary.
Accepted perltidy suggestions.
This commit is contained in:
parent
2056d25b46
commit
a1a4a58048
303
F1DataBot.pm
303
F1DataBot.pm
@ -1,12 +1,17 @@
|
|||||||
#!/usr/bin/perl
|
|
||||||
|
|
||||||
# Important for switch feature
|
# Important for switch feature
|
||||||
use v5.34;
|
use v5.34;
|
||||||
|
|
||||||
|
use utf8;
|
||||||
use strict;
|
use strict;
|
||||||
use warnings;
|
use warnings;
|
||||||
|
|
||||||
|
no warnings qw(experimental);
|
||||||
|
|
||||||
|
# core packages
|
||||||
|
use Encode;
|
||||||
|
|
||||||
# CPAN packages
|
# CPAN packages
|
||||||
|
use JSON;
|
||||||
use Log::Log4perl;
|
use Log::Log4perl;
|
||||||
|
|
||||||
# Package name
|
# Package name
|
||||||
@ -14,160 +19,320 @@ package F1DataBot;
|
|||||||
|
|
||||||
# Constants and initalisations
|
# Constants and initalisations
|
||||||
Log::Log4perl->init('log.conf');
|
Log::Log4perl->init('log.conf');
|
||||||
my $ERGAST_URL = 'http://ergast.com/api/f1';
|
|
||||||
my $TELEGRAM_URL = 'https://api.telegram.org';
|
sub new {
|
||||||
my $TOKEN = 'bot5868933096:AAE8Oe-AxU6m_yCWfpqTqwwjERqnRpBGJtE';
|
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 {
|
sub greet {
|
||||||
|
|
||||||
my %Param = @_;
|
my ( $Self, %Param ) = @_;
|
||||||
my $LogObject = Log::Log4perl->get_logger('F1DataBot');
|
|
||||||
use Data::Dumper;
|
|
||||||
|
|
||||||
$LogObject->info('greet: Initiating greet routine');
|
$Self->{LogObject}->info('greet: Initiating greet routine');
|
||||||
|
|
||||||
if ( !defined $Param{Message} ) {
|
if ( !defined $Param{Message} ) {
|
||||||
$LogObject->error('greet: Message not defined!');
|
$Self->{LogObject}->error('greet: Message not defined!');
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
|
|
||||||
my @Greetings = qw(Hallo Gruezi Hello Holá Bonjour Konichiwa Shalom Godmorgen);
|
my @Greetings =
|
||||||
my $Greet = $Greetings[ int(rand(7)) ] || '';
|
qw(Hallo Gruezi Hello Holá Bonjour Konichiwa Shalom Godmorgen);
|
||||||
$LogObject->debug('Random Greet is ' . $Greet);
|
my $Greet = $Greetings[ int( rand(7) ) ] || '';
|
||||||
my $ReturnContent = $Greet . ', ' . ($Param{Message}->{chat}->{first_name} ? $Param{Message}->{chat}->{first_name} : $Param{Message}->{chat}->{username}) . '!';
|
$Self->{LogObject}->debug( 'Random Greet is ' . $Greet );
|
||||||
$LogObject->debug('ReturnContent is ' . $ReturnContent);
|
my $ReturnContent =
|
||||||
return $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 {
|
sub statistics {
|
||||||
|
|
||||||
my %Param = @_;
|
my ( $Self, %Param ) = @_;
|
||||||
my $LogObject = Log::Log4perl->get_logger('F1DataBot');
|
|
||||||
use Data::Dumper;
|
use Data::Dumper;
|
||||||
use LWP::Simple::REST qw(GET json);
|
use LWP::Simple::REST qw(GET json);
|
||||||
use XML::Parser;
|
|
||||||
|
|
||||||
$LogObject->info('statistics: Initiating statistics routine');
|
$Self->{LogObject}->info('statistics: Initiating statistics routine');
|
||||||
|
|
||||||
if ( !defined $Param{Message} ) {
|
if ( !defined $Param{Message} ) {
|
||||||
$LogObject->error('statistics: Message not defined!');
|
$Self->{LogObject}->error('statistics: Message not defined!');
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Parse arguments
|
# Parse arguments
|
||||||
# Expected format: driver | constructor | circuit
|
# Expected format: driver | constructor | circuit
|
||||||
# Circuit: [name] [statistics identifier] [individual parameters]
|
# Circuit: [name] [statistics identifier] [individual parameters]
|
||||||
$Param{Message}->{text} =~ /^(\/statistics)\s(?<statclass>driver|constructor|circuit)/;
|
$Param{Message}->{text} =~
|
||||||
|
/^(\/statistics)\s(?<statclass>driver|constructor|circuit)/;
|
||||||
my $StatClass = $+{statclass};
|
my $StatClass = $+{statclass};
|
||||||
given ( $StatClass ) {
|
my %ReturnData;
|
||||||
|
given ($StatClass) {
|
||||||
|
|
||||||
when ( 'driver' ) {
|
when ('driver') {
|
||||||
$LogObject->info('statistics: Recognizing driver command');
|
$Self->{LogObject}->info('statistics: Recognizing driver command');
|
||||||
$Param{Message}->{text} =~ /^(\/statistics)\s$StatClass\s(?<statidentifier>\w+)/;
|
$Param{Message}->{text} =~
|
||||||
|
/^(\/statistics)\s$StatClass\s(?<statidentifier>\w+)/;
|
||||||
my $StatIdentifier = $+{statidentifier};
|
my $StatIdentifier = $+{statidentifier};
|
||||||
given ( $StatIdentifier ) {
|
given ($StatIdentifier) {
|
||||||
when ( 'standings' ) {
|
when ('standings') {
|
||||||
my $Standings = json POST ( join('/', ($ERGAST_URL, 'current', 'driverStandings.json')), {} );
|
my $Standings = json POST(
|
||||||
$LogObject->info('statistics: Fetched standings are ' . Dumper($Standings));
|
join( '/',
|
||||||
|
( $ERGAST_URL, 'current', 'driverStandings.json' )
|
||||||
|
),
|
||||||
|
{}
|
||||||
|
);
|
||||||
my %DriverStandings;
|
my %DriverStandings;
|
||||||
my $DriverStandingsFormatted = '';
|
my $DriverStandingsFormatted = sprintf( "%-3s%-4s%-5s%7s\n",
|
||||||
for my $Driver ( $Standings->{MRData}->{StandingsTable}->{StandingsLists}->[0]->{DriverStandings}->@* ) {
|
"#", "No.", "Code", "Points" );
|
||||||
$DriverStandingsFormatted .= "Position: $Driver->{positionText}, Name: $Driver->{Driver}->{code} - Points: $Driver->{points}\n";
|
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}
|
||||||
|
);
|
||||||
}
|
}
|
||||||
return $DriverStandingsFormatted;
|
$DriverStandingsFormatted =~ s/^/<pre>/;
|
||||||
|
$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 {
|
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";
|
$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' ) {
|
when ('constructor') {
|
||||||
$LogObject->info('statistics: Recognizing constructor command');
|
$Self->{LogObject}
|
||||||
|
->info('statistics: Recognizing constructor command');
|
||||||
|
$Param{Message}->{text} =~
|
||||||
|
/^(\/statistics)\s$StatClass\s(?<statidentifier>\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";
|
||||||
}
|
}
|
||||||
when ( 'circuit' ) {
|
$ConstructorStandingsFormatted =~ s/^/<pre>/;
|
||||||
$LogObject->info('statistics: Recognizing circuit command');
|
$ConstructorStandingsFormatted =~ s/$/<\/pre>/;
|
||||||
|
|
||||||
|
$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
|
# Statistics class not recognized
|
||||||
default {
|
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";
|
$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)
|
# Use system to call the python script (big shame, but nothing to do about it)
|
||||||
return '';
|
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
||||||
sub processMessage {
|
sub processMessage {
|
||||||
|
|
||||||
my %Param = @_;
|
my ( $Self, %Param ) = @_;
|
||||||
my $LogObject = Log::Log4perl->get_logger('F1DataBot');
|
|
||||||
use Data::Dumper;
|
use Data::Dumper;
|
||||||
use LWP::Simple::REST qw(POST plain);
|
use LWP::Simple::REST qw(POST plain json);
|
||||||
|
|
||||||
my %Commands = (
|
my %Commands = (
|
||||||
'greet' => \&greet,
|
'greet' => \&greet,
|
||||||
'statistics' => \&statistics,
|
'statistics' => \&statistics,
|
||||||
|
'build' => \&build,
|
||||||
);
|
);
|
||||||
|
|
||||||
if ( !defined $Param{Message} ) {
|
if ( !defined $Param{Message} ) {
|
||||||
$LogObject->error('processMessage: Message not defined!');
|
$Self->{LogObject}->error('processMessage: Message not defined!');
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
|
|
||||||
$LogObject->info('processMessage: Starting to process message');
|
$Self->{LogObject}->info('processMessage: Starting to process message');
|
||||||
$LogObject->info('processMessage: Message is ' . Dumper($Param{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;
|
my $ResponseData = {};
|
||||||
if ( $Message->{text} =~ /\/(?<command>greet|statistics)\s?(?<arguments>.*)?/ ) {
|
if ( $Message->{text} =~
|
||||||
|
/\/(?<command>greet|statistics|build)\s?(?<arguments>.*)?/ )
|
||||||
|
{
|
||||||
my $Command = $+{command};
|
my $Command = $+{command};
|
||||||
my $ArgumentsString = $+{arguments};
|
my $ArgumentsString = $+{arguments};
|
||||||
$ResponseContent = $Commands{$Command}(
|
$ResponseData = $Commands{$Command}(
|
||||||
Message => $Message,
|
Message => $Message,
|
||||||
Arguments => $ArgumentsString,
|
Arguments => $ArgumentsString,
|
||||||
);
|
);
|
||||||
|
if ( !keys $ResponseData->%* ) {
|
||||||
|
return;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
$LogObject->debug('Command not recognized. Data: ' . $Message->{text});
|
$Self->{LogObject}
|
||||||
$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";
|
->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')), {
|
my $ResponseResult = plain POST(
|
||||||
|
join( '/', ( $TELEGRAM_URL, $TOKEN, 'sendMessage' ) ),
|
||||||
|
{
|
||||||
chat_id => $Message->{chat}->{id},
|
chat_id => $Message->{chat}->{id},
|
||||||
text => $ResponseContent,
|
$ResponseData->%*,
|
||||||
} );
|
}
|
||||||
$LogObject->info('processMessage: Answering result is ' . Dumper($ResponseResult));
|
);
|
||||||
|
my $Response = JSON::decode_json($ResponseResult);
|
||||||
|
$Self->{LogObject}
|
||||||
|
->info( 'processMessage: Answering result is ' . Dumper($Response) );
|
||||||
|
|
||||||
# mark message as read
|
# mark message as read
|
||||||
my $SeenResult = plain POST ( join('/', ($TELEGRAM_URL, $TOKEN, 'readMessageContents')), {
|
my $SeenResult = plain POST(
|
||||||
|
join( '/', ( $TELEGRAM_URL, $TOKEN, 'readMessageContents' ) ),
|
||||||
|
{
|
||||||
id => $Message->{id},
|
id => $Message->{id},
|
||||||
} );
|
}
|
||||||
|
);
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
||||||
sub fetchMessages {
|
sub fetchMessages {
|
||||||
|
|
||||||
my %Param = @_;
|
my ( $Self, %Param ) = @_;
|
||||||
my $LogObject = Log::Log4perl->get_logger('F1DataBot');
|
|
||||||
use Data::Dumper;
|
use Data::Dumper;
|
||||||
use LWP::Simple::REST qw(GET json);
|
use LWP::Simple::REST qw(GET json);
|
||||||
|
|
||||||
my $Method = 'getUpdates';
|
my $Method = 'getUpdates';
|
||||||
$LogObject->info('fetchMessages: Initiating getUpdates');
|
$Self->{LogObject}->info('fetchMessages: Initiating getUpdates');
|
||||||
|
|
||||||
my $MessageDataRaw = json GET ( join('/', ($TELEGRAM_URL, $TOKEN, $Method)), {} );
|
my $MessageDataRaw =
|
||||||
$LogObject->info('fetchMessages: Messages raw are ' . Dumper($MessageDataRaw));
|
json GET( join( '/', ( $TELEGRAM_URL, $TOKEN, $Method ) ), {} );
|
||||||
|
$Self->{LogObject}
|
||||||
|
->info( 'fetchMessages: Messages raw are ' . Dumper($MessageDataRaw) );
|
||||||
my @Messages = $MessageDataRaw->{result}->@*;
|
my @Messages = $MessageDataRaw->{result}->@*;
|
||||||
$LogObject->info('fetchMessages: Messages returned are ' . Dumper(\@Messages));
|
$Self->{LogObject}
|
||||||
for my $Message ( @Messages ) {
|
->info( 'fetchMessages: Messages returned are ' . Dumper( \@Messages ) );
|
||||||
$LogObject->info('fetchMessages: Calling processMessage');
|
for my $Message (@Messages) {
|
||||||
processMessage(
|
$Self->{LogObject}->info('fetchMessages: Calling processMessage');
|
||||||
Message => $Message,
|
processMessage( Message => $Message, );
|
||||||
);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|||||||
@ -4,4 +4,5 @@ use lib '/home/demiguise/telegram_bot';
|
|||||||
|
|
||||||
use F1DataBot;
|
use F1DataBot;
|
||||||
|
|
||||||
F1DataBot::fetchMessages();
|
my $F1DataBotObject = F1DataBot->new();
|
||||||
|
$F1DataBotObject->fetchMessages();
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user