TelegramBot/TelegramBot.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 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->{TelegramURL} = 'https://api.telegram.org';

    # load remembered update ids
    $Self->{MessageIDs} = YAML::LoadFile("$FindBin::Bin/message_ids.yml");

    # whitelist
    $Self->{Whitelist} = $Param{Whitelist};

    # default command list
    $Self->{CommandList} = {
        'greet' => \&greet,
    };

    # default query trigger
    $Self->{QueryTrigger} = {
        'startQuery' => 1,
    };

    $Self->{Data} = {};

    # load plugins
    my @Plugins = glob("$FindBin::Bin/Plugins/*");

    # iterate over plugins found
    if ( @Plugins ) {
        use File::Basename;
        PLUGIN:
        for my $PluginPath ( @Plugins ) {
            my $PluginName = basename($PluginPath);
            next PLUGIN unless require("$FindBin::Bin/Plugins/${PluginName}/Core.pm");

            my $FullPath = "Plugins::${PluginName}::Core";
            my $PluginObject = $FullPath->new;
            if( !$PluginObject ) {
                $Self->{LogObject}->error("Couldn't load plugin $PluginName");
                next PLUGIN;
            }

            # import plugin command list
            my $PluginCommandList = $PluginObject->getCommandList();
            COMMAND:
            for my $PluginCommand ( keys $PluginCommandList->%* ) {
                next COMMAND if $Self->{CommandList}{$PluginCommand};

                $Self->{CommandList}{$PluginCommand} = $PluginCommandList->{$PluginCommand};
            }

            # import plugin query trigger
            my $PluginQueryTriggerList = $PluginObject->getQueryTrigger();
            QUERYTRIGGER:
            for my $PluginQueryTrigger ( keys $PluginQueryTriggerList->%* ) {
                next QUERYTRIGGER if $Self->{QueryTrigger}{$PluginQueryTrigger};

                $Self->{QueryTrigger}{$PluginQueryTrigger} = $PluginQueryTriggerList->{$PluginQueryTrigger};
            }

            # import module data
            my $PluginData = $PluginObject->getData();
            $Self->{Data} = {
                $Self->{Data}->%*,
                $PluginData->%*,
            };
        }
    }

    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

# TODO rebuild to take custom parameters of various kind
sub build {
    my ( $Self, %Param ) = @_;

    use Data::Dumper;
    use JSON;
    use LWP::Simple::REST qw(POST plain);

    my $KeyboardData;
    my $KeyboardMessage;
    if ( $Param{KeyboardData} ) {
        $KeyboardData    = $Param{KeyboardData};
        $KeyboardMessage = $Param{KeyboardMessage} // '';
    }
    elsif ( $Param{QueryStep} ) {
        if ( $Param{QueryStep} eq 'hist' ) {
            # show next selection
        }
        else {
            # for now, testing fallback
            my $ResponseResult = plain POST(
                join( '/', ( $Self->{TelegramURL}, $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}{message}{chat}{first_name}, über die folgenden Fragen kannst du auswählen, welche Interaktion du ausführen möchtest. Was möchtest du tun?";
    }

    # keyboard encoding
    my $EncodedKeyboard = JSON::to_json(
        $KeyboardData,
    );
    my $ResponseResult = plain POST(
        join( '/', ( $Self->{TelegramURL}, $Self->{Token}, 'sendMessage' ) ),
        {
            'chat_id'             => $Param{Message}{message}{chat}{id} || $Param{Message}{chat}{id},
            'reply_to_message_id' => $Param{Message}{message}{message_id} || $Param{Message}{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      = {};
    my $CommandList       = join('|', keys $Self->{CommandList}->%*);
    my $QueryTriggerList  = join('|', keys $Self->{QueryTrigger}->%*);

    # command branch
    if ( defined $Param{Message}{message} && $Param{Message}{message}{text} && $Param{Message}{message}{text} =~
        /\/(?<command>$CommandList)\s?(?<arguments>.*)?/ )
    {
        my $Message = $Param{Message}{message};
        my $Command         = $+{command};
        my $ArgumentsString = $+{arguments};
        $ResponseData = $Self->{CommandList}{$Command}(
            $Self,
            Message   => $Message,
            Arguments => $ArgumentsString,
        );
        if ( !keys $ResponseData->%* ) {
            return;
        }
    }

    # query trigger branch
    elsif ( defined $Param{Message}{message} && $Param{Message}{message}{text} && $Param{Message}{message}{text} =~ /\/(?<trigger>$QueryTriggerList)/ ) {
        my $Subname = $+{trigger};
        $Self->$Subname(
            Message => $Param{Message},
        );
    }

    # query result branch
    elsif ( defined $Param{Message}{callback_query} ) {
        my $ArgumentsString = '';
        $ResponseData = $Self->{CommandList}{$Param{Message}{callback_query}{data}}(
            $Self,
            Message => $Param{Message}{callback_query}{message},
            Arguments => $ArgumentsString,
        );
        if ( !keys $ResponseData->%* ) {
            return;
        }
    }
    else {
        $Self->{LogObject}
          ->debug( 'Command not recognized. Data: ' . $Param{Message}{message}{text} );
        if ( 0 && $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->{TelegramURL}, $Self->{Token}, 'sendMessage' ) ),
        {
            chat_id => $Param{Message}{message}{chat}{id} || $Param{Message}{callback_query}{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->{TelegramURL}, $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->{TelegramURL}, $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) {
        my $MessageID = $Message->{message}{message_id} || $Message->{callback_query}{message}{message_id};
        my $UserID    = $Message->{message}{from}{id} || $Message->{callback_query}{message}{chat}{id};
        if ( !$Self->{Whitelist}{$UserID} ) {
            $Self->{LogObject}
              ->info( 'fetchMessages: User not whitelisted, skipping message ' . Dumper($MessageDataRaw) );

            $Self->{MessageIDs}{$MessageID} = 1;
            next MESSAGE;
        }
        if ($Self->{MessageIDs}{$MessageID}) {
            $Self->{LogObject}->info('fetchMessages: Skipping known message_id');
            next MESSAGE;
        }
        else {
            $Self->{LogObject}->info('fetchMessages: Calling processMessage');
            $Self->{MessageIDs}{$MessageID} = 1;
            $Self->processMessage( Message => $Message, );
        }
    }
    YAML::DumpFile("$FindBin::Bin/message_ids.yml", $Self->{MessageIDs});
}

1;