commit f4d13731461ca8fb7e2f947c3b3ad725ae8ca8fd
parent bed1c8b3df1d2b12cf73a38fc42f12bfc165211b
Author: noodle <noodle@pastanoggin.com>
Date: Sun, 22 Jun 2025 21:08:54 +0300
remove i/o side effects from most subroutines
subroutine msg was deleted too as it was used only once after the
purification. now only logger, out, evasdrop and the toplevel main
code is impure. i might try to optimize them further later. for now,
we'll be implementing reconnection as i/o has been minimized
Diffstat:
| M | mata_bot.pl | | | 220 | ++++++++++++++++++++++++++++++++++++++++--------------------------------------- |
1 file changed, 111 insertions(+), 109 deletions(-)
diff --git a/mata_bot.pl b/mata_bot.pl
@@ -29,75 +29,16 @@ my $NICK_RE = qr/mata_?bo[ity]+/i;
my $REAL = 'death to technomage!!';
my $USER = 'mata_bot_beta4';
-sub init {
- my $ball_path = $DEFAULT_PATH_BALL;
- my $chan = $DEFAULT_CHAN;
- my $hellos_path = $DEFAULT_PATH_HELLOS;
- my $host = $DEFAULT_HOST;
- my $logging = $DEFAULT_LOGGING;
- my $port = $DEFAULT_PORT;
- my $quotes_path = $DEFAULT_PATH_QUOTES;
- my $tls = $DEFAULT_TLS;
-
- getopts('tlH:b:h:j:p:q:', \my %flags);
- $ball_path = $flags{'b'} if $flags{'b'};
- $chan = "#$flags{'j'}" if $flags{'j'};
- $hellos_path = $flags{'H'} if $flags{'H'};
- $host = $flags{'h'} if $flags{'h'};
- $logging = 1 if $flags{'l'};
- $port = $flags{'p'} if $flags{'p'};
- $quotes_path = $flags{'q'} if $flags{'q'};
- $tls = 1 if $flags{'t'};
-
- open (my $ball_file, "<", $ball_path) or die "couldn't open ${ball_path}: $!";
- chomp(my @ball = <$ball_file>);
- close $ball_file or die "$ball_file: $!";
- open (my $hellos_file, "<", $hellos_path) or die "couldn't open ${hellos_path}: $!";
- chomp(my @hellos = <$hellos_file>);
- close $hellos_file or die "$hellos_file: $!";
- open (my $quotes_file, "<", $quotes_path) or die "couldn't open ${quotes_path}: $!";
- chomp(my @quotes = <$quotes_file>);
- close $quotes_file or die "$quotes_file: $!";
-
- return {
- 'chan' => $chan,
- 'host' => $host,
- 'logging' => $logging,
- 'port' => $port,
- 'tls' => $tls,
- },
- {
- 'ball' => \@ball,
- 'hellos' => \@hellos,
- 'quotes' => \@quotes,
- };
-}
-
sub randint {
my($min, $max) = @_;
return $min if $min == $max;
- ($min, $max) = ($max, $min) if $min > $max;
+ ($min, $max) = ($max, $min) if $min > $max;
return $min + int rand(1 + $max - $min);
}
-sub logger {
- my $logmessage = shift;
- print strftime('%Y-%m-%dT%H:%M:%SZ ', gmtime()), $logmessage, "\n";
-}
-
-sub out {
- my ($sock, $logging, $message) = @_;
- logger($message) if $logging;
- print $sock "$message\r\n";
-}
-
-sub msg {
- my ($sock, $logging, $chan, $message) = @_;
- out($sock, $logging, "PRIVMSG ${chan} :${message}");
-}
-
sub respond_command {
- my ($sock, $logging, $chan, $ball, $hellos, $sender_nick, $content) = @_;
+ my ($ball, $hellos, $sender_nick, $content) = @_;
+ my $reply;
if ($content =~ /\b{wb}([1-9]\d*)?d([1-9]\d*)\b{wb}/) {
# we got dice
my $ndice = $1 // 1;
@@ -107,37 +48,37 @@ sub respond_command {
my $result = $min + int rand(1 + $max - $min);
my $roll = "d${nface}";
$roll = $ndice . $roll if $ndice > 1;
- msg($sock, $logging, $chan, "${sender_nick} rolled a ${roll} and got ${result}! ${MATA_HAPPY}");
+ $reply = "${sender_nick} rolled a ${roll} and got ${result}! ${MATA_HAPPY}";
} elsif ($content =~ /\b{wb}pray+\b{wb}/) {
- msg($sock, $logging, $chan, "Stay prayed up!! ${MATA_CUTE}");
+ $reply = "Stay prayed up!! ${MATA_CUTE}";
} elsif ($content =~ /\b{wb}bru[hv]+\b{wb}/i) {
- msg($sock, $logging, $chan, "Did i stutter? ${MATA_NORM}");
+ $reply = "Did i stutter? ${MATA_NORM}";
} elsif ($content =~ /\b{wb}f+(u?ck+)? *(yo)?u+\b{wb}/i) {
- msg($sock, $logging, $chan, "$MATA_FLIPOFF");
+ $reply = "$MATA_FLIPOFF"
} elsif ($content =~ /\b{wb}i+ *l+(ove+)? *(you+|y+|u+)\b{wb}/i) {
- msg($sock, $logging, $chan, "<3 ${MATA_HAPPY}");
+ $reply = "<3 ${MATA_HAPPY}"
} elsif ($content =~ /(thanks+|thx+|thank +(yo)?u+)( *a+ *lot+)?/i) {
- msg($sock, $logging, $chan, "You're welcome, ${sender_nick}! ${MATA_HAPPY}");
+ $reply = "You're welcome, ${sender_nick}! ${MATA_HAPPY}"
} elsif ($content =~ /who('| +i|)s+ +(a|the)+ +goo+d+ +(bo+[ity]+o*|gir(l+|lie+))/i) {
- msg($sock, $logging, $chan, "Me! ${MATA_CUTE}");
+ $reply = "Me! ${MATA_CUTE}"
} elsif ($content =~ /
h(ow+)?\s*(are+|r+)\s*(you+|yo+|u+)(\s+doing+)?(\s+today+)?|
how('|\si|)s+\s+(it+\s+going+|life+|everything+)
/ix) {
- msg($sock, $logging, $chan, "I feel fantaaaastic... hey, hey, hey! ${MATA_SING}");
+ $reply = "I feel fantaaaastic... hey, hey, hey! ${MATA_SING}"
} elsif ($content =~ /\b{wb}(
what('|\si|)s+\s*(up+|happening+|cracking+)|
(was)?sup+
)\b{wb}/ix) {
- msg($sock, $logging, $chan, "Looking for technomage, and you? ${MATA_NORM}");
+ $reply = "Looking for technomage, and you? ${MATA_NORM}"
} elsif ($content =~ /\b{wb}(
goo+d+\s*(bo+[ity]+o*|gir(l+|lie+))|
w(elcome+)?\s*(b+|back+)
)\b{wb}/ix) {
if ($sender_nick eq $MOTHER) {
- msg($sock, $logging, $chan, "Thank you, mother! ${MATA_HAPPY}");
+ $reply = "Thank you, mother! ${MATA_HAPPY}"
} else {
- msg($sock, $logging, $chan, "Thanks, ${sender_nick}! ${MATA_HAPPY}");
+ $reply = "Thanks, ${sender_nick}! ${MATA_HAPPY}"
}
} elsif ($content =~ /\b{wb}(
(al+-?)?sala+m+u*\s+alaikum+u*|
@@ -152,32 +93,35 @@ sub respond_command {
well+\s+met+|
yo+
)\b{wb}/ix) {
- msg($sock, $logging, $chan, "$hellos->[rand @$hellos], ${sender_nick}! ${MATA_HAPPY}");
+ $reply = "$hellos->[rand @$hellos], ${sender_nick}! ${MATA_HAPPY}"
} elsif ($content =~ /\?$/) {
# we got a question
- msg($sock, $logging, $chan, "$ball->[rand @$ball] ${MATA_CUTE}");
+ $reply = "$ball->[rand @$ball] ${MATA_CUTE}"
} elsif ($sender_nick eq $MOTHER) {
- msg($sock, $logging, $chan, "Done, mother! ${MATA_HAPPY}");
+ $reply = "Done, mother! ${MATA_HAPPY}"
} else {
- msg($sock, $logging, $chan, "\1ACTION leans over and places it's hand near it's antenna. \"HUUH?\" ${MATA_NORM}\1");
+ $reply = " ${MATA_NORM}\1"
}
+ return $reply;
}
sub respond_mention {
- my ($sock, $logging, $chan, $quotes, $sender_nick, $message) = @_;
+ my ($quotes, $sender_nick, $message) = @_;
+ my $reply;
if ($sender_nick eq $MOTHER) {
- msg($sock, $logging, $chan, "Yes, mother? ${MATA_HAPPY}");
+ $reply = "Yes, mother? ${MATA_HAPPY}";
} elsif ($message =~ /^\b${NICK_RE}\b$/) {
- msg($sock, $logging, $chan, "${MATA_NORM} ?");
+ $reply = "${MATA_NORM} ?";
} else {
- msg($sock, $logging, $chan, "$quotes->[rand @$quotes] ${MATA_NORM}");
+ $reply = "$quotes->[rand @$quotes] ${MATA_NORM}";
}
+ return $reply;
}
# respond to channel
-# returns 1 if bot shouldn't remember last message for s///, 0 otherwise
sub respond {
- my ($sock, $logging, $chan, $lists, $subbuffer, $sender_nick, $message) = @_;
+ my ($lists, $subbuffer, $sender_nick, $message) = @_;
+ my $reply;
if ($subbuffer->{$sender_nick} && $message =~ m,\b{wb}s/([^/]+)/([^/]*)(?:/([gi]*))?,) {
# chat s///
my $prev_message = $subbuffer->{$sender_nick};
@@ -189,7 +133,7 @@ sub respond {
eval {
$regex = qr/(?$imod:$retext)/
};
- return $prev_message if $@;
+ return $prev_message, '' if $@;
my $ismatch;
if ($mods =~ /g/) {
$ismatch = $prev_message =~ s/$regex/$repl/g;
@@ -197,75 +141,86 @@ sub respond {
$ismatch = $prev_message =~ s/$regex/$repl/;
}
if ($ismatch) {
- msg($sock, $logging, $chan, "${sender_nick} meant to say: ${prev_message}");
+ $reply = "${sender_nick} meant to say: ${prev_message}"
}
- return $prev_message;
+ return $prev_message, $reply;
} elsif ($message =~ m,watch\?v=([a-zA-Z0-9_-]+),) {
# post youtube video titles from video ID
my $video_id = $1;
my $response = HTTP::Tiny->new->get("https://fuyt.lab8.cz/?s=${video_id}&o=relevance");
unless ($response->{success}) {
- msg($sock, $logging, $chan, "failed to get title of video ${video_id} ${MATA_DEAD} ($response->{status} $response->{reason}!)");
- return $message;
+ $reply = "failed to get title of video ${video_id} ${MATA_DEAD} ($response->{status} $response->{reason}!)";
+ return $message, $reply;
}
unless (length $response->{content}) {
- msg($sock, $logging, $chan, "failed to get title of youtube video ${video_id} ${MATA_DEAD} (HTTP response empty!)");
- return $message;
+ $reply = "failed to get title of youtube video ${video_id} ${MATA_DEAD} (HTTP response empty!)";
+ return $message, $reply;
}
my $content = $response->{content};
if ($content =~ m,<span class="title"><a href="https://www\.youtube\.com/watch\?v=$video_id" accesskey="0">([^<]+)</a>,i) {
my $title = $1;
$title =~ tr/[\000\r\n]//d;
$title = trim($title);
- msg($sock, $logging, $chan, "YouTube: $title");
+ $reply = "YouTube: $title";
} else {
- msg($sock, $logging, $chan, "failed to get title of video ${video_id} ${MATA_DEAD} (no videos matching ID $video_id!)");
+ $reply = "failed to get title of video ${video_id} ${MATA_DEAD} (no videos matching ID $video_id!)";
}
} elsif ($message =~ m,https?://[^ ]+,) {
my $url = $&;
# get in it's HEAD to check if it's text/html
my $response = HTTP::Tiny->new->head($url);
unless ($response->{success}) {
- msg($sock, $logging, $chan, "$response->{status} $response->{reason} (HEAD ${url}) ${MATA_DEAD}");
- return $message;
+ $reply = "$response->{status} $response->{reason} (HEAD ${url}) ${MATA_DEAD}";
+ return $message, $reply;
}
unless ($response->{headers}->{'content-type'}) {
- msg($sock, $logging, $chan, "no content-type header in HTTP response (HEAD ${url}) ${MATA_DEAD}");
- return $message;
+ $reply = "no content-type header in HTTP response (HEAD ${url}) ${MATA_DEAD}";
+ return $message, $reply;
}
unless ($response->{headers}->{'content-type'} =~ m,text/html,) {
# we got a non text/html content type
- msg($sock, $logging, $chan, "File: $response->{headers}->{'content-type'}");
- return $message;
+ $reply = "File: $response->{headers}->{'content-type'}";
+ return $message, $reply;
}
# if it's text/html, GET it's title
$response = HTTP::Tiny->new->get($url);
unless ($response->{success}) {
- msg($sock, $logging, $chan, "$response->{status} $response->{reason} (GET ${url}) ${MATA_DEAD}");
- return $message;
+ $reply = "$response->{status} $response->{reason} (GET ${url}) ${MATA_DEAD}";
+ return $message, $reply;
}
unless (length $response->{content}) {
- msg($sock, $logging, $chan, "Empty HTTP response (GET ${url}) ${MATA_DEAD}");
- return $message;
+ $reply = "Empty HTTP response (GET ${url}) ${MATA_DEAD}";
+ return $message, $reply;
}
my $content = $response->{content};
if ($content =~ m,<title[^>]*>([^<]+)</title[^>]*>,i) {
my $title = $1;
$title =~ tr/[\000\r\n]//d;
$title = trim($title);
- msg($sock, $logging, $chan, "Title: $title");
+ $reply = "Title: $title";
} else {
- msg($sock, $logging, $chan, "No title found (GET ${url} ${MATA_DEAD}");
+ $reply = "No title found (GET ${url} ${MATA_DEAD}";
}
# TODO: this part should use [^ ] and .* instead but i'm scared of .*
} elsif ($message =~ /^ *${NICK_RE}[:, ] *([^\000\r\n ][^\000\r\n]*)$/
or $message =~ /^ *([^\000\r\n ][^\000\r\n]*)[, ] *${NICK_RE}\W*$/) {
- respond_command($sock, $logging, $chan, $lists->{'ball'}, $lists->{'hellos'}, $sender_nick, $1);
+ $reply = respond_command($lists->{'ball'}, $lists->{'hellos'}, $sender_nick, $1);
} elsif ($message =~ /\b${NICK_RE}\b/) {
- respond_mention($sock, $logging, $chan, $lists->{'quotes'}, $sender_nick, $message);
+ $reply = respond_mention($lists->{'quotes'}, $sender_nick, $message);
}
- return $message;
+ return $message, $reply;
+}
+
+sub logger {
+ my $logmessage = shift;
+ print strftime('%Y-%m-%dT%H:%M:%SZ ', gmtime()), $logmessage, "\n";
+}
+
+sub out {
+ my ($sock, $logging, $message) = @_;
+ logger($message) if $logging;
+ print $sock "$message\r\n";
}
sub evasdrop {
@@ -275,6 +230,7 @@ sub evasdrop {
my $message = '';
my %subbuffer;
while (1) {
+ my $reply;
# buffer up
if ($opts->{'tls'}) {
$chunk = <$sock>;
@@ -306,16 +262,62 @@ sub evasdrop {
# respond to message
if ($message =~ /^PING :([^\000\r\n\ ]+)$/) {
# if we got a ping, pong back
- out($sock, $opts->{'logging'}, "PONG :$1");
+ $reply = "PONG :$1";
} elsif ($message =~ /^:([^\000\r\n\#\&\ ][^\000\r\n\ ]*)![^\000\r\n\ ]+@[^\000\r\n\ ]+ PRIVMSG $opts->{'chan'} :([^\000\r\n]*)$/) {
# if we got a message to our chan. read and act accordingly
my $sender_nick = $1;
my $sender_message = $2;
- $subbuffer->{$sender_nick} = respond($sock, $opts->{'logging'}, $opts->{'chan'}, $lists, $subbuffer, $sender_nick, $sender_message);
+ ($subbuffer->{$sender_nick}, $reply) = respond($lists, $subbuffer, $sender_nick, $sender_message);
+ next if not $reply;
+ $reply = "PRIVMSG $opts->{'chan'} :" . $reply;
}
+ out($sock, $opts->{'logging'}, $reply);
}
}
+sub init {
+ my $ball_path = $DEFAULT_PATH_BALL;
+ my $chan = $DEFAULT_CHAN;
+ my $hellos_path = $DEFAULT_PATH_HELLOS;
+ my $host = $DEFAULT_HOST;
+ my $logging = $DEFAULT_LOGGING;
+ my $port = $DEFAULT_PORT;
+ my $quotes_path = $DEFAULT_PATH_QUOTES;
+ my $tls = $DEFAULT_TLS;
+
+ getopts('tlH:b:h:j:p:q:', \my %flags);
+ $ball_path = $flags{'b'} if $flags{'b'};
+ $chan = "#$flags{'j'}" if $flags{'j'};
+ $hellos_path = $flags{'H'} if $flags{'H'};
+ $host = $flags{'h'} if $flags{'h'};
+ $logging = 1 if $flags{'l'};
+ $port = $flags{'p'} if $flags{'p'};
+ $quotes_path = $flags{'q'} if $flags{'q'};
+ $tls = 1 if $flags{'t'};
+ open (my $ball_file, "<", $ball_path) or die "couldn't open ${ball_path}: $!";
+ chomp(my @ball = <$ball_file>);
+ close $ball_file or die "$ball_file: $!";
+ open (my $hellos_file, "<", $hellos_path) or die "couldn't open ${hellos_path}: $!";
+ chomp(my @hellos = <$hellos_file>);
+ close $hellos_file or die "$hellos_file: $!";
+ open (my $quotes_file, "<", $quotes_path) or die "couldn't open ${quotes_path}: $!";
+ chomp(my @quotes = <$quotes_file>);
+ close $quotes_file or die "$quotes_file: $!";
+
+ return {
+ 'chan' => $chan,
+ 'host' => $host,
+ 'logging' => $logging,
+ 'port' => $port,
+ 'tls' => $tls,
+ },
+ {
+ 'ball' => \@ball,
+ 'hellos' => \@hellos,
+ 'quotes' => \@quotes,
+ };
+}
+
while (1) {
# start the connection
my ($opts, $lists) = init();
