L3TDE-IRC/lib/L3TDE/Bot/IRC.pm

package L3TDE::Bot::IRC;

use v5.34.1;

use strict;
use warnings;

use Moo;

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 parent/] => (
    is       => 'rw',
    required => 1,
);

# 221 stands for mode.
has once_221_login => ( is => 'rw' );

has socket => ( is => 'rw', );

# Not lazy because we may do it more than once.
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->_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 _print_socket {
    my $self    = shift;
    my $message = shift;
    my $socket  = $self->socket;
    $message =~ s/\s+$//;
    say "SENT ($message)";
    print $socket "$message\r\n";
}

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 {
            $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 ($@) {
            die($@);
        }
    }
    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;
    local $/ = "\r\n";
    my $socket = $self->socket;
    my $line   = <$socket>;
    return $line;
}

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;