2023-01-13 23:41:10 +01:00
package L3TDE::Bot ;
use v5 .34 .0 ;
use strict ;
use warnings ;
use Crypt::URandom qw/urandom/ ;
use Moo ;
use Types::Standard qw/Str/ ;
use L3TDE::Bot::IRC ;
use L3TDE::DB ;
use L3TDE::Config ;
2023-01-18 19:07:24 +01:00
use L3TDE::Player ;
use L3TDE::Help ;
2023-01-13 23:41:10 +01:00
with 'L3TDE::Model' ;
has [ qw/id data/ ] = > (
is = > 'rw' ,
required = > 1 ,
) ;
has type = > (
is = > 'ro' ,
required = > 1 ,
) ;
2023-01-18 19:07:24 +01:00
my $ help = L3TDE::Help:: singleton ( ) ;
$ help - > install_help ( join = > 'This command allows to ask the bot to join a group in the server you are using, it may not be implemented for some backends.' ) ;
$ help - > install_help ( help = > 'This command shows help.' ) ;
$ help - > install_help ( help1 = > 'This does not exists.' ) ;
2023-01-13 23:41:10 +01:00
sub table { 'bots' }
sub defaulted_fields { [] }
sub not_defaulted_fields { [ qw/id type/ ] }
sub jsonb_fields { [ qw/data/ ] }
sub find_fields { [ qw/id/ ] }
sub id_fields { [ qw/id/ ] }
sub get_instance {
my $ self = shift ;
2023-01-18 19:07:24 +01:00
{
if ( ! defined $ self - > { instance } ) {
if ( uc ( $ self - > type ) eq 'IRC' ) {
$ self - > { instance } = L3TDE::Bot::IRC - > new ( % { $ self - > data } , parent = > $ self ) ;
next ;
}
die "@{[$self->type]} not implemented." ;
}
}
return $ self - > { instance } ;
}
sub is_registered {
return ! ! shift - > data - > { registered } ;
}
sub mark_registered {
my $ self = shift ;
$ self - > data - > { registered } = 1 ;
$ self - > update ( [ qw/data/ ] ) ;
}
sub process_msg {
my $ self = shift ;
my $ sender_username = shift ;
my $ prefered_reply_to = shift ;
my $ message = shift ;
my $ instance = $ self - > get_instance ;
if ( $ message =~ s/^#(\S+)\s*// && defined $ 1 ) {
my $ command = $ 1 ;
if ( $ command eq 'join' ) {
my ( $ where ) = $ message =~ /^(\S+)/ ;
if ( ! defined $ where ) {
$ instance - > msg ( $ prefered_reply_to , 'You must choose a channel to join.' ) ;
return ;
}
eval {
$ instance - > try_to_join ( $ prefered_reply_to , $ where ) ;
} ;
if ( $@ ) {
$ instance - > msg ( $ prefered_reply_to , $@ ) ;
}
return ;
}
if ( $ command eq 'help' ) {
my ( $ help_search ) = $ message =~ /^(\S+)/ ;
if ( ! defined $ help_search ) {
$ instance - > msg ( $ prefered_reply_to , 'Usage #help <topic>.' ) ;
return ;
}
eval {
$ instance - > msg ( $ prefered_reply_to , $ help - > search_help ( $ help_search ) ) ;
} ;
if ( $@ ) {
$ instance - > msg ( $ prefered_reply_to , $@ ) ;
}
return ;
}
2023-01-13 23:41:10 +01:00
}
}
2023-01-18 19:07:24 +01:00
sub start {
2023-01-13 23:41:10 +01:00
my $ self = shift ;
2023-01-18 19:07:24 +01:00
my $ pid = fork ;
if ( ! $ pid ) {
$ self - > get_instance - > start ;
exit ;
}
return $ pid ;
2023-01-13 23:41:10 +01:00
}
sub create_bots {
my $ class = shift ;
for my $ bot ( $ class - > _get_from_config_bot_hashes - > @ * ) {
eval {
my $ bot = $ class - > create ( %$ bot ) ;
say "Created @{[$bot->id]}." ;
} ;
if ( $@ ) {
# Duplicate keys are expected.
if ( $@ !~ /duplicate key value/ ) {
die $@ ;
}
}
}
}
sub _parse_irc {
my $ class = shift ;
my $ bot = shift ;
my ( $ username , $ hostname , $ port ) = $ bot - > @ { qw/username hostname port/ } ;
$ username // = 'l3tde' ;
$ port // = 6697 ;
return {
id = > "IRC(${username}\@${hostname}/${port})" ,
type = > 'IRC' ,
data = > {
username = > $ username ,
hostname = > $ hostname ,
port = > $ port ,
2023-01-18 19:07:24 +01:00
password = > unpack ( 'H*' , urandom ( 20 ) ) ,
2023-01-13 23:41:10 +01:00
}
} ;
}
sub _get_from_config_bot_hashes {
my $ class = shift ;
my $ config = L3TDE::Config - > new ;
my @ bots ;
for my $ bot ( @ { $ config - > { bots } } ) {
if ( uc ( $ bot - > { type } ) eq 'IRC' ) {
push @ bots , $ class - > _parse_irc ( $ bot ) ;
}
else {
die "The bot type @{[$bot->{type}]} is not implemented." ;
}
}
return \ @ bots ;
}
1 ;