4 files changed, 537 insertions, 0 deletions
diff --git a/lib/IRC/Client/Core.rakumod b/lib/IRC/Client/Core.rakumod
new file mode 100644
index 0000000..8cba445
--- /dev/null
+++ b/lib/IRC/Client/Core.rakumod
@@ -0,0 +1,155 @@
+#! /usr/bin/env false
+
+use v6.d;
+
+use IRC::Client::Handler;
+use IRC::Client::Plugin;
+use Log;
+
+#| A plugin for IRC::Client, encapsulating all the core functionality required
+#| of a functional IRC client.
+unit class IRC::Client::Core is IRC::Client::Plugin;
+
+#| Special cased method to setup the initial connection with IRC.
+multi method irc-setup ($irc) {
+	$irc.connected = True;
+	$irc.send-raw("USER {$irc.user} 8 * :{$irc.real-name}");
+	$irc.set-nick($irc.nicks[0]);
+}
+
+#| Special cased method to perform actions once the client is ready to go to
+#| work.
+multi method irc-ready ($irc) {
+	for $irc.channels -> $channel {
+		$irc.join($channel);
+	}
+}
+
+#| Handle RPL_WELCOME. This message indicates that the connection setup has
+#| been succesful.
+multi method irc-n001 ($message) {
+	my $nick = $message.params[0];
+
+	.debug("Logged in as $nick") with $Log::instance;
+
+	$.irc.prefix = $message[*-1].words.tail;
+	$.irc.nick = $nick;
+}
+
+#| Handle ERR_ERRONEUSNICKNAME. This message indicates that the nickname which
+#| is being used is not allowed, and the client should try an alternative
+#| instead.
+multi method irc-n432 ($message where { $_.params[0] eq '*' }) {
+	.error($message.params[*-1]) with $Log::instance;
+
+	my @nicks = $.irc.nicks;
+	my $index = @nicks.first($.irc.nick, :k) + 1 // 0;
+
+	if (@nicks.elems ≤ $index) {
+		.warning("No more nicks to try ({@nicks.join(' ')})") with $Log::instance;
+		$.irc.stop;
+		exit(3);
+	}
+
+	$.irc.set-nick(@nicks[$index]);
+}
+
+#| Handle ERR_NICKNAMEINUSE. This message indicates the nickname which is being
+#| used is already in use by another client. Another nickname should be tried
+#| instead.
+multi method irc-n433 ($message where { $_.params[0] eq '*' }) {
+	self.irc-n432($message);
+}
+
+multi method irc-n433 ($message where { $_.params[0] ne '*'}) {
+	$.irc.nick = $_.params[1];
+}
+
+#| Handle ERR_CHANNELISFULL. This message indicates a channel could not be
+#| joined due to a user count limitation (+l).
+multi method irc-n471 ($message) {
+	self!unregister-channel($.irc, $message.params[1]);
+}
+
+#| Handle ERR_INVITEONLYCHAN. This message indicates a channel could not be
+#| joined because you must be invited (+i).
+multi method irc-n473 ($message) {
+	self!unregister-channel($message.params[1]);
+}
+
+#| Handle ERR_BANNEDFROMCHAN. This message indicates a channel could not be
+#| joined due to an active ban (+b).
+multi method irc-n474 ($message) {
+	self!unregister-channel($message.params[1]);
+}
+
+#| Handle ERR_BADCHANNELKEY. This message indicates a channel could not be
+#| joined because it requires a key, or the given key was incorrect.
+multi method irc-n475 ($message) {
+	self!unregister-channel($message.params[1]);
+}
+
+#| Handle JOIN, but only if it pertains to ourselves. This method will keep the
+#| IRC::Client.channels list synced to the channels the bot is actually in.
+multi method irc-join ($message where { $_.nickname eq $message.irc.nick }) {
+	self!register-channel($message.params[0]);
+}
+
+#| Handle PART, but only if it pertains to ourselves. This method will keep the
+#| IRC::Client.channels list synced to the channels the bot is actually in.
+multi method irc-part ($message where { $_.nickname eq $message.irc.nick }) {
+	self!unregister-channel($message.params[0]);
+}
+
+#| Handle a CTCP PING request.
+multi method irc-privmsg ($message where { $_.ctcp && $_.params[*-1].words[0] eq 'PING'}) {
+	$.irc.notice($message.nickname, "PING {$message.params[*-1].words[1..*]}", :ctcp);
+}
+
+#| Handle a CTCP VERSION request.
+multi method irc-privmsg ($message where { $_.ctcp && $_.params[*-1].words[0] eq 'VERSION'}) {
+	$.irc.notice($message.nickname, 'VERSION raku/IRC::Client v0.1.0', :ctcp);
+}
+
+#| Handle a PING command. This message should be responded to with a PONG
+#| reply, to indicate the client is still alive.
+multi method irc-ping ($message) {
+	$.irc.send-raw("PONG :{$message.params[*-1]}");
+}
+
+#| Convenience method for adding a channel to the IRC::Client.channels list.
+method !register-channel ($channel) {
+	my @channels = $.irc.channels;
+
+	return if @channels ∋ $channel;
+
+	.debug("Adding $channel to the IRC::Client.channels") with $Log::instance;
+
+	$.irc.channels.append($channel);
+}
+
+#| Convenience method for removing a channel from the IRC::Client.channels
+#| list.
+method !unregister-channel ($channel) {
+	.debug("Removing $channel from IRC::Client.channels") with $Log::instance;
+
+	$.irc.channels = $.irc.channels.grep(* ne $channel);
+}
+
+=begin pod
+
+=NAME    IRC::Client::Core
+=AUTHOR  Patrick Spek <~tyil/raku-devel@lists.sr.ht>
+=VERSION 0.0.0
+
+=head1 Synopsis
+
+=head1 Description
+
+=head1 Examples
+
+=head1 See also
+
+=end pod
+
+# vim: ft=perl6 noet
diff --git a/lib/IRC/Client/Handler.rakumod b/lib/IRC/Client/Handler.rakumod
new file mode 100644
index 0000000..c966099
--- /dev/null
+++ b/lib/IRC/Client/Handler.rakumod
@@ -0,0 +1,174 @@
+#! /usr/bin/env false
+
+use v6.d;
+
+use IRC::Client::Message;
+use IRC::Client::Plugin;
+
+use Log;
+
+#| This class handles incoming messages, formats a context from them and
+#| dispatches it on to any registered plugin that can handle it.
+unit class IRC::Client::Handler;
+
+#| Handle numeric commands.
+multi method handle (
+	$event where { $_.command ~~ / \d ** 3/ },
+) {
+	my @events;
+
+	# Special cases for IRC::Client
+	@events.append('irc-connected' => $event.irc) if $event.command eq '001';
+	@events.append('irc-ready' => $event.irc) if $event.command eq '376';
+	@events.append('irc-ready' => $event.irc) if $event.command eq '422';
+
+	# Regular events, handles in the regular way
+	@events.append("irc-n{$event.command}" => $event);
+	@events.append('irc-numeric' => $event);
+	@events.append('irc-all' => $event);
+
+	self.dispatch(@events, $event.irc);
+}
+
+#| Handle PRIVMSG and NOTICE commands.
+multi method handle (
+	$event where { $_.command ∈ <PRIVMSG NOTICE> }
+) {
+	my @events;
+	my $stripped;
+
+	# If the message starts with the name of the client, it should dispatch
+	# an irc-addressed event.
+	if ($event.params[*-1] ~~ / ^ ( "{$event.irc.nick}" <[:;,]> <.ws> ) /) {
+		$stripped = $event.set-param(*-1, $event.params[*-1].substr($0.chars));
+	}
+
+
+	# A private message to the client should dispatch an irc-to-me event,
+	# optionally stripping away the client's current nickname from the
+	# start.
+	if ($event.params[0] eq $event.irc.nick) {
+		@events.append('irc-to-me' => $stripped // $event);
+	}
+
+	# A message to a public channel prefixed with the client's current
+	# nickname is both an irc-to-me event, and an irc-addressed event.
+	if ($event.params[0] ne $event.irc.nick && $stripped) {
+		@events.append('irc-to-me' => $stripped);
+		@events.append('irc-addressed' => $stripped);
+	}
+
+	@events.append("irc-{$event.command.fc}-me" => $event) if $event.params[0] eq $event.irc.nick;
+	@events.append('irc-mentioned' => $event) if $event.params[*-1].words ∋ $event.irc.nick;
+	@events.append("irc-{$event.command.fc}-channel" => $event) if $event.params[0] ~~ / ^ <[#&]> /;
+	@events.append("irc-{$event.command.fc}" => $event);
+	@events.append('irc-all' => $event);
+
+	self.dispatch(@events, $event.irc);
+}
+
+#| Handle MODE commands.
+multi method handle (
+	$event where { $_.command eq 'MODE' }
+) {
+	my @events;
+
+	@events.append('irc-mode-me' => $event) if $event.params[0] eq $event.irc.nick;
+	@events.append('irc-mode-channel' => $event) if $event.params[0] ~~ / ^ <[#&]> /;
+	@events.append('irc-mode' => $event);
+	@events.append('irc-all' => $event);
+
+	self.dispatch(@events, $event.irc);
+}
+
+#| Handle all IRC commands. Note that the order in which events are appended
+#| does matter, the most "narrow" event should always come first, getting
+#| broader as we go down the list.
+multi method handle (
+	$event,
+) {
+	my @events;
+
+	@events.append("irc-{$event.command.fc}" => $event);
+	@events.append('irc-all' => $event);
+
+	self.dispatch(@events, $event.irc);
+}
+
+#| Dispatch the message to all plugins.
+method dispatch (
+	@events,
+	$client, #= IRC::Client, but can't `use` this due to circular references
+) {
+	my @plugins = $client.plugins;
+
+	# Loop over all the plugins, and dispatch to each of them on a seperate
+	# thread. This allows plugins to take their sweet time, while not being
+	# in any other plugins' way.
+	for $client.plugins -> $plugin {
+		start {
+			CATCH {
+				default {
+					my $exception = $_;
+					.emergency($exception.gist.lines.map(*.trim-trailing).join("\n")) with $Log::instance;
+				}
+			}
+
+			self.dispatch-plugin(@events, $plugin)
+		}
+	}
+}
+
+#| Dispatch the message to all plugin methods that can handle them.
+method dispatch-plugin (
+	@events,
+	IRC::Client::Plugin $plugin,
+) {
+	for @events -> $event {
+		my $method = $event.key;
+		my $payload = $event.value;
+
+		# Check for available methods to handle this payload.
+		my @methods = $plugin.^can($method)
+			.map(*.candidates)
+			.flat
+			.grep(*.cando(\($plugin, $payload)))
+			;
+
+		# Nothing to do if nothing was found.
+		next unless @methods;
+
+		.debug("Dispatching to {$plugin.^name}.$method") with $Log::instance;
+
+		my $response = $plugin."$method"($payload);
+
+		next unless $payload ~~ IRC::Client::Message;
+
+		# Depending on the return value of the method, something can be
+		# done.
+		given ($response) {
+			when Str {
+				$payload.reply($response);
+				last;
+			}
+		}
+	}
+}
+
+=begin pod
+
+=NAME    IRC::Client::Handler
+=AUTHOR  Patrick Spek <~tyil/raku-devel@lists.sr.ht>
+=VERSION 0.0.0
+
+=head1 Synopsis
+
+=head1 Description
+
+=head1 Examples
+
+=head1 See also
+
+=end pod
+
+# vim: ft=perl6 noet
diff --git a/lib/IRC/Client/Message.rakumod b/lib/IRC/Client/Message.rakumod
new file mode 100644
index 0000000..1e1ffb7
--- /dev/null
+++ b/lib/IRC/Client/Message.rakumod
@@ -0,0 +1,180 @@
+#! /usr/bin/env false
+
+use v6.d;
+
+use IRC::Grammar;
+
+#| A class to represent a message over IRC.
+unit class IRC::Client::Message;
+
+has Str $.servername;
+has Str $.nickname;
+has Str $.user;
+has Str $.host;
+has Str $.command;
+has Str @.params;
+has Bool $.ctcp = False;
+has $.irc;
+
+multi method new (
+	#| A string representing a line sent or received from an IRC server.
+	Str:D $line,
+
+	#| A reference the the IRC::Client handling the message.
+	$irc,
+) {
+	my $match = IRC::Grammar.parse($line);
+
+	# If the line doesn't match the IRC grammar, it's malformed and not up
+	# to IRC::Client to fix it.
+	die "Malformed message '$line'" if !?$match;
+
+	my $ctcp = False;
+	my @params = $match<params>.map(*.Str).Array;
+
+	my %prefix = $match<prefix>
+		.hash
+		.kv
+		.map(sub ($key, $value) { $key => $value.Str })
+		;
+
+	if ($match<command> eq 'PRIVMSG'|'NOTICE') {
+		with ($match<params>.tail.Str) {
+			if ($_.comb[0, *-1].grep(* eq "\x[1]")) {
+				$ctcp = True;
+				@params[*-1] = $_.Str.substr(1, *-1);
+			} else {
+				@params[*-1] = $_.Str;
+			}
+		}
+	}
+
+	self.bless(
+		command => $match<command>.Str,
+		|%prefix,
+		:@params,
+		:$irc,
+	);
+}
+
+multi method new (
+	%params,
+) {
+	self.bless(|%params, params => %params<params>.list);
+}
+
+method gist
+{
+	@!params.tail
+}
+
+method prefix
+{
+	return $!servername if $!servername;
+
+	my $prefix = $!nickname;
+
+	if ($!host) {
+		if ($!user) {
+			$prefix = "$prefix!$!user";
+		}
+
+		$prefix = "$prefix@$!host";
+	}
+
+	$prefix;
+}
+
+method raku
+{
+	my $s = "$!command {@!params.join(' ')}";
+
+	with (self.prefix) { $s = ":$_ $s" }
+
+	given (@!params.elems) {
+		when 1 {
+			$s = "$s :{@!params[0]}"
+		}
+		default {
+			my @middle = @!params.head(*-1);
+			my $trailing = @!params.tail;
+
+			$s = "$s {@middle.join(' ')} :$trailing";
+		}
+	}
+
+
+	$s;
+}
+
+method words
+{
+	self.Str.words
+}
+
+method Hash
+{
+	%(
+		:$!servername,
+		:$!nickname,
+		:$!user,
+		:$!host,
+		:$!command,
+		:@!params,
+		:$!ctcp,
+		:$!irc,
+	)
+}
+
+method Str
+{
+	self.gist
+}
+
+#
+# Mutators
+#
+
+method set-param (
+	$index where { $_ ~~ Int:D|Code:D },
+	Str:D $value,
+) {
+	my %params = self.Hash;
+
+	%params<params>[$index] = $value;
+
+	self.new(|%params, params => %params<params>.list);
+}
+
+#
+# Convenience
+#
+
+method reply (
+	Str:D $message,
+) {
+	my $target = @!params[0] eq $!irc.nick ?? $!nickname !! @!params[0];
+
+	given ($!command) {
+		when 'PRIVMSG' { $!irc.privmsg($target, $message, :$!ctcp) }
+		when 'NOTICE' { $!irc.notice($target, $message, :$!ctcp) }
+	}
+}
+
+=begin pod
+
+=NAME    IRC::Client::Message
+=AUTHOR  Patrick Spek <~tyil/raku-devel@lists.sr.ht>
+=VERSION 0.0.0
+
+=head1 Synopsis
+
+=head1 Description
+
+=head1 Examples
+
+=head1 See also
+
+=end pod
+
+# vim: ft=perl6 noet
diff --git a/lib/IRC/Client/Plugin.rakumod b/lib/IRC/Client/Plugin.rakumod
new file mode 100644
index 0000000..7388416
--- /dev/null
+++ b/lib/IRC/Client/Plugin.rakumod
@@ -0,0 +1,28 @@
+#! /usr/bin/env false
+
+use v6.d;
+
+#| A base role for IRC::Client plugins. A plugin may handle any number of
+#| methods, in order to act upon events encountered by the client.
+unit role IRC::Client::Plugin;
+
+#| A reference to the IRC::Client the plugin is used by.
+has $.irc is rw;
+
+=begin pod
+
+=NAME    IRC::Client::Plugin
+=AUTHOR  Patrick Spek <~tyil/raku-devel@lists.sr.ht>
+=VERSION 0.0.0
+
+=head1 Synopsis
+
+=head1 Description
+
+=head1 Examples
+
+=head1 See also
+
+=end pod
+
+# vim: ft=perl6 noet