100 lines
2.1 KiB
Perl
100 lines
2.1 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 Future::AsyncAwait;
|
|
use L3TDE::Bot::IRC;
|
|
|
|
use L3TDE::DB;
|
|
use L3TDE::Config;
|
|
|
|
with 'L3TDE::Model';
|
|
|
|
has [qw/id data/] => (
|
|
is => 'rw',
|
|
required => 1,
|
|
);
|
|
|
|
has type => (
|
|
is => 'ro',
|
|
required => 1,
|
|
);
|
|
|
|
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 ( uc( $self->type ) eq 'IRC' ) {
|
|
return L3TDE::Bot::IRC->new( %{ $self->data } );
|
|
}
|
|
die "@{[$self->type]} not implemented.";
|
|
}
|
|
|
|
async sub start {
|
|
my $self = shift;
|
|
my $start_result = await $self->get_instance->start;
|
|
return $start_result;
|
|
}
|
|
|
|
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(60) ),
|
|
}
|
|
};
|
|
}
|
|
|
|
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;
|