aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--.editorconfig16
-rw-r--r--.gitignore14
-rw-r--r--.gitlab-ci.yml23
-rw-r--r--.travis.yml13
-rw-r--r--CHANGELOG.md9
-rw-r--r--META6.json28
-rw-r--r--README.rakudoc23
-rw-r--r--bin/test72
-rw-r--r--lib/IRC/Client.rakumod332
-rw-r--r--lib/IRC/Client/Core.rakumod155
-rw-r--r--lib/IRC/Client/Handler.rakumod174
-rw-r--r--lib/IRC/Client/Message.rakumod180
-rw-r--r--lib/IRC/Client/Plugin.rakumod28
-rw-r--r--t/01-parser.t19
14 files changed, 1086 insertions, 0 deletions
diff --git a/.editorconfig b/.editorconfig
new file mode 100644
index 0000000..74dde7f
--- /dev/null
+++ b/.editorconfig
@@ -0,0 +1,16 @@
+[*]
+charset = utf-8
+end_of_line = lf
+insert_final_newline = true
+indent_style = tab
+indent_size = 4
+
+[*.json]
+indent_style = space
+indent_size = 2
+
+[*.yml]
+indent_style = space
+indent_size = 2
+
+# vim: ft=dosini
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..93356c2
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,14 @@
+## Perl 6 precompilation files ##
+.precomp
+
+## Editor files ##
+
+# emacs
+*~
+
+# vim
+.*.sw?
+
+# comma
+.idea
+*.iml
diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml
new file mode 100644
index 0000000..d330e03
--- /dev/null
+++ b/.gitlab-ci.yml
@@ -0,0 +1,23 @@
+IRC::Client:
+ only:
+ - master
+ image: rakudo-star
+ before_script:
+ - zef install . --deps-only --test-depends --/test
+ script: AUTHOR_TESTING=1 prove -v -e "perl6 -Ilib" t
+ artifacts:
+ name: "IRC-Client"
+ paths:
+ - META6.json
+ - bin
+ - lib
+ - resources
+ - t
+
+test:
+ except:
+ - master
+ image: rakudo-star
+ before_script:
+ - zef install . --deps-only --test-depends --/test
+ script: AUTHOR_TESTING=1 prove -v -e "perl6 -Ilib" t
diff --git a/.travis.yml b/.travis.yml
new file mode 100644
index 0000000..077ddb0
--- /dev/null
+++ b/.travis.yml
@@ -0,0 +1,13 @@
+language: perl6
+
+perl6:
+ - latest
+
+os:
+ - linux
+
+install:
+ - rakudobrew build zef
+ - zef install --deps-only .
+
+script: AUTHOR_TESTING=1 prove -v -e "perl6 -Ilib" t/
diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
index 0000000..1003abb
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,9 @@
+# Changelog
+All notable changes to this project will be documented in this file.
+
+The format is based on [Keep a Changelog](http://keepachangelog.com/en/1.0.0/)
+and this project adheres to [Semantic
+Versioning](http://semver.org/spec/v2.0.0.html).
+
+## [UNRELEASED]
+- Initial release
diff --git a/META6.json b/META6.json
new file mode 100644
index 0000000..33b7095
--- /dev/null
+++ b/META6.json
@@ -0,0 +1,28 @@
+{
+ "api": "0",
+ "auth": "cpan:TYIL",
+ "authors": [
+ "Patrick Spek <~tyil/raku-devel@lists.sr.ht>"
+ ],
+ "depends": [
+ "IRC::Grammar"
+ ],
+ "description": "My own take on the IRC::Client module",
+ "license": "AGPL-3.0",
+ "meta-version": 0,
+ "name": "IRC::Client",
+ "perl": "6.d",
+ "provides": {
+ "IRC::Client": "lib/IRC/Client.rakumod",
+ "IRC::Client::Core": "lib/IRC/Client/Core.rakumod",
+ "IRC::Client::Handler": "lib/IRC/Client/Handler.rakumod",
+ "IRC::Client::Message": "lib/IRC/Client/Message.rakumod",
+ "IRC::Client::Plugin": "lib/IRC/Client/Plugin.rakumod"
+ },
+ "resources": [
+ ],
+ "source-url": "",
+ "tags": [
+ ],
+ "version": "0.0.0"
+}
diff --git a/README.rakudoc b/README.rakudoc
new file mode 100644
index 0000000..30192e0
--- /dev/null
+++ b/README.rakudoc
@@ -0,0 +1,23 @@
+=begin pod
+
+=NAME IRC::Client
+=AUTHOR Patrick Spek <~tyil/raku-devel@lists.sr.ht>
+=VERSION 0.0.0
+
+=head1 Description
+
+My own take on the IRC::Client module
+
+=head1 Installation
+
+Install this module through L<zef|https://github.com/ugexe/zef>:
+
+=begin code :lang<sh>
+zef install IRC::Client
+=end code
+
+=head1 License
+
+This module is distributed under the terms of the AGPL-3.0.
+
+=end pod
diff --git a/bin/test b/bin/test
new file mode 100644
index 0000000..421230f
--- /dev/null
+++ b/bin/test
@@ -0,0 +1,72 @@
+#!/usr/bin/env raku
+
+use v6.d;
+
+use IRC::Client;
+use IRC::Client::Plugin;
+use Log;
+use Log::Level;
+use Number::Denominate;
+
+sub MAIN()
+{
+ # Configure Log
+ $Log::instance = (require ::($*ENV<RAKU_LOG_CLASS> // 'Log::Colored')).new;
+ $Log::instance.add-output($*OUT, %*ENV<RAKU_LOG_LEVEL> // Log::Level::Debug);
+
+ # Start the IRC client
+ my $bot = IRC::Client.new(
+ #host => 'chat.freenode.net',
+ #port => 6697,
+ #ssl => True,
+ host => '127.0.0.1',
+ port => 6667,
+ ssl => False,
+ nicks => <tyil_ircbot tyiltest>,
+ channels => <##t #test>,
+ plugins => [
+ class _ is IRC::Client::Plugin {
+ multi method irc-to-me ($ where * eq 'uptime') {
+ denominate now - INIT now;
+ }
+
+ multi method irc-to-me ($event where { $_.nickname eq 'tyil' && $_ eq 'prefix' }) {
+ $event.irc.prefix;
+ }
+
+ multi method irc-to-me ($event where { $_.nickname eq 'tyil' && $_ eq 'chanlist' }) {
+ $event.irc.channels.join(', ')
+ }
+
+ multi method irc-to-me ($event where { $_.nickname eq 'tyil' && $_.words[0] eq 'join'}) {
+ my $channel = $event.words[1];
+
+ $event.reply("Joining $channel");
+ $event.irc.join($channel);
+ }
+
+ multi method irc-to-me ($event where { $_.nickname eq 'tyil' && $_.words[0] eq 'part'}) {
+ my $channel = $event.words[1];
+
+ $event.reply("Parting $channel");
+ $event.irc.part($channel);
+ }
+
+ multi method irc-mentioned ($) {
+ "Don't take my name in your filthy mouth, peasant"
+ }
+
+ multi method http-get(%payload) {
+ dd %payload<body>;
+ %payload<irc>.privmsg('#test', 'hello there');
+ }
+
+ multi method http-post(%payload) {
+ %payload<irc>.privmsg('#test', %payload<body><this>);
+ }
+ },
+ ],
+ );
+
+ $bot.start;
+}
diff --git a/lib/IRC/Client.rakumod b/lib/IRC/Client.rakumod
new file mode 100644
index 0000000..166873c
--- /dev/null
+++ b/lib/IRC/Client.rakumod
@@ -0,0 +1,332 @@
+#! /usr/bin/env false
+
+use v6.d;
+
+use Log;
+
+use IRC::Client::Core;
+use IRC::Client::Handler;
+use IRC::Client::Message;
+use IRC::Client::Plugin;
+
+#| A simple IRC client, intended for automating interactions.
+unit class IRC::Client;
+
+#| The host to connect to.
+has Str $.host = '127.0.0.1';
+
+#| The port to connect to.
+has Int $.port = 6697;
+
+#| Use SSL. Requires IO::Socket::Async::SSL to be installed.
+has Bool $.ssl = True;
+
+#| A list of channels to join on startup.
+has Str @.channels is rw;
+
+#| A list of acceptable nicknames to use.
+has Str @.nicks;
+
+#| The user to identify as.
+has Str $.user = 'raku';
+
+#| The real name to identify as.
+has Str $.real-name = 'IRC::Client';
+
+#| A list of plugins to use.
+has IRC::Client::Plugin @.plugins;
+
+#| The timeout between liveness checks (a PING to itself).
+has Real $.liveness-check-timeout = 30;
+
+#| The timeout between sending individual messages.
+has Real $.send-timeout = 0.2;
+
+#| The bot's own full prefix.
+has Str $.prefix is rw;
+
+#| The current nick of the bot.
+has Str $.nick is rw;
+
+#| Whether the bot is already connected.
+has Bool $.connected is rw;
+
+#| The connection with the IRC server.
+has $!connection;
+
+#| A supplier for incoming messages.
+has Supplier $!in;
+
+#| A Channel for outgoing messages.
+has Channel $!out;
+
+submethod TWEAK
+{
+ # Due to lack of knowledge on how to properly do "protected" variables
+ # in Raku, I'm just throwing a lot of warnings when you shouldn't be
+ # setting something.
+ if ($!connected) { .warning("Don't set connected on .new!") with $Log::instance }
+ if ($!prefix) { .warning("Don't set prefix on .new!") with $Log::instance }
+ if ($!nick) { .warning("Don't set nick on .new!") with $Log::instance }
+
+ $!connected = False;
+}
+
+#| Start the IRC client, connecting to the server and signing on to the
+#| network.
+method start
+{
+ # Sanity checks
+ if (!@!nicks) {
+ .error("You must specify at least one nickname") with $Log::instance;
+ return;
+ }
+
+ # Include the core functionality plugin
+ @!plugins.unshift(IRC::Client::Core);
+
+ # Insert IRC::Client object into plugins
+ for @!plugins.grep(* ~~ IRC::Client::Plugin:D) {
+ $_.irc = self;
+ }
+
+ # Set up suppliers
+ $!in = Supplier.new;
+ $!out = Channel.new;
+
+ # Set up a tap to handle incomding messages, outside of the react
+ # block. This should help in keeping the react block free of
+ # long-running code.
+ $!in.Supply.tap(sub ($message) {
+ try {
+ CATCH {
+ default {
+ my $exception = $_
+ .gist
+ .lines
+ .map(*.trim-trailing)
+ .join("\n")
+ ;
+
+ .critical($exception) with $Log::instance;
+ }
+ }
+
+ .debug("Handling $message") with $Log::instance;
+ IRC::Client::Handler.handle(IRC::Client::Message.new($message, self));
+ }
+ });
+
+ # Dispatch an irc-started event. This event should occurr once per run,
+ # to perform certain initial setups like an HTTP server.
+ IRC::Client::Handler.dispatch(['irc-started' => self], self);
+
+ # Pick the socket class
+ my $socket = !$!ssl ?? IO::Socket::Async !! do {
+ require ::('IO::Socket::Async::SSL');
+ };
+
+ # Connect to the server in a loop, to ensure automatic re-connection
+ # upon any issue.
+ loop {
+ .debug("Connecting to $!host:$!port") with $Log::instance;
+
+ try {
+ CATCH {
+ default {
+ my $exception = $_
+ .gist
+ .lines
+ .map(*.trim-trailing)
+ .join("\n")
+ ;
+
+ .emergency($exception) with $Log::instance;
+ }
+ }
+
+ $!connection = await $socket.connect($!host, $!port);
+ .debug("Connected to $!host:$!port") with $Log::instance;
+
+ # Create a buffer for incoming data
+ my $buffer;
+
+ react {
+ # Setup handling incoming messages
+ whenever $!connection.Supply -> $message {
+ for $message.comb -> $character {
+ given ($character) {
+ # When \r\n is encountered, it signifies the end of a message,
+ # so emit whatever is in the $!buffer to the $!in Supply.
+ when "\r\n" {
+ .info("< $buffer") with $Log::instance;
+ $!in.emit($buffer);
+ $buffer = '';
+ }
+
+ # Otherwise, add the character to the $!buffer.
+ default { $buffer ~= $character }
+ }
+ }
+ }
+
+ # Setup handling outgoing messages
+ whenever Supply.interval($!send-timeout) {
+ if ($!connected) {
+ with ($!out.poll) -> $message {
+ .notice("> $message") with $Log::instance;
+ $!connection.put($message);
+ }
+ }
+ }
+
+ # Simple keep-alive check, to ensure the socket
+ # is still open and usable.
+ whenever Supply.interval($!liveness-check-timeout).skip {
+ if ($!connected) {
+ self.privmsg($!nick, "PING {now.to-posix.first.subst('.', ' ')}", :ctcp);
+ }
+ }
+
+ # Setup handling ^c
+ whenever signal(SIGINT) {
+ .notice('Caught ^c') with $Log::instance;
+ self.stop('Caught ^c');
+ exit 0;
+ }
+
+ # Log on to the server
+ IRC::Client::Handler.dispatch(['irc-setup' => self], self);
+
+ LAST {
+ $!connected = False;
+ .error('Socket closed') with $Log::instance;
+ }
+ }
+ }
+
+ # Wait a small amount of time, in order to not blast an IRC
+ # server with connections when something is wrong.
+ sleep(5);
+ }
+}
+
+#| Stop the IRC client, sending a QUIT to the server and closing the
+#| connection.
+method stop (
+ Str:D $reason = ''
+) {
+ my $message = "QUIT :$reason";
+
+ .notice("> $message") with $Log::instance;
+
+ $!connected = False;
+ $!connection.put($message);
+ $!connection.close;
+}
+
+#
+# Backwards compatability
+#
+
+method run (
+) is DEPRECATED('IRC::Client.start') {
+ self.start()
+}
+
+method quit (
+) is DEPRECATED('IRC::Client.stop') {
+ self.stop()
+}
+
+method send (
+ :$where!,
+ :$text!,
+ :$notice
+) is DEPRECATED('IRC::Client.privmsg or IRC::Client.notice') {
+ self."{$notice ?? 'notice' !! 'privmsg'}"($where, $text)
+}
+
+#
+# Barebones messaging
+#
+
+#| Send a raw line to the IRC server.
+method send-raw (
+ Str:D $message,
+) {
+ $!out.send($message);
+}
+
+#
+# Convenience methods
+#
+
+method join (
+ Str:D $channel,
+) {
+ self.send-raw("JOIN $channel");
+}
+
+method set-nick (
+ Str:D $nick,
+) {
+ $!nick = $nick;
+ self.send-raw("NICK :$nick");
+}
+
+method part (
+ Str:D $channel,
+) {
+ self.send-raw("PART $channel");
+}
+
+multi method privmsg (
+ Str:D $target,
+ Str:D $message,
+ Bool :$ctcp where { !$_ },
+) {
+ self.send-raw("PRIVMSG $target :$message");
+}
+
+multi method privmsg (
+ Str:D $target,
+ Str:D $message,
+ Bool :$ctcp! where { $_ },
+) {
+ self.privmsg($target, "\x[1]$message\x[1]");
+}
+
+multi method notice (
+ Str:D $target,
+ Str:D $message,
+ Bool :$ctcp where { !$_ },
+) {
+ self.send-raw("NOTICE $target :$message");
+}
+
+multi method notice (
+ Str:D $target,
+ Str:D $message,
+ Bool :$ctcp where { $_ },
+) {
+ self.notice($target, "\x[1]$message\x[1]");
+}
+
+=begin pod
+
+=NAME IRC::Client
+=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/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
diff --git a/t/01-parser.t b/t/01-parser.t
new file mode 100644
index 0000000..56e4a77
--- /dev/null
+++ b/t/01-parser.t
@@ -0,0 +1,19 @@
+#!/usr/bin/env raku
+
+use v6.d;
+
+use Test;
+
+use IRC::Client;
+use IRC::Client::Message;
+
+my $client = IRC::Client.new;
+
+ok IRC::Client::Message.new(":irc.tyil.nl 432 * tyil_ircbot :Nickname too long, max. 9 characters", $client);
+ok IRC::Client::Message.new(":irc.tyil.nl 004 tyiltest irc.tyil.nl ngircd-26.1 abBcCFiIoqrRswx abehiIklmMnoOPqQrRstvVz", $client);
+
+ok IRC::Client::Message.new("PING :adams.freenode.net", $client);
+ok IRC::Client::Message.new(":freenode-connect!bot@freenode/utility-bot/frigg PRIVMSG tyil_ircbot :\x[1]VERSION\x[1]", $client);
+ok IRC::Client::Message.new(':tyil_ircbot!~raku@2a10:3781:a2:1:e8ed:81a8:92c9:b4aa JOIN #scriptkitties', $client);
+ok IRC::Client::Message.new(':freenode-connect!bot@freenode/utility-bot/frigg NOTICE tyil_ircbot :Welcome to freenode. To protect the network all new connections will be scanned for vulnerabilities. This will not harm your computer, and vulnerable hosts will be notified.', $client);
+
generated by cgit v1.1 at 2024-04-20 13:53:21 +0000