commit - bed1c8b3df1d2b12cf73a38fc42f12bfc165211b
commit + f4d13731461ca8fb7e2f947c3b3ad725ae8ca8fd
blob - a5ab109b20d6015545bf5f6ee1f9c7bdfdfdb7da
blob + 22d9e5882533569882794bf4ac15f21313b5211a
--- mata_bot.pl
+++ mata_bot.pl
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;
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*|
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};
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;
$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 {
my ($sock, $opts, $lists, $subbuffer) = @_;
my $buffer = '';
my $message = '';
my %subbuffer;
while (1) {
+ my $reply;
# buffer up
if ($opts->{'tls'}) {
$chunk = <$sock>;
# 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();
