F1DataTelegramBot/F1DataBot.pm

# 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 JSON;
use Log::Log4perl;
use YAML;

# Package name
package F1DataBot;

# Constants and initalisations
Log::Log4perl->init("$FindBin::Bin/log.conf");

sub new {
    my ( $Type, %Param ) = @_;

    # allocate new hash for object
    my $Self = {};
    bless( $Self, $Type );

    # TODO Use LogLevel Param for Logger Initialisation.
    $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',
    };

    # 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 statistics

	Starting point for executing F1 statistic queries.

=cut

sub statistics {

    my ( $Self, %Param ) = @_;
    use Data::Dumper;
    use LWP::Simple::REST qw(GET json);

    $Self->{LogObject}->info('statistics: Initiating statistics routine');

    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(?<statclass>driver|constructor|circuit)/;
    my $StatClass = $+{statclass};
    my %ReturnData;
    given ($StatClass) {

        when ('driver') {
            $Self->{LogObject}->info('statistics: Recognizing driver command');
            $Param{Message}->{text} =~
              /^(\/statistics)\s$StatClass\s(?<statidentifier>\w+)/;
            my $StatIdentifier = $+{statidentifier};
            given ($StatIdentifier) {
                when ('standings') {
                    my $Standings = json POST(
                        join( '/',
                            ( $Self->{URL}{Ergast}, '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/^/<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 {
                    $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(?<statidentifier>\w+)/;
            my $StatIdentifier = $+{statidentifier};
            given ($StatIdentifier) {
                when ('standings') {
                    my $Standings = json POST(
                        join(
                            '/',
                            (
                                $Self->{URL}{Ergast}, '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/^/<pre>/;
                    $ConstructorStandingsFormatted =~ s/$/<\/pre>/;
                    $ReturnData{text} = $ConstructorStandingsFormatted;
                }
                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)

}

=head1 replyLoveQuote

    Reply with lovely text to special user id.

=cut

sub replyLoveQuote {

    my ( $Self, %Param ) = @_;

    return unless $Self->{Whitelist}->{$Param{Message}->{from}->{id}} eq 'Sarah' || $Self->{Whitelist}->{$Param{Message}->{from}->{id}} eq 'Stefan';

    my $LoveQuotes = YAML::LoadFile("$FindBin::Bin/lovely_quotes.yml");

    my %MessageData;
    if ( ref $LoveQuotes eq 'ARRAY' ) {

        my $QuoteID = int( rand( $#{ $LoveQuotes } ) );

        my $Message = $LoveQuotes->[$QuoteID]->{Text};
        $Message .= "\n\n - <i>$LoveQuotes->[$QuoteID]->{Source}</i>";

        %MessageData = (
            text => $Message,
            parse_mode => 'HTML',
        );
    }

    return \%MessageData;

}

=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) );
            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('message_ids.yml', $Self->{MessageIDs});
}

1;