diff options
Diffstat (limited to 'lib/old-IRC')
-rw-r--r-- | lib/old-IRC/Client.pm6 | 174 | ||||
-rw-r--r-- | lib/old-IRC/Client/Plugin.pm6 | 3 | ||||
-rw-r--r-- | lib/old-IRC/Client/Plugin/Debugger.pm6 | 8 | ||||
-rw-r--r-- | lib/old-IRC/Client/Plugin/PingPong.pm6 | 2 | ||||
-rw-r--r-- | lib/old-IRC/Grammar.pm6 | 20 | ||||
-rw-r--r-- | lib/old-IRC/Grammar/Actions.pm6 | 26 | ||||
-rw-r--r-- | lib/old-IRC/Parser.pm6 | 7 |
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 // []; +} |