From b6da79a0bc1289f2a6064a6b3ffcd0c2333f2c97 Mon Sep 17 00:00:00 2001 From: Patrick Spek Date: Wed, 5 May 2021 11:03:32 +0200 Subject: Initial commit --- .editorconfig | 16 ++ .gitignore | 14 ++ .gitlab-ci.yml | 23 +++ .travis.yml | 13 ++ CHANGELOG.md | 9 ++ META6.json | 28 ++++ README.rakudoc | 23 +++ bin/test | 72 +++++++++ lib/IRC/Client.rakumod | 332 +++++++++++++++++++++++++++++++++++++++++ lib/IRC/Client/Core.rakumod | 155 +++++++++++++++++++ lib/IRC/Client/Handler.rakumod | 174 +++++++++++++++++++++ lib/IRC/Client/Message.rakumod | 180 ++++++++++++++++++++++ lib/IRC/Client/Plugin.rakumod | 28 ++++ t/01-parser.t | 19 +++ 14 files changed, 1086 insertions(+) create mode 100644 .editorconfig create mode 100644 .gitignore create mode 100644 .gitlab-ci.yml create mode 100644 .travis.yml create mode 100644 CHANGELOG.md create mode 100644 META6.json create mode 100644 README.rakudoc create mode 100644 bin/test create mode 100644 lib/IRC/Client.rakumod create mode 100644 lib/IRC/Client/Core.rakumod create mode 100644 lib/IRC/Client/Handler.rakumod create mode 100644 lib/IRC/Client/Message.rakumod create mode 100644 lib/IRC/Client/Plugin.rakumod create mode 100644 t/01-parser.t 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: + +=begin code :lang +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 // 'Log::Colored')).new; + $Log::instance.add-output($*OUT, %*ENV // 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 => , + 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; + %payload.privmsg('#test', 'hello there'); + } + + multi method http-post(%payload) { + %payload.privmsg('#test', %payload); + } + }, + ], + ); + + $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 ∈ } +) { + 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.map(*.Str).Array; + + my %prefix = $match + .hash + .kv + .map(sub ($key, $value) { $key => $value.Str }) + ; + + if ($match eq 'PRIVMSG'|'NOTICE') { + with ($match.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.Str, + |%prefix, + :@params, + :$irc, + ); +} + +multi method new ( + %params, +) { + self.bless(|%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[$index] = $value; + + self.new(|%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); + -- cgit v1.1