Some tidying and a bit of necessary reworking.
This commit is contained in:
		
							
								
								
									
										111
									
								
								TelegramBot.pm
									
									
									
									
									
								
							
							
						
						
									
										111
									
								
								TelegramBot.pm
									
									
									
									
									
								
							@@ -47,18 +47,27 @@ sub new {
 | 
				
			|||||||
    # whitelist
 | 
					    # whitelist
 | 
				
			||||||
    $Self->{Whitelist} = $Param{Whitelist};
 | 
					    $Self->{Whitelist} = $Param{Whitelist};
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					    # default command list
 | 
				
			||||||
    $Self->{CommandList} = {
 | 
					    $Self->{CommandList} = {
 | 
				
			||||||
        'greet' => \&greet,
 | 
					        'greet' => \&greet,
 | 
				
			||||||
    };
 | 
					    };
 | 
				
			||||||
 | 
					
 | 
				
			||||||
    # include plugins
 | 
					    # default query trigger
 | 
				
			||||||
 | 
					    $Self->{QueryTrigger} = {
 | 
				
			||||||
 | 
					        'startQuery' => 1,
 | 
				
			||||||
 | 
					    };
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					    # load plugins
 | 
				
			||||||
    my @Plugins = glob("$FindBin::Bin/Plugins/*");
 | 
					    my @Plugins = glob("$FindBin::Bin/Plugins/*");
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					    # iterate over plugins found
 | 
				
			||||||
    if ( @Plugins ) {
 | 
					    if ( @Plugins ) {
 | 
				
			||||||
        use File::Basename;
 | 
					        use File::Basename;
 | 
				
			||||||
        PLUGIN:
 | 
					        PLUGIN:
 | 
				
			||||||
        for my $PluginPath ( @Plugins ) {
 | 
					        for my $PluginPath ( @Plugins ) {
 | 
				
			||||||
            my $PluginName = basename($PluginPath);
 | 
					            my $PluginName = basename($PluginPath);
 | 
				
			||||||
            next PLUGIN unless require("$FindBin::Bin/Plugins/${PluginName}/Core.pm");
 | 
					            next PLUGIN unless require("$FindBin::Bin/Plugins/${PluginName}/Core.pm");
 | 
				
			||||||
 | 
					
 | 
				
			||||||
            my $FullPath = "Plugins::${PluginName}::Core";
 | 
					            my $FullPath = "Plugins::${PluginName}::Core";
 | 
				
			||||||
            my $PluginObject = $FullPath->new;
 | 
					            my $PluginObject = $FullPath->new;
 | 
				
			||||||
            if( !$PluginObject ) {
 | 
					            if( !$PluginObject ) {
 | 
				
			||||||
@@ -74,6 +83,15 @@ sub new {
 | 
				
			|||||||
 | 
					
 | 
				
			||||||
                $Self->{CommandList}{$PluginCommand} = $PluginCommandList->{$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};
 | 
				
			||||||
 | 
					            }
 | 
				
			||||||
        }
 | 
					        }
 | 
				
			||||||
    }
 | 
					    }
 | 
				
			||||||
 | 
					
 | 
				
			||||||
@@ -102,9 +120,9 @@ sub greet {
 | 
				
			|||||||
    $Self->{LogObject}->debug( 'Random Greet is ' . $Greet );
 | 
					    $Self->{LogObject}->debug( 'Random Greet is ' . $Greet );
 | 
				
			||||||
    my $ReturnContent =
 | 
					    my $ReturnContent =
 | 
				
			||||||
      $Greet . ', '
 | 
					      $Greet . ', '
 | 
				
			||||||
      . ( $Param{Message}->{chat}->{first_name}
 | 
					      . ( $Param{Message}{chat}{first_name}
 | 
				
			||||||
        ? $Param{Message}->{chat}->{first_name}
 | 
					        ? $Param{Message}{chat}{first_name}
 | 
				
			||||||
        : $Param{Message}->{chat}->{username} )
 | 
					        : $Param{Message}{chat}{username} )
 | 
				
			||||||
      . '!';
 | 
					      . '!';
 | 
				
			||||||
    $Self->{LogObject}->debug( 'ReturnContent is ' . $ReturnContent );
 | 
					    $Self->{LogObject}->debug( 'ReturnContent is ' . $ReturnContent );
 | 
				
			||||||
    return { text => $ReturnContent, };
 | 
					    return { text => $ReturnContent, };
 | 
				
			||||||
@@ -118,8 +136,8 @@ sub greet {
 | 
				
			|||||||
 | 
					
 | 
				
			||||||
# TODO rebuild to take custom parameters of various kind
 | 
					# TODO rebuild to take custom parameters of various kind
 | 
				
			||||||
sub build {
 | 
					sub build {
 | 
				
			||||||
 | 
					 | 
				
			||||||
    my ( $Self, %Param ) = @_;
 | 
					    my ( $Self, %Param ) = @_;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
    use Data::Dumper;
 | 
					    use Data::Dumper;
 | 
				
			||||||
    use JSON;
 | 
					    use JSON;
 | 
				
			||||||
    use LWP::Simple::REST qw(POST plain);
 | 
					    use LWP::Simple::REST qw(POST plain);
 | 
				
			||||||
@@ -135,8 +153,8 @@ sub build {
 | 
				
			|||||||
            my $ResponseResult = plain POST(
 | 
					            my $ResponseResult = plain POST(
 | 
				
			||||||
                join( '/', ( $Self->{TelegramURL}, $Self->{Token}, 'sendMessage' ) ),
 | 
					                join( '/', ( $Self->{TelegramURL}, $Self->{Token}, 'sendMessage' ) ),
 | 
				
			||||||
                {
 | 
					                {
 | 
				
			||||||
                    'chat_id'             => $Param{Message}->{callback_query}->{from}->{id},
 | 
					                    'chat_id'             => $Param{Message}{callback_query}{from}{id},
 | 
				
			||||||
                    'reply_to_message_id' => $Param{Message}->{callback_query}->{message}->{message_id},
 | 
					                    'reply_to_message_id' => $Param{Message}{callback_query}{message}{message_id},
 | 
				
			||||||
                    'text'                => "Kommando $Param{QueryStep} erkannt",
 | 
					                    'text'                => "Kommando $Param{QueryStep} erkannt",
 | 
				
			||||||
                }
 | 
					                }
 | 
				
			||||||
            );
 | 
					            );
 | 
				
			||||||
@@ -146,17 +164,16 @@ sub build {
 | 
				
			|||||||
 | 
					
 | 
				
			||||||
    }
 | 
					    }
 | 
				
			||||||
    else {
 | 
					    else {
 | 
				
			||||||
        # TODO load list of commands from core and plugins
 | 
					 | 
				
			||||||
        $KeyboardData = {
 | 
					        $KeyboardData = {
 | 
				
			||||||
            'inline_keyboard' => [
 | 
					            'inline_keyboard' => [
 | 
				
			||||||
                [
 | 
					                [
 | 
				
			||||||
                    {
 | 
					                    {
 | 
				
			||||||
                        'text'          => 'Grüßen',
 | 
					                        'text'          => 'Grüßen',
 | 
				
			||||||
                        'callback_data' => 'greet'
 | 
					                        'callback_data' => 'greet',
 | 
				
			||||||
                    },
 | 
					                    },
 | 
				
			||||||
                    {
 | 
					                    {
 | 
				
			||||||
                        'text'          => 'Statistik',
 | 
					                        'text'          => 'Statistik',
 | 
				
			||||||
                        'callback_data' => 'statistics'
 | 
					                        'callback_data' => 'statistics',
 | 
				
			||||||
                    },
 | 
					                    },
 | 
				
			||||||
                ],
 | 
					                ],
 | 
				
			||||||
            ],
 | 
					            ],
 | 
				
			||||||
@@ -164,18 +181,20 @@ sub build {
 | 
				
			|||||||
            'single_use'  => 1,
 | 
					            'single_use'  => 1,
 | 
				
			||||||
            'placeholder' => 'test',
 | 
					            '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?";
 | 
					        $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?";
 | 
				
			||||||
    }
 | 
					    }
 | 
				
			||||||
    my $EncodedKeyboard = JSON::encode_json(
 | 
					
 | 
				
			||||||
 | 
					    # keyboard encoding
 | 
				
			||||||
 | 
					    my $EncodedKeyboard = JSON::to_json(
 | 
				
			||||||
        $KeyboardData,
 | 
					        $KeyboardData,
 | 
				
			||||||
    );
 | 
					    );
 | 
				
			||||||
    my $ResponseResult = plain POST(
 | 
					    my $ResponseResult = plain POST(
 | 
				
			||||||
        join( '/', ( $Self->{TelegramURL}, $Self->{Token}, 'sendMessage' ) ),
 | 
					        join( '/', ( $Self->{TelegramURL}, $Self->{Token}, 'sendMessage' ) ),
 | 
				
			||||||
        {
 | 
					        {
 | 
				
			||||||
            'chat_id'             => $Param{Message}->{chat}->{id},
 | 
					            'chat_id'             => $Param{Message}{message}{chat}{id},
 | 
				
			||||||
            'reply_to_message_id' => $Param{Message}->{id},
 | 
					            'reply_to_message_id' => $Param{Message}{message}{message_id},
 | 
				
			||||||
            'text'                => $KeyboardMessage,
 | 
					            'text'                => $KeyboardMessage,
 | 
				
			||||||
            'reply_markup' => $EncodedKeyboard,
 | 
					            'reply_markup'        => $EncodedKeyboard,
 | 
				
			||||||
        }
 | 
					        }
 | 
				
			||||||
    );
 | 
					    );
 | 
				
			||||||
    $Self->{LogObject}->info( 'build: Sending result is ' . $ResponseResult );
 | 
					    $Self->{LogObject}->info( 'build: Sending result is ' . $ResponseResult );
 | 
				
			||||||
@@ -191,8 +210,8 @@ sub build {
 | 
				
			|||||||
=cut
 | 
					=cut
 | 
				
			||||||
 | 
					
 | 
				
			||||||
sub processMessage {
 | 
					sub processMessage {
 | 
				
			||||||
 | 
					 | 
				
			||||||
    my ( $Self, %Param ) = @_;
 | 
					    my ( $Self, %Param ) = @_;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
    use Data::Dumper;
 | 
					    use Data::Dumper;
 | 
				
			||||||
    use LWP::Simple::REST qw(POST plain json);
 | 
					    use LWP::Simple::REST qw(POST plain json);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
@@ -205,13 +224,15 @@ sub processMessage {
 | 
				
			|||||||
    $Self->{LogObject}
 | 
					    $Self->{LogObject}
 | 
				
			||||||
      ->info( 'processMessage: Message is ' . Dumper( $Param{Message} ) );
 | 
					      ->info( 'processMessage: Message is ' . Dumper( $Param{Message} ) );
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					    my $ResponseData      = {};
 | 
				
			||||||
 | 
					    my $CommandList       = join('|', keys $Self->{CommandList}->%*);
 | 
				
			||||||
 | 
					    my $QueryTriggerList  = join('|', keys $Self->{QueryTrigger}->%*);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
    my $ResponseData = {};
 | 
					    # command branch
 | 
				
			||||||
    my $CommandList  = join('|', keys $Self->{CommandList}->%*);
 | 
					    if ( defined $Param{Message}{message} && $Param{Message}{message}{text} && $Param{Message}{message}{text} =~
 | 
				
			||||||
    if ( defined $Param{Message}->{message} && $Param{Message}->{message}->{text} =~
 | 
					 | 
				
			||||||
        /\/(?<command>$CommandList)\s?(?<arguments>.*)?/ )
 | 
					        /\/(?<command>$CommandList)\s?(?<arguments>.*)?/ )
 | 
				
			||||||
    {
 | 
					    {
 | 
				
			||||||
        my $Message = $Param{Message}->{message};
 | 
					        my $Message = $Param{Message}{message};
 | 
				
			||||||
        my $Command         = $+{command};
 | 
					        my $Command         = $+{command};
 | 
				
			||||||
        my $ArgumentsString = $+{arguments};
 | 
					        my $ArgumentsString = $+{arguments};
 | 
				
			||||||
        $ResponseData = $Self->{CommandList}{$Command}(
 | 
					        $ResponseData = $Self->{CommandList}{$Command}(
 | 
				
			||||||
@@ -223,25 +244,40 @@ sub processMessage {
 | 
				
			|||||||
            return;
 | 
					            return;
 | 
				
			||||||
        }
 | 
					        }
 | 
				
			||||||
    }
 | 
					    }
 | 
				
			||||||
    elsif ( defined $Param{Message}->{callback_query} ) {
 | 
					
 | 
				
			||||||
 | 
					    # query trigger branch
 | 
				
			||||||
 | 
					    elsif ( defined $Param{Message}{message} && $Param{Message}{message}{text} && $Param{Message}{message}{text} =~ /\/(?<trigger>$QueryTriggerList)/ ) {
 | 
				
			||||||
        $Self->build(
 | 
					        $Self->build(
 | 
				
			||||||
            Message => $Param{Message},
 | 
					            Message   => $Param{Message},
 | 
				
			||||||
            QueryStep => $Param{Message}->{callback_query}->{data},
 | 
					            QueryStep => $Param{Message}{callback_query}{data} || '',
 | 
				
			||||||
        );
 | 
					        );
 | 
				
			||||||
    }
 | 
					    }
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					    # 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 {
 | 
					    else {
 | 
				
			||||||
        $Self->{LogObject}
 | 
					        $Self->{LogObject}
 | 
				
			||||||
          ->debug( 'Command not recognized. Data: ' . $Param{Message}->{message}->{text} );
 | 
					          ->debug( 'Command not recognized. Data: ' . $Param{Message}{message}{text} );
 | 
				
			||||||
        if ( $Self->{Whitelist}->{$Param{Message}->{message}->{from}->{id}} eq 'Sarah'
 | 
					        if ( $Self->{Whitelist}{$Param{Message}{message}{from}{id}} eq 'Sarah'
 | 
				
			||||||
            || $Self->{Whitelist}->{$Param{Message}->{message}->{from}->{id}} eq 'Stefan' ) {
 | 
					            || $Self->{Whitelist}{$Param{Message}{message}{from}{id}} eq 'Stefan' ) {
 | 
				
			||||||
            $ResponseData = $Self->replyLoveQuote( Message => $Param{Message}->{message} );
 | 
					            $ResponseData = $Self->replyLoveQuote( Message => $Param{Message}{message} );
 | 
				
			||||||
        }
 | 
					        }
 | 
				
			||||||
        else {
 | 
					        else {
 | 
				
			||||||
            $ResponseData->{text} =
 | 
					            $ResponseData->{text} =
 | 
				
			||||||
              "I'm sorry, "
 | 
					              "I'm sorry, "
 | 
				
			||||||
              . ( $Param{Message}->{message}->{chat}->{first_name}
 | 
					              . ( $Param{Message}{message}{chat}{first_name}
 | 
				
			||||||
                ? $Param{Message}->{message}->{chat}->{first_name}
 | 
					                ? $Param{Message}{message}{chat}{first_name}
 | 
				
			||||||
                : $Param{Message}->{message}->{chat}->{username} )
 | 
					                : $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";
 | 
					              . ", 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";
 | 
				
			||||||
        }
 | 
					        }
 | 
				
			||||||
 | 
					
 | 
				
			||||||
@@ -250,7 +286,7 @@ sub processMessage {
 | 
				
			|||||||
    my $ResponseResult = plain POST(
 | 
					    my $ResponseResult = plain POST(
 | 
				
			||||||
        join( '/', ( $Self->{TelegramURL}, $Self->{Token}, 'sendMessage' ) ),
 | 
					        join( '/', ( $Self->{TelegramURL}, $Self->{Token}, 'sendMessage' ) ),
 | 
				
			||||||
        {
 | 
					        {
 | 
				
			||||||
            chat_id => $Param{Message}->{message}->{chat}->{id},
 | 
					            chat_id => $Param{Message}{message}{chat}{id} || $Param{Message}{callback_query}{message}{chat}{id},
 | 
				
			||||||
            $ResponseData->%*,
 | 
					            $ResponseData->%*,
 | 
				
			||||||
        }
 | 
					        }
 | 
				
			||||||
    );
 | 
					    );
 | 
				
			||||||
@@ -262,7 +298,7 @@ sub processMessage {
 | 
				
			|||||||
    my $SeenResult = plain POST(
 | 
					    my $SeenResult = plain POST(
 | 
				
			||||||
        join( '/', ( $Self->{TelegramURL}, $Self->{Token}, 'readMessageContents' ) ),
 | 
					        join( '/', ( $Self->{TelegramURL}, $Self->{Token}, 'readMessageContents' ) ),
 | 
				
			||||||
        {
 | 
					        {
 | 
				
			||||||
            id => $Param{Message}->{message}->{id},
 | 
					            id => $Param{Message}{message}{id},
 | 
				
			||||||
        }
 | 
					        }
 | 
				
			||||||
    );
 | 
					    );
 | 
				
			||||||
 | 
					
 | 
				
			||||||
@@ -275,7 +311,6 @@ sub processMessage {
 | 
				
			|||||||
=cut
 | 
					=cut
 | 
				
			||||||
 | 
					
 | 
				
			||||||
sub fetchMessages {
 | 
					sub fetchMessages {
 | 
				
			||||||
 | 
					 | 
				
			||||||
    my ( $Self, %Param ) = @_;
 | 
					    my ( $Self, %Param ) = @_;
 | 
				
			||||||
    use Data::Dumper;
 | 
					    use Data::Dumper;
 | 
				
			||||||
    use LWP::Simple::REST qw(GET json);
 | 
					    use LWP::Simple::REST qw(GET json);
 | 
				
			||||||
@@ -293,20 +328,22 @@ sub fetchMessages {
 | 
				
			|||||||
 | 
					
 | 
				
			||||||
    MESSAGE:
 | 
					    MESSAGE:
 | 
				
			||||||
    for my $Message (@Messages) {
 | 
					    for my $Message (@Messages) {
 | 
				
			||||||
        if ( !$Self->{Whitelist}{$Message->{message}{from}{id}} ) {
 | 
					        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}
 | 
					            $Self->{LogObject}
 | 
				
			||||||
              ->info( 'fetchMessages: User not whitelisted, skipping message ' . Dumper($MessageDataRaw) );
 | 
					              ->info( 'fetchMessages: User not whitelisted, skipping message ' . Dumper($MessageDataRaw) );
 | 
				
			||||||
 | 
					
 | 
				
			||||||
            $Self->{MessageIDs}{$Message->{message}{message_id}} = 1;
 | 
					            $Self->{MessageIDs}{$MessageID} = 1;
 | 
				
			||||||
            next MESSAGE;
 | 
					            next MESSAGE;
 | 
				
			||||||
        }
 | 
					        }
 | 
				
			||||||
        if ($Self->{MessageIDs}{$Message->{message}{message_id}}) {
 | 
					        if ($Self->{MessageIDs}{$MessageID}) {
 | 
				
			||||||
            $Self->{LogObject}->info('fetchMessages: Skipping known message_id');
 | 
					            $Self->{LogObject}->info('fetchMessages: Skipping known message_id');
 | 
				
			||||||
            next MESSAGE;
 | 
					            next MESSAGE;
 | 
				
			||||||
        }
 | 
					        }
 | 
				
			||||||
        else {
 | 
					        else {
 | 
				
			||||||
            $Self->{LogObject}->info('fetchMessages: Calling processMessage');
 | 
					            $Self->{LogObject}->info('fetchMessages: Calling processMessage');
 | 
				
			||||||
            $Self->{MessageIDs}{$Message->{message}{message_id}} = 1;
 | 
					            $Self->{MessageIDs}{$MessageID} = 1;
 | 
				
			||||||
            $Self->processMessage( Message => $Message, );
 | 
					            $Self->processMessage( Message => $Message, );
 | 
				
			||||||
        }
 | 
					        }
 | 
				
			||||||
    }
 | 
					    }
 | 
				
			||||||
 
 | 
				
			|||||||
		Reference in New Issue
	
	Block a user