sergiotarxz
/
L3TDE-IRC
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Adding help and join commands.

This commit is contained in:
sergiotarxz 2023-01-18 19:07:24 +01:00
parent 21e918182c
commit b823922b57
8 changed files with 402 additions and 76 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
Build.PL
View File

@ -9,19 +9,19 @@ my $build = Module::Build->new(
dist_author => 'Sergio Iglesias <contact@owlcode.tech>',
dist_abstract => '.',
requires => {
'DBI' => 0,
'DBD::Pg' => 0,
'DBD::Mock' => 0,
'Moo' => 0,
'Types::Standard' => 0,
'JSON' => 0,
'Path::Tiny' => 0,
'List::AllUtils' => 0,
'Test::Most' => 0,
'Test::MockModule' => 0,
'Crypt::URandom' => 0,
'Future::AsyncAwait' => 0,
'IO::Socket::SSL' => 0,
'DBI' => 0,
'DBD::Pg' => 0,
'DBD::Mock' => 0,
'Moo' => 0,
'Types::Standard' => 0,
'JSON' => 0,
'Path::Tiny' => 0,
'List::AllUtils' => 0,
'Test::Most' => 0,
'Test::MockModule' => 0,
'Crypt::URandom' => 0,
'IO::Socket::SSL' => 0,
'Promise::Me' => 0,
},
);
$build->create_build_script;

11
bin/l3tde.pl
View File

@ -6,16 +6,13 @@ use strict;
use warnings;
use L3TDE::Bot;
use Future::AsyncAwait;
L3TDE::Bot->create_bots;
$SIG{CHLD} = 'IGNORE';
for my $bot (@{L3TDE::Bot->find}) {
main($bot);
say 'AAAAAAAAAAAAAAAAAAAAAAAH';
my $pid = $bot->start;
}
async sub main {
my $bot = shift;
return $bot->start;
while ((my $pid = wait) != -1) {
say "Reaped $pid";
}

82
lib/L3TDE/Bot.pm
View File

@ -8,11 +8,12 @@ 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;
use L3TDE::Player;
use L3TDE::Help;
with 'L3TDE::Model';
@ -26,6 +27,11 @@ has type => (
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/] }
@ -35,16 +41,75 @@ sub id_fields { [qw/id/] }
sub get_instance {
my $self = shift;
if ( uc( $self->type ) eq 'IRC' ) {
return L3TDE::Bot::IRC->new( %{ $self->data } );
{
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.";
}
}
die "@{[$self->type]} not implemented.";
return $self->{instance};
}
async sub start {
sub is_registered {
return !!shift->data->{registered};
}
sub mark_registered {
my $self = shift;
my $start_result = await $self->get_instance->start;
return $start_result;
$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 {
@ -55,7 +120,6 @@ sub create_bots {
say "Created @{[$bot->id]}.";
};
if ($@) {
# Duplicate keys are expected.
if ( $@ !~ /duplicate key value/ ) {
die $@;
@ -77,7 +141,7 @@ sub _parse_irc {
username => $username,
hostname => $hostname,
port => $port,
password => unpack( 'H*', urandom(60) ),
password => unpack( 'H*', urandom(20) ),
}
};
}

204
lib/L3TDE/Bot/IRC.pm
View File

@ -7,74 +7,212 @@ use warnings;
use Moo;
use Future::AsyncAwait;
use IO::Socket::SSL;
use Crypt::URandom qw/urandom/;
use List::AllUtils qw/none any/;
with 'L3TDE::Bot::Role';
has [qw/password username hostname port/] => (
is => 'rw',
has [qw/password username hostname port parent/] => (
is => 'rw',
required => 1,
);
has socket => (
is => 'rw',
);
# 221 stands for mode.
has once_221_login => ( is => 'rw' );
has socket => ( is => 'rw', );
# Not lazy because we may do it more than once.
async sub _generate_socket {
my $self = shift;
my $username = $self->username;
my $hostname = $self->hostname;
my $password = $self->password;
my $port = $self->port;
my $random_nick = unpack('H*', urandom(10));
my $return = IO::Socket::SSL->new(
sub _generate_socket {
my $self = shift;
my $username = $self->username;
my $hostname = $self->hostname;
my $password = $self->password;
my $port = $self->port;
my $random_nick = unpack( 'H*', urandom(10) );
my $return = IO::Socket::SSL->new(
PeerHost => $hostname,
PeerPort => $port,
Proto => 'tcp',
Timeout => 5
) or die $!;
$self->socket($return);
$self->_send_message("USER $username 0 * :L3TDE Bot\r\n");
$self->_send_message("NICK ${username}_${random_nick}\r\n");
$self->_print_socket("USER $username 0 * :L3TDE Bot");
if ( $self->parent->is_registered ) {
$self->_print_socket("NICK ${username}_${random_nick}");
}
else {
$self->_print_socket("NICK ${username}");
}
return $self;
}
sub _send_message {
my $self = shift;
sub _print_socket {
my $self = shift;
my $message = shift;
my $socket = $self->socket;
my $socket = $self->socket;
$message =~ s/\s+$//;
say "SENT ($message)";
print $socket "$message\r\n";
}
async sub start {
sub _try_reply_ping {
my $self = shift;
my $line = shift;
if ( $line =~ /^PING (.+?)\s+$/ ) {
$self->_print_socket("PONG $1");
return 1;
}
return 0;
}
sub _try_reply_user_interaction {
my $self = shift;
my $line = shift;
if ( ( my $params_line = $line =~ s/^:(\S+?)(?:!\S+)?@(?:\S+) (\w+)\s+//r )
&& $1 )
{
my $sender_username = $1;
my $command = $2;
say "Received interaction ($sender_username -> $command)";
if ( $command eq 'PRIVMSG' ) {
my ( $dest, $message ) = $params_line =~ /^(\S+) :(.*?)\s+$/;
my $prefered_reply_to = $sender_username;
if ( $dest =~ /^#/ ) {
$prefered_reply_to = $dest;
}
$self->parent->process_msg( $sender_username,
$prefered_reply_to, $message );
}
return 1;
}
return 0;
}
sub _try_reply_server_action {
my $self = shift;
my $line = shift;
if ( my ( $server, $protocol_message ) = $line =~ /^:(\S+) (\d+)/ ) {
# We silence the annoying motd.
if ( $protocol_message == 221 ) {
if ( !$self->once_221_login ) {
$self->once_221_login(1);
if ( $self->parent->is_registered ) {
$self->login;
}
else {
$self->register;
}
$self->_join_saved_channels;
}
}
return 1;
}
return 0;
}
sub start {
my $self = shift;
$self->once_221_login(0);
while (1) {
eval {
await $self->_generate_socket;
#while(defined(my $line = $self->_read)) {
# # print $line;
# $self->username('aaaaaaah');
#}
$self->_generate_socket;
while ( defined( my $line = $self->_read ) ) {
{
next if !$self->once_221_login;
print $line;
}
!$self->_try_reply_ping($line)
&& !$self->_try_reply_user_interaction($line)
&& $self->_try_reply_server_action($line);
}
};
if ($@) {
warn($@);
die($@);
}
}
return;
return 1;
}
sub login {
my $self = shift;
$self->msg(
NickServ => "identify @{[$self->username]} @{[$self->password]}" );
}
sub register {
my $self = shift;
$self->msg(
NickServ => "register @{[$self->password]} @{[$self->password]}" );
$self->parent->mark_registered;
}
sub _read {
my $self = shift;
$/ = "\r\n";
local $/ = "\r\n";
my $socket = $self->socket;
my $line = <$socket>;
$/ = "\n";
return <$socket>;
my $line = <$socket>;
return $line;
}
async sub msg {
...
sub try_to_join {
my $self = shift;
my $class = $self->get_class;
my $prefered_reply_to = shift;
my $channel = shift;
my $parent = $self->parent;
$parent->data->{channels} //= [];
my $channels = $parent->data->{channels};
if ( none { $_ eq $channel } @$channels ) {
$self->_join_channel($channel);
push @{ $parent->data->{channels} }, $channel;
$parent->update( [qw/data/] );
$self->msg( $prefered_reply_to, "Succesfully joined $channel" );
}
else {
die "I am already in $channel.";
}
}
sub _join_saved_channels {
my $self = shift;
my $parent = $self->parent;
my $channels = $parent->data->{channels};
return if !defined $channels;
for my $channel (@$channels) {
eval { $self->_join_channel($channel); };
if ($@) {
say STDERR $@;
}
}
}
sub _join_channel {
my $self = shift;
my $channel = shift // die("Channel not defined");
die "$channel should start by #." if $channel !~ /^#/;
$self->_print_socket("JOIN $channel");
}
sub get_class {
my $self = shift;
return $self if !ref $self;
return ref $self;
}
sub msg {
my $self = shift;
my $username = shift;
my $message = shift;
warn "Bad username $username", return if $username =~ /\s+|:/;
$self->_print_socket("PRIVMSG $username :$message");
}
1;

1
lib/L3TDE/Bot/Role.pm
View File

@ -9,4 +9,5 @@ use Moo::Role;
requires 'msg';
requires 'start';
requires 'try_to_join';
1;

59
lib/L3TDE/Help.pm Normal file
View File

@ -0,0 +1,59 @@
package L3TDE::Help;
use v5.34.1;
use strict;
use warnings;
use List::AllUtils qw/one/;
use Moo;
has _help => (
is => 'rw',
);
# We have to be sure every file which installs help gets loaded.
require L3TDE::Player;
require L3TDE::Bot;
my $single_instance;
sub singleton {
if (!$single_instance) {
$single_instance = __PACKAGE__->new;
}
return $single_instance;
}
sub BUILD {
my $self = shift;
$self->_help({});
}
sub search_help {
my $self = shift;
my $search_string = shift;
my $help_text = $self->_help->{$search_string};
if (defined $help_text) {
return $help_text;
}
my @matches = map { index($_, $search_string) != -1 ? ($_) : () } keys %{$self->_help};
if (!@matches) {
die "No match.";
}
if (@matches > 1) {
die "More than a match " . (join ', ', @matches);
}
return $self->_help->{$matches[0]};
}
sub install_help {
my $self = shift;
my ($key, $help_text) = @_;
if (defined $self->_help->{$key}) {
warn "Overwriting key $key. ¡This is an error!";
}
$self->_help->{$key} = $help_text;
}
1;

28
lib/L3TDE/Model.pm
View File

@ -29,7 +29,7 @@ sub _dbh {
}
sub create {
my $class = shift->_get_class;
my $class = shift->get_class;
my $dbh = $class->_dbh;
my %params = @_;
my $not_defaulted_fields = $class->not_defaulted_fields;
@ -72,14 +72,14 @@ sub create {
}
sub _generate_returning {
my $class = shift->_get_class;
my $class = shift->get_class;
my $returning = "RETURNING ";
$returning .= $class->_to_select_fields;
return $returning;
}
sub _to_select_fields {
my $class = shift->_get_class;
my $class = shift->get_class;
my $not_defaulted_fields = $class->not_defaulted_fields;
my $jsonb_fields = $class->jsonb_fields;
my $defaulted_fields = $class->defaulted_fields;
@ -90,7 +90,7 @@ sub _to_select_fields {
}
sub _is_field_to_update {
my $class = shift->_get_class;
my $class = shift->get_class;
my $field = shift;
my $jsonb_fields = $class->jsonb_fields;
my $not_defaulted_fields = $class->not_defaulted_fields;
@ -110,9 +110,9 @@ sub update {
my $id_fields = $self->id_fields;
for my $field_to_update (@$fields_to_update) {
die "$field_to_update does not exists in @{[$self->_get_class]}"
die "$field_to_update does not exists in @{[$self->get_class]}"
if !$self->_is_field_to_update($field_to_update);
die "$field_to_update is not a method in @{[$self->_get_class]}"
die "$field_to_update is not a method in @{[$self->get_class]}"
if !$self->can($field_to_update);
}
my $query = "UPDATE $table SET ";
@ -128,12 +128,12 @@ sub update {
$query .= $self->_generate_returning;
$query .= ";";
my $result = $dbh->selectrow_hashref( $query, {},
( map { $self->$_ } ( @$fields_to_update, @$id_fields ) ) );
( map { my $return = $self->$_; $return = encode_json($return) if $self->_is_jsonb($_); $return; } ( @$fields_to_update, @$id_fields ) ) );
return $self->_result_to_object($result);
}
sub _is_jsonb {
my $class = shift->_get_class;
my $class = shift->get_class;
my $key = shift;
my $jsonb_fields = $class->jsonb_fields;
return any { $key eq $_ } @$jsonb_fields;
@ -141,7 +141,7 @@ sub _is_jsonb {
sub _result_to_object {
my $self = shift;
my $class = $self->_get_class;
my $class = $self->get_class;
my $result = shift;
for my $key ( keys %$result ) {
$result->{$key} = decode_json $result->{$key} if $self->_is_jsonb($key);
@ -149,14 +149,14 @@ sub _result_to_object {
return $class->new(%$result);
}
sub _get_class {
sub get_class {
my $self = shift;
return $self if !ref $self;
return ref $self;
}
sub _validate_find_fields {
my $class = shift->_get_class;
my $class = shift->get_class;
my $fields_to_search = shift;
my $find_fields = $class->find_fields;
for my $field_to_search (@$fields_to_search) {
@ -169,7 +169,7 @@ sub _validate_find_fields {
}
sub _generate_select {
my $class = shift->_get_class;
my $class = shift->get_class;
my $fields_to_search = shift;
my $table = $class->table;
my $query = "SELECT @{[$class->_to_select_fields]} FROM $table";
@ -181,7 +181,7 @@ sub _generate_select {
}
sub find_one {
my $class = shift->_get_class;
my $class = shift->get_class;
my %params = @_;
my $dbh = $class->_dbh;
my @fields_to_search = sort { $a cmp $b } keys %params;
@ -194,7 +194,7 @@ sub find_one {
}
sub find {
my $class = shift->_get_class;
my $class = shift->get_class;
my %params = @_;
my $page = delete $params{page} // 0;
my $dbh = $class->_dbh;

67
lib/L3TDE/Player.pm Normal file
View File

@ -0,0 +1,67 @@
package L3TDE::Player;
use v5.34.1;
use strict;
use warnings;
use Moo;
use L3TDE::Help;
with 'L3TDE::Model';
# TODO: Help texts installation.
my %RACES = (
aldimor => {
base => {
body => 1,
magic => 5,
strength => 3,
quickness => 2,
wisdom => 4,
intelligence => 4,
charisma => 4,
attack => 2,
luck => 0
},
extra => { magic => 3, wisdom => 3 },
help =>
'The aldimors are the race of the magic, they are sightly greenish and love the nature. Damaging a tree is a crime punished with death for them.',
}
);
for my $key ( keys %RACES ) {
my $sum_base = 0;
my $sum_extra = 0;
my $base = $RACES{$key}{base};
my $extra = $RACES{$key}{extra};
for my $key ( keys %$base ) {
$sum_base += $base->{$key};
}
for my $key ( keys %$extra ) {
$sum_extra += $extra->{$key};
}
warn("$key base is unbalanced") if $sum_base != 25;
warn("$key extra is unbalanced") if $sum_extra != 6;
my $help = L3TDE::Help::singleton();
$help->install_help( $key, $RACES{$key}{help} );
}
sub table { 'players' }
sub not_defaulted_fields { [qw/username bot_id party_uuid/] }
sub defaulted_fields { [qw/uuid/] }
sub jsonb_fields { [qw/data/] }
sub find_fields { [qw/uuid username bot_id party_uuid/] }
sub id_fields { [qw/uuid/] }
has [qw/uuid username bot_id party_uuid data/] => ( is => 'rw' );
sub bot {
my $self = shift;
if ( !exists $self->{bot} ) {
require L3TDE::Bot;
$self->{bot} = L3TDE::Bot->find_one( id => $self->bot_id );
}
return $self->{bot};
}
1;