# Important for switch feature use v5.32; use utf8; use strict; use warnings; no warnings qw(experimental); # core packages use Encode; # CPAN packages use JSON; use Log::Log4perl; use YAML; # Package name package F1DataBot; # Constants and initalisations Log::Log4perl->init('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->{UpdateIDs} = YAML::LoadFile('update_ids.yml'); 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(?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(?\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/^/
/;
                    $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(
                            '/',
                            (
                                $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/^/
/;
                    $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
        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 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} ) );


    if ( $Param{Message}->{message}->{from}->{id} eq '587238001' ) {
        return;
    }

    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} );
        $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) {
        $Self->{LogObject}->info('fetchMessages: Calling processMessage');
        if ($Self->{UpdateIDs}{$Message->{update_id}}) {
            $Self->{LogObject}->info('fetchMessages: Skipping known update_id');
            next MESSAGE;
        }
        else {
            $Self->{UpdateIDs}{$Message->{update_id}} = 1;
            $Self->processMessage( Message => $Message, );
        }
    }
    YAML::DumpFile('update_ids.yml', $Self->{UpdateIDs});
}

1;