164 lines
4.0 KiB
Perl
164 lines
4.0 KiB
Perl
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;
|
|
use L3TDE::Player;
|
|
use L3TDE::Help;
|
|
|
|
with 'L3TDE::Model';
|
|
|
|
has [qw/id data/] => (
|
|
is => 'rw',
|
|
required => 1,
|
|
);
|
|
|
|
has type => (
|
|
is => 'ro',
|
|
required => 1,
|
|
);
|
|
|
|
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.');
|
|
|
|
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;
|
|
{
|
|
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;
|
|
}
|
|
}
|
|
}
|
|
|
|
sub start {
|
|
my $self = shift;
|
|
my $pid = fork;
|
|
if (!$pid) {
|
|
$self->get_instance->start;
|
|
exit;
|
|
}
|
|
return $pid;
|
|
}
|
|
|
|
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,
|
|
password => unpack( 'H*', urandom(20) ),
|
|
}
|
|
};
|
|
}
|
|
|
|
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;
|