commit - 05d86fdaa37573e395f40904af86c8516c40456d
commit + bed1c8b3df1d2b12cf73a38fc42f12bfc165211b
blob - e819a0ded1e90fb5ae20af101db12f0fce7920b3
blob + a5ab109b20d6015545bf5f6ee1f9c7bdfdfdb7da
--- mata_bot.pl
+++ mata_bot.pl
my $SHAREDIR = '/usr/local/share';
my $CHUNK_LENGTH = 1024;
+my $DEFAULT_CHAN = '#testmatabot';
+my $DEFAULT_HOST = 'localhost';
+my $DEFAULT_LOGGING = 0;
+my $DEFAULT_PATH_BALL = "$SHAREDIR/matabot/ball";
+my $DEFAULT_PATH_HELLOS = "$SHAREDIR/matabot/hellos";
+my $DEFAULT_PATH_QUOTES = "$SHAREDIR/matabot/quotes";
+my $DEFAULT_PORT = 6667;
+my $DEFAULT_TLS = 0;
+my $MATA_CUTE = '[>.<]';
+my $MATA_DEAD = '[x~x]';
+my $MATA_FLIPOFF = 't[-_-t]';
+my $MATA_HAPPY = '[^_^]';
+my $MATA_NORM = '[._.]';
+my $MATA_SING = '[^=^]';
+my $MOTHER = 'noodle';
my $NICK = 'mata_bot';
my $NICK_RE = qr/mata_?bo[ity]+/i;
-my $USER = 'mata_bot_beta4';
my $REAL = 'death to technomage!!';
-my $MOTHER = 'noodle';
-my $MATA_NORM = '[._.]';
-my $MATA_HAPPY = '[^_^]';
-my $MATA_SING = '[^=^]';
-my $MATA_DEAD = '[x~x]';
-my $MATA_CUTE = '[>.<]';
-my $MATA_FLIPOFF = 't[-_-t]';
+my $USER = 'mata_bot_beta4';
-my $ball_path = "$SHAREDIR/matabot/ball";
-my $quotes_path = "$SHAREDIR/matabot/quotes";
-my $hellos_path = "$SHAREDIR/matabot/hellos";
-my $chan = '#testmatabot';
-my $host = 'localhost';
-my $logging = 0;
-my $port = '6667';
-my $tls = 0;
-my %subbuffer;
+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;
-# process args
-getopts('tlH:b:h:j:p:q:', \my %opts);
-$ball_path = $opts{'b'} if ($opts{'b'});
-$chan = "#$opts{'j'}" if ($opts{'j'});
-$hellos_path = $opts{'H'} if ($opts{'H'});
-$host = $opts{'h'} if ($opts{'h'});
-$logging = 1 if ($opts{'l'});
-$port = $opts{'p'} if ($opts{'p'});
-$quotes_path = $opts{'q'} if ($opts{'q'});
-$tls = 1 if ($opts{'t'});
+ 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'};
-# read in the quotes file;
-open (my $quotes_file, "<", $quotes_path) or die "couldn't open ${quotes_path}: $!";
-chomp(my @quotes = <$quotes_file>);
-my $quotes_num = $.;
-close $quotes_file or die "$quotes_file: $!";
+ 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: $!";
-# read in the 8ball file
-open (my $ball_file, "<", $ball_path) or die "couldn't open ${ball_path}: $!";
-chomp(my @ball = <$ball_file>);
-my $ball_num = $.;
-close $ball_file or die "$ball_file: $!";
+ return {
+ 'chan' => $chan,
+ 'host' => $host,
+ 'logging' => $logging,
+ 'port' => $port,
+ 'tls' => $tls,
+ },
+ {
+ 'ball' => \@ball,
+ 'hellos' => \@hellos,
+ 'quotes' => \@quotes,
+ };
+}
-# read in the hellos file
-open (my $hellos_file, "<", $hellos_path) or die "couldn't open ${hellos_path}: $!";
-chomp(my @hellos = <$hellos_file>);
-my $hellos_num = $.;
-close $hellos_file or die "$hellos_file: $!";
-
sub randint {
my($min, $max) = @_;
return $min if $min == $max;
}
sub out {
- my ($sock, $message) = @_;
- logger($message) if ($logging);
+ my ($sock, $logging, $message) = @_;
+ logger($message) if $logging;
print $sock "$message\r\n";
}
sub msg {
- my ($sock, $message) = @_;
- out($sock, "PRIVMSG $chan :$message");
+ my ($sock, $logging, $chan, $message) = @_;
+ out($sock, $logging, "PRIVMSG ${chan} :${message}");
}
sub respond_command {
- my ($sock, $sender_nick, $content) = @_;
+ my ($sock, $logging, $chan, $ball, $hellos, $sender_nick, $content) = @_;
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, "${sender_nick} rolled a ${roll} and got ${result}! ${MATA_HAPPY}");
+ msg($sock, $logging, $chan, "${sender_nick} rolled a ${roll} and got ${result}! ${MATA_HAPPY}");
} elsif ($content =~ /\b{wb}pray+\b{wb}/) {
- msg($sock, "Stay prayed up!! ${MATA_CUTE}");
+ msg($sock, $logging, $chan, "Stay prayed up!! ${MATA_CUTE}");
} elsif ($content =~ /\b{wb}bru[hv]+\b{wb}/i) {
- msg($sock, "Did i stutter? ${MATA_NORM}");
+ msg($sock, $logging, $chan, "Did i stutter? ${MATA_NORM}");
} elsif ($content =~ /\b{wb}f+(u?ck+)? *(yo)?u+\b{wb}/i) {
- msg($sock, "$MATA_FLIPOFF");
+ msg($sock, $logging, $chan, "$MATA_FLIPOFF");
} elsif ($content =~ /\b{wb}i+ *l+(ove+)? *(you+|y+|u+)\b{wb}/i) {
- msg($sock, "<3 ${MATA_HAPPY}");
+ msg($sock, $logging, $chan, "<3 ${MATA_HAPPY}");
} elsif ($content =~ /(thanks+|thx+|thank +(yo)?u+)( *a+ *lot+)?/i) {
- msg($sock, "You're welcome, ${sender_nick}! ${MATA_HAPPY}");
+ msg($sock, $logging, $chan, "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, "Me! ${MATA_CUTE}");
+ msg($sock, $logging, $chan, "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, "I feel fantaaaastic... hey, hey, hey! ${MATA_SING}");
+ msg($sock, $logging, $chan, "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, "Looking for technomage, and you? ${MATA_NORM}");
+ msg($sock, $logging, $chan, "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, "Thank you, mother! ${MATA_HAPPY}");
+ msg($sock, $logging, $chan, "Thank you, mother! ${MATA_HAPPY}");
} else {
- msg($sock, "Thanks, ${sender_nick}! ${MATA_HAPPY}");
+ msg($sock, $logging, $chan, "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, "$hellos[int rand($hellos_num)], ${sender_nick}! ${MATA_HAPPY}");
+ msg($sock, $logging, $chan, "$hellos->[rand @$hellos], ${sender_nick}! ${MATA_HAPPY}");
} elsif ($content =~ /\?$/) {
# we got a question
- msg($sock, "$ball[int rand($ball_num)] ${MATA_CUTE}");
+ msg($sock, $logging, $chan, "$ball->[rand @$ball] ${MATA_CUTE}");
} elsif ($sender_nick eq $MOTHER) {
- msg($sock, "Done, mother! ${MATA_HAPPY}");
+ msg($sock, $logging, $chan, "Done, mother! ${MATA_HAPPY}");
} else {
- msg($sock, "\1ACTION leans over and places it's hand near it's antenna. \"HUUH?\" ${MATA_NORM}\1");
+ msg($sock, $logging, $chan, "\1ACTION leans over and places it's hand near it's antenna. \"HUUH?\" ${MATA_NORM}\1");
}
}
sub respond_mention {
- my ($sock, $sender_nick, $message) = @_;
+ my ($sock, $logging, $chan, $quotes, $sender_nick, $message) = @_;
if ($sender_nick eq $MOTHER) {
- msg($sock, "Yes, mother? ${MATA_HAPPY}");
+ msg($sock, $logging, $chan, "Yes, mother? ${MATA_HAPPY}");
} elsif ($message =~ /^\b${NICK_RE}\b$/) {
- msg($sock, "${MATA_NORM} ?");
+ msg($sock, $logging, $chan, "${MATA_NORM} ?");
} else {
- msg($sock, "$quotes[int rand($quotes_num)] ${MATA_NORM}");
+ msg($sock, $logging, $chan, "$quotes->[rand @$quotes] ${MATA_NORM}");
}
}
# respond to channel
# returns 1 if bot shouldn't remember last message for s///, 0 otherwise
sub respond {
- my ($sock, $sender_nick, $message) = @_;
- if ($subbuffer{$sender_nick} && $message =~ m,\b{wb}s/([^/]+)/([^/]*)(?:/([gi]*))?,) {
+ my ($sock, $logging, $chan, $lists, $subbuffer, $sender_nick, $message) = @_;
+ if ($subbuffer->{$sender_nick} && $message =~ m,\b{wb}s/([^/]+)/([^/]*)(?:/([gi]*))?,) {
# chat s///
+ my $prev_message = $subbuffer->{$sender_nick};
my $retext = $1;
my $repl = $2;
my $mods = $3 // '';
eval {
$regex = qr/(?$imod:$retext)/
};
- return 1 if $@;
+ return $prev_message if $@;
my $ismatch;
if ($mods =~ /g/) {
- $ismatch = $subbuffer{$sender_nick} =~ s/$regex/$repl/g;
+ $ismatch = $prev_message =~ s/$regex/$repl/g;
} else {
- $ismatch = $subbuffer{$sender_nick} =~ s/$regex/$repl/;
+ $ismatch = $prev_message =~ s/$regex/$repl/;
}
if ($ismatch) {
- msg($sock, "${sender_nick} meant to say: $subbuffer{$sender_nick}");
+ msg($sock, $logging, $chan, "${sender_nick} meant to say: ${prev_message}");
}
- return 1;
+ return $prev_message;
} 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, "failed to get title of video ${video_id} ${MATA_DEAD} ($response->{status} $response->{reason}!)");
- return 0;
+ msg($sock, $logging, $chan, "failed to get title of video ${video_id} ${MATA_DEAD} ($response->{status} $response->{reason}!)");
+ return $message;
}
unless (length $response->{content}) {
- msg($sock, "failed to get title of youtube video ${video_id} ${MATA_DEAD} (HTTP response empty!)");
- return 0;
+ msg($sock, $logging, $chan, "failed to get title of youtube video ${video_id} ${MATA_DEAD} (HTTP response empty!)");
+ return $message;
}
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, "YouTube: $title");
+ msg($sock, $logging, $chan, "YouTube: $title");
} else {
- msg($sock, "failed to get title of video ${video_id} ${MATA_DEAD} (no videos matching ID $video_id!)");
+ msg($sock, $logging, $chan, "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, "$response->{status} $response->{reason} (HEAD ${url}) ${MATA_DEAD} ");
- return 0;
+ msg($sock, $logging, $chan, "$response->{status} $response->{reason} (HEAD ${url}) ${MATA_DEAD}");
+ return $message;
}
unless ($response->{headers}->{'content-type'}) {
- msg($sock, "no content-type header in HTTP response (HEAD ${url}) ${MATA_DEAD}");
- return 0;
+ msg($sock, $logging, $chan, "no content-type header in HTTP response (HEAD ${url}) ${MATA_DEAD}");
+ return $message;
}
unless ($response->{headers}->{'content-type'} =~ m,text/html,) {
# we got a non text/html content type
- msg($sock, "File: $response->{headers}->{'content-type'}");
- return 0;
+ msg($sock, $logging, $chan, "File: $response->{headers}->{'content-type'}");
+ return $message;
}
# if it's text/html, GET it's title
$response = HTTP::Tiny->new->get($url);
unless ($response->{success}) {
- msg($sock, "$response->{status} $response->{reason} (GET ${url}) ${MATA_DEAD}");
- return 0;
+ msg($sock, $logging, $chan, "$response->{status} $response->{reason} (GET ${url}) ${MATA_DEAD}");
+ return $message;
}
unless (length $response->{content}) {
- msg($sock, "Empty HTTP response (GET ${url}) ${MATA_DEAD}");
- return 0;
+ msg($sock, $logging, $chan, "Empty HTTP response (GET ${url}) ${MATA_DEAD}");
+ return $message;
}
my $content = $response->{content};
if ($content =~ m,<title[^>]*>([^<]+)</title[^>]*>,i) {
my $title = $1;
$title =~ tr/[\000\r\n]//d;
$title = trim($title);
- msg($sock, "Title: $title");
+ msg($sock, $logging, $chan, "Title: $title");
} else {
- msg($sock, "No title found (GET ${url} ${MATA_DEAD}");
+ msg($sock, $logging, $chan, "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, $sender_nick, $1);
+ respond_command($sock, $logging, $chan, $lists->{'ball'}, $lists->{'hellos'}, $sender_nick, $1);
} elsif ($message =~ /\b${NICK_RE}\b/) {
- respond_mention($sock, $sender_nick, $message);
+ respond_mention($sock, $logging, $chan, $lists->{'quotes'}, $sender_nick, $message);
}
- return 0;
+ return $message;
}
sub evasdrop {
- my $sock = shift;
+ my ($sock, $opts, $lists, $subbuffer) = @_;
my $buffer = '';
my $chunk = '';
my $message = '';
+ my %subbuffer;
while (1) {
# buffer up
- if ($tls) {
+ if ($opts->{'tls'}) {
$chunk = <$sock>;
} else {
$sock->recv($chunk, $CHUNK_LENGTH);
$buffer .= $chunk;
next;
}
-
# log message
- logger($message) if ($logging);
+ logger($message) if ($opts->{'logging'});
# respond to message
if ($message =~ /^PING :([^\000\r\n\ ]+)$/) {
# if we got a ping, pong back
- out($sock, "PONG :$1");
- } elsif ($message =~ /^:([^\000\r\n\#\&\ ][^\000\r\n\ ]*)![^\000\r\n\ ]+@[^\000\r\n\ ]+ PRIVMSG ${chan} :([^\000\r\n]*)$/) {
+ out($sock, $opts->{'logging'}, "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;
- unless (respond($sock, $sender_nick, $sender_message)) {
- $subbuffer{$sender_nick} = $sender_message;
- }
+ $subbuffer->{$sender_nick} = respond($sock, $opts->{'logging'}, $opts->{'chan'}, $lists, $subbuffer, $sender_nick, $sender_message);
}
}
}
while (1) {
# start the connection
+ my ($opts, $lists) = init();
my $sock;
- if ($tls) {
+ if ($opts->{'tls'}) {
$sock = IO::Socket::SSL->new(
Domain => AF_INET,
Type => SOCK_STREAM,
- PeerHost => $host,
- PeerPort => $port,
+ PeerHost => $opts->{'host'},
+ PeerPort => $opts->{'port'},
) || die "Can't open socket: $IO::Socket::errstr";
} else {
$sock = IO::Socket->new(
Domain => AF_INET,
Type => SOCK_STREAM,
- proto => 'tcp',
- PeerHost => $host,
- PeerPort => $port,
+ proto => $opts->{'tcp'},
+ PeerHost => $opts->{'host'},
+ PeerPort => $opts->{'port'},
) || die "Can't open socket: $IO::Socket::errstr";
}
# set user, real, and nick, then join
- out($sock, "USER $USER * * :$REAL");
- out($sock, "NICK $NICK");
- out($sock, "JOIN $chan");
+ out($sock, $opts->{'logging'}, "USER $USER * * :$REAL");
+ out($sock, $opts->{'logging'}, "NICK $NICK");
+ out($sock, $opts->{'logging'}, "JOIN $opts->{'chan'}");
# main loop
- evasdrop($sock);
+ evasdrop($sock, $opts, $lists);
}
