aboutsummaryrefslogtreecommitdiff
path: root/lib/old-IRC
diff options
context:
space:
mode:
Diffstat (limited to 'lib/old-IRC')
-rw-r--r--lib/old-IRC/Client.pm6174
-rw-r--r--lib/old-IRC/Client/Plugin.pm63
-rw-r--r--lib/old-IRC/Client/Plugin/Debugger.pm68
-rw-r--r--lib/old-IRC/Client/Plugin/PingPong.pm62
-rw-r--r--lib/old-IRC/Grammar.pm620
-rw-r--r--lib/old-IRC/Grammar/Actions.pm626
-rw-r--r--lib/old-IRC/Parser.pm67
7 files changed, 240 insertions, 0 deletions
diff --git a/lib/old-IRC/Client.pm6 b/lib/old-IRC/Client.pm6
new file mode 100644
index 0000000..700739c
--- /dev/null
+++ b/lib/old-IRC/Client.pm6
@@ -0,0 +1,174 @@
+use v6;
+use IRC::Parser; # parse-irc
+use IRC::Client::Plugin::PingPong;
+use IRC::Client::Plugin;
+unit class IRC::Client;
+
+has Bool:D $.debug = False;
+has Str:D $.host = 'localhost';
+has Str $.password;
+has Int:D $.port where 0 <= $_ <= 65535 = 6667;
+has Str:D $.nick = 'Perl6IRC';
+has Str:D $.username = 'Perl6IRC';
+has Str:D $.userhost = 'localhost';
+has Str:D $.userreal = 'Perl6 IRC Client';
+has Str:D @.channels = ['#perl6bot'];
+has IO::Socket::Async $.sock;
+has @.plugins = [];
+has @.plugins-essential = [
+ IRC::Client::Plugin::PingPong.new
+];
+has @!plugs = [|@!plugins-essential, |@!plugins];
+
+method handle-event ($e) {
+ $e<pipe> = {};
+
+ for @!plugs.grep(*.^can: 'irc-all-events') -> $p {
+ my $res = $p.irc-all-events(self, $e);
+ return unless $res === IRC_NOT_HANDLED;
+ }
+
+ # Wait for END_MOTD or ERR_NOMOTD before attempting to join
+ if $e<command> eq '422' | '376' {
+ $.ssay("JOIN {@!channels[]}\n");
+ .irc-connected: self for @!plugs.grep(*.^can: 'irc-connected');
+ }
+
+ my $nick = $!nick;
+ if ( ( $e<command> eq 'PRIVMSG' and $e<params>[0] eq $nick )
+ or ( $e<command> eq 'NOTICE' and $e<params>[0] eq $nick )
+ or ( $e<command> eq 'PRIVMSG'
+ and $e<params>[1] ~~ /:i ^ $nick <[,:]> \s+/
+ )
+ ) {
+ my %res = :where($e<who><nick> ),
+ :who( $e<who><nick> ),
+ :how( $e<command> ),
+ :what( $e<params>[1] );
+
+ %res<where> = $e<params>[0] # this message was said in the channel
+ unless ( $e<command> eq 'PRIVMSG' and $e<params>[0] eq $nick )
+ or ( $e<command> eq 'NOTICE' and $e<params>[0] eq $nick );
+
+ %res<what>.subst-mutate: /:i ^ $nick <[,:]> \s+/, ''
+ if %res<where> ~~ /^ <[#&]>/;
+
+ for @!plugs.grep(*.^can: 'irc-to-me') -> $p {
+ my $res = $p.irc-to-me(self, $e, %res);
+ return unless $res === IRC_NOT_HANDLED;
+ }
+ }
+
+ if ( $e<command> eq 'PRIVMSG' and $e<params>[0] eq $!nick ) {
+ for @!plugs.grep(*.^can: 'irc-privmsg-me') -> $p {
+ my $res = $p.irc-privmsg-me(self, $e);
+ return unless $res === IRC_NOT_HANDLED;
+ }
+ }
+
+ if ( $e<command> eq 'NOTICE' and $e<params>[0] eq $!nick ) {
+ for @!plugs.grep(*.^can: 'irc-notice-me') -> $p {
+ my $res = $p.irc-notice-me(self, $e);
+ return unless $res === IRC_NOT_HANDLED;
+ }
+ }
+
+ my $cmd = 'irc-' ~ $e<command>.lc;
+ for @!plugs.grep(*.^can: $cmd) -> $p {
+ my $res = $p."$cmd"(self, $e);
+ return unless $res === IRC_NOT_HANDLED;
+ }
+
+ for @!plugs.grep(*.^can: 'irc-unhandled') -> $p {
+ my $res = $p.irc-unhandled(self, $e);
+ return unless $res === IRC_NOT_HANDLED;
+ }
+}
+
+method notice (Str $who, Str $what) {
+ my $msg = "NOTICE $who :$what\n";
+ $!debug and "{plug-name}$msg".put;
+ $!sock.print("$msg\n");
+ self;
+}
+
+method privmsg (Str $who, Str $what) {
+ my $msg = "PRIVMSG $who :$what\n";
+ $!debug and "{plug-name}$msg".put;
+ $!sock.print("$msg\n");
+ self;
+}
+
+method respond (
+ Str:D :$how = 'privmsg',
+ Str:D :$where is required,
+ Str:D :$what is required is copy,
+ Str:D :$who,
+ :$when where Any|Dateish|Instant;
+ # TODO: remove Any: https://rt.perl.org/Ticket/Display.html?id=127142
+) {
+ $what = "$who, $what" if $who and $where ~~ /^<[#&]>/;
+ my $method = $how.fc eq 'PRIVMSG'.fc ?? 'privmsg'
+ !! $how.fc eq 'NOTICE'.fc ?? 'notice'
+ !! fail 'Unknown :$how specified. Use PRIVMSG or NOTICE';
+
+ if $when {
+ Promise.at($when).then: { self."$method"($where, $what) };
+ CATCH { warn .backtrace }
+ }
+ else {
+ self."$method"($where, $what);
+ }
+ self;
+}
+
+method run {
+ .irc-start-up: self for @!plugs.grep(*.^can: 'irc-start-up');
+
+ await IO::Socket::Async.connect( $!host, $!port ).then({
+ $!sock = .result;
+ $.ssay("PASS $!password\n") if $!password.defined;
+ $.ssay("NICK $!nick\n");
+ $.ssay("USER $!username $!username $!host :$!userreal\n");
+
+ # my $left-overs = '';
+ react {
+ whenever $!sock.Supply :bin -> $buf is copy {
+ my $str = try $buf.decode: 'utf8';
+ $str or $str = $buf.decode: 'latin-1';
+ # $str ~= $left-overs;
+ $!debug and "[server {DateTime.now}] {$str}".put;
+ my $events = parse-irc $str;
+ for @$events -> $e {
+ self.handle-event: $e;
+ CATCH { warn .backtrace }
+ }
+ }
+
+ CATCH { warn .backtrace }
+ }
+
+ say "Closing connection";
+ $!sock.close;
+
+ # CATCH { warn .backtrace }
+ });
+}
+
+method ssay (Str:D $msg) {
+ $!debug and "{plug-name}$msg".put;
+ $!sock.print("$msg\n");
+ self;
+}
+
+#### HELPER SUBS
+
+sub plug-name {
+ my $plug = callframe(3).file;
+ my $cur = $?FILE;
+ return '[core] ' if $plug eq $cur;
+ $cur ~~ s/'.pm6'$//;
+ $plug ~~ s:g/^ $cur '/' | '.pm6'$//;
+ $plug ~~ s/'/'/::/;
+ return "[$plug] ";
+}
diff --git a/lib/old-IRC/Client/Plugin.pm6 b/lib/old-IRC/Client/Plugin.pm6
new file mode 100644
index 0000000..d73d7bd
--- /dev/null
+++ b/lib/old-IRC/Client/Plugin.pm6
@@ -0,0 +1,3 @@
+constant IRC_HANDLED = "irc plugin handled \x1";
+constant IRC_NOT_HANDLED = "irc plugin not-handled \x2";
+unit class IRC::Client::Plugin;
diff --git a/lib/old-IRC/Client/Plugin/Debugger.pm6 b/lib/old-IRC/Client/Plugin/Debugger.pm6
new file mode 100644
index 0000000..13b1461
--- /dev/null
+++ b/lib/old-IRC/Client/Plugin/Debugger.pm6
@@ -0,0 +1,8 @@
+use Data::Dump;
+use IRC::Client::Plugin;
+unit class IRC::Client::Plugin::Debugger is IRC::Client::Plugin;
+
+method irc-all-events ($irc, $e) {
+ say Dump $e, :indent(4);
+ return IRC_NOT_HANDLED;
+}
diff --git a/lib/old-IRC/Client/Plugin/PingPong.pm6 b/lib/old-IRC/Client/Plugin/PingPong.pm6
new file mode 100644
index 0000000..2651fd6
--- /dev/null
+++ b/lib/old-IRC/Client/Plugin/PingPong.pm6
@@ -0,0 +1,2 @@
+unit class IRC::Client::Plugin::PingPong;
+method irc-ping ($irc, $e) { $irc.ssay("PONG {$irc.nick} $e<params>[0]") }
diff --git a/lib/old-IRC/Grammar.pm6 b/lib/old-IRC/Grammar.pm6
new file mode 100644
index 0000000..c05322c
--- /dev/null
+++ b/lib/old-IRC/Grammar.pm6
@@ -0,0 +1,20 @@
+unit grammar IRC::Grammar;
+token TOP { <message>+ }
+token SPACE { ' '+ }
+token message { [':' <prefix> <SPACE> ]? <command> <params> \n }
+ token prefix {
+ [ <servername> || <nick> ['!' <user>]? ['@' <host>]? ]
+ <before <SPACE>>
+ }
+ token servername { <host> }
+ token nick { <letter> [ <letter> | <number> | <special> ]* }
+ token user { <-[\ \x0\r\n]>+? <before [<SPACE> | '@']>}
+ token host { <-[\s!@]>+ }
+ token command { <letter>+ | <number>**3 }
+ token params { <SPACE>* [ ':' <trailing> | <middle> <params> ]? }
+ token middle { <-[:\ \x0\r\n]> <-[\ \x0\r\n]>* }
+ token trailing { <-[\x0\r\n]>* }
+
+ token letter { <[a..zA..Z]> }
+ token number { <[0..9]> }
+ token special { <[-_\[\]\\`^{}]> }
diff --git a/lib/old-IRC/Grammar/Actions.pm6 b/lib/old-IRC/Grammar/Actions.pm6
new file mode 100644
index 0000000..234e392
--- /dev/null
+++ b/lib/old-IRC/Grammar/Actions.pm6
@@ -0,0 +1,26 @@
+unit class IRC::Grammar::Actions;
+method TOP ($/) { $/.make: $<message>>>.made }
+method message ($/) {
+ my $pref = $/<prefix>;
+ my %args = command => ~$/<command>;
+ for qw/nick user host/ {
+ $pref{$_}.defined or next;
+ %args<who>{$_} = $pref{$_}.Str;
+ }
+ %args<who><host> = ~$pref<servername> if $pref<servername>.defined;
+
+ my $p = $/<params>;
+
+ for ^100 { # bail out after 100 iterations; we're stuck
+ if ( $p<middle>.defined ) {
+ %args<params>.append: ~$p<middle>;
+ }
+ if ( $p<trailing>.defined ) {
+ %args<params>.append: ~$p<trailing>;
+ last;
+ }
+ $p = $p<params>;
+ }
+
+ $/.make: %args;
+}
diff --git a/lib/old-IRC/Parser.pm6 b/lib/old-IRC/Parser.pm6
new file mode 100644
index 0000000..dda05e6
--- /dev/null
+++ b/lib/old-IRC/Parser.pm6
@@ -0,0 +1,7 @@
+use IRC::Grammar;
+use IRC::Grammar::Actions;
+unit class IRC::Parser;
+
+sub parse-irc (Str:D $input) is export {
+ IRC::Grammar.parse($input, actions => IRC::Grammar::Actions).made // [];
+}
generated by cgit v1.1 at 2024-06-01 23:48:37 +0000