From 18615cc9bb33801fbde2716513071e7b32af2ab2 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sun, 24 Jul 2016 16:20:12 -0400 Subject: moar work --- lib/IRC/Client.pm6 | 119 ++++++++++++++++++++++++++++++------- lib/IRC/Client/Grammar/Actions.pm6 | 2 +- lib/IRC/Client/Message.pm6 | 35 ++++++++--- lib/IRC/Client/Plugin.pm6 | 4 -- 4 files changed, 128 insertions(+), 32 deletions(-) delete mode 100644 lib/IRC/Client/Plugin.pm6 (limited to 'lib') diff --git a/lib/IRC/Client.pm6 b/lib/IRC/Client.pm6 index dc86287..06c030f 100644 --- a/lib/IRC/Client.pm6 +++ b/lib/IRC/Client.pm6 @@ -3,6 +3,13 @@ unit class IRC::Client; use IRC::Client::Grammar; use IRC::Client::Grammar::Actions; +my class IRC_FLAG_NEXT {}; + +role IRC::Client::Plugin is export { + my IRC_FLAG_NEXT $.NEXT; + has $.irc is rw; +} + has Str:D $.host = 'localhost'; has Int:D $.debug = 0; has Str $.password; @@ -14,6 +21,9 @@ has Str:D $.userreal = 'Perl6 IRC Client'; has Str:D @.channels = ['#perl6']; has @.plugins; has %.servers; +has Bool $!is-connected = False; +has Lock $!lock = Lock.new; +has Channel $!event-pipe = Channel.new; my &colored = try { require Terminal::ANSIColor; @@ -23,12 +33,26 @@ my &colored = try { method run { self!prep-servers; + .irc = self for @.plugins.grep: { .DEFINITE and .^can: 'irc' }; + + start { + my $closed = $!event-pipe.closed; + loop { + if $!event-pipe.receive -> $e { + $!debug and debug-print $e, :in, :server($e.server); + $!lock.protect: { + self!handle-event: $e; + CATCH { default { warn $_; warn .backtrace } } + }; + } + elsif $closed { last } + } + } - my $lock = Lock.new; for %!servers.kv -> $s-name, $s-conf { $s-conf = IO::Socket::Async.connect($s-conf, $s-conf).then: { - $lock.protect: { $s-conf = .result; }; + $!lock.protect: { $s-conf = .result; }; self!ssay: "PASS $!password", :server($s-name) if $!password.defined; @@ -39,8 +63,6 @@ method run { my $left-overs = ''; react { - CATCH { warn .backtrace } - whenever $s-conf.Supply :bin -> $buf is copy { my $str = try $buf.decode: 'utf8'; $str or $str = $buf.decode: 'latin-1'; @@ -48,19 +70,29 @@ method run { (my $events, $left-overs) = self!parse: $str, :server($s-name); - for $events.grep: *.defined -> $e { - $!debug and debug-print $e, :in, :server($e.server); - $lock.protect: { self!handle-event: $e; }; - } + $!event-pipe.send: $_ for $events.grep: *.defined; } + CATCH { default { warn $_; warn .backtrace } } } $s-conf.close; + CATCH { default { warn $_; warn .backtrace } } }; } await Promise.allof: %!servers.values».; } -method send-cmd ($cmd, *@args, :$server) { +method emit-custom (|c) { + $!event-pipe.send: c; +} + +method send (:$where!, :$text!, :$server, :$notice) { + for $server || |%!servers.keys.sort { + self.send-cmd: $notice ?? 'NOTICE' !! 'PRIVMSG', $where, $text, + :server($_); + } +} + +method send-cmd ($cmd, *@args is copy, :$server) { @args[*-1] = ':' ~ @args[*-1]; self!ssay: :$server, join ' ', $cmd, @args; } @@ -82,23 +114,73 @@ method !handle-event ($e) { %!servers{ $e.server } = $e.args[0]; self!ssay: "JOIN $_", :server($e.server) for @.channels; } - when 'PING' { $e.reply } + when 'PING' { return $e.reply; } when 'JOIN' { # say "Joined channel $e.channel() on $e.server()" # if $e.nick eq %!servers{ $e.server }; } } - my $method = 'irc-' ~ $e.^name.subst('IRC::Client::Message::', '') + my $event-name = 'irc-' ~ $e.^name.subst('IRC::Client::Message::', '') .lc.subst: '::', '-', :g; - $!debug >= 2 and debug-print "emitting `$method`", :sys; - for self!plugs-that-can: $method { - last if ."$method"($e).?^name.&[eq]: 'IRC_FLAG_HANDLED'; + + my @events = flat gather { + given $event-name { + when 'irc-privmsg-channel' | 'irc-notice-channel' { + my $nick = $!nick; + if $e.text.subst-mutate: /^ $nick <[,:\s]> \s* /, '' { + take 'irc-addressed', ('irc-to-me' if $!is-connected); + } + elsif $e ~~ / << $nick >> / and $!is-connected { + take 'irc-mentioned'; + } + take $event-name, $event-name eq 'irc-privmsg-channel' + ?? 'irc-privmsg' !! 'irc-notice'; + } + when 'irc-privmsg-me' { + take $event-name, ('irc-to-me' if $!is-connected), + 'irc-privmsg'; + } + when 'irc-notice-me' { + take $event-name, ('irc-to-me' if $!is-connected), + 'irc-notice'; + } + when 'irc-mode-channel' | 'irc-mode-me' { + take $event-name, 'irc-mode'; + } + when 'irc-numeric' { + if $e.command eq '001' { + $!is-connected = True ; + take 'irc-connected'; + } + take 'irc-' ~ $e.command, $event-name; + } + } + take 'irc-all'; + } + + EVENT: for @events -> $event { + debug-print "emitting `$event`", :sys + if $!debug >= 3 or ($!debug == 2 and not $event eq 'irc-all'); + + for self!plugs-that-can($event, $e) { + my $res = ."$event"($e); + next if $res ~~ IRC_FLAG_NEXT; + $e.reply: $res unless $res ~~ Nil; + last EVENT; + + CATCH { default { warn $_, .backtrace; } } + } } } -method !plugs-that-can ($method) { - return @!plugins.grep(*.^can: $method); +method !plugs-that-can ($method, $e) { + gather { + for @!plugins -> $plug { + take $plug if .cando: \($plug, $e) + for $plug.^can: $method; + } + } } method !ssay (Str:D $msg, :$server = '*') { @@ -110,10 +192,7 @@ method !ssay (Str:D $msg, :$server = '*') { method !parse (Str:D $str, :$server) { return |IRC::Client::Grammar.parse( $str, - actions => IRC::Client::Grammar::Actions.new( - irc => self, - server => $server, - ), + :actions( IRC::Client::Grammar::Actions.new: :irc(self), :$server ) ).made; } diff --git a/lib/IRC/Client/Grammar/Actions.pm6 b/lib/IRC/Client/Grammar/Actions.pm6 index 7c16227..b1fcc53 100644 --- a/lib/IRC/Client/Grammar/Actions.pm6 +++ b/lib/IRC/Client/Grammar/Actions.pm6 @@ -45,7 +45,7 @@ method message ($match) { my $msg; given %msg-args { - when /^ $=(<[0..9]>**3) $/ { + when /^ <[0..9]>**3 $/ { $msg = IRC::Client::Message::Numeric.new: |%msg-args; } when 'JOIN' { diff --git a/lib/IRC/Client/Message.pm6 b/lib/IRC/Client/Message.pm6 index 74261c9..84eba2c 100644 --- a/lib/IRC/Client/Message.pm6 +++ b/lib/IRC/Client/Message.pm6 @@ -16,9 +16,6 @@ role IRC::Client::Message { constant M = IRC::Client::Message; role Join does M { has $.channel; } -role Notice does M { has $.text; } -role Notice::Channel does Notice { has $.channel; } -role Notice::Me does Notice { } role Mode does M { has @.modes; } role Mode::Channel does Mode { has $.channel; } role Mode::Me does Mode { } @@ -34,16 +31,40 @@ role Ping does M { method reply { $.irc.send-cmd: 'PONG', $.args, :$.server; } } -role Privmsg does M { has $.text; } +role Privmsg does M { + has $.text is rw; + has Bool $.replied is rw = False; + method Str { $.text } +} role Privmsg::Channel does Privmsg { has $.channel; method reply ($text, :$where) { - $.irc.send-cmd: 'PRIVMSG', $where // $.channel, $text, :$.server; + $.irc.send-cmd: 'PRIVMSG', $where // $.channel, "$.nick, $text", + :$.server; } } role Privmsg::Me does Privmsg { method reply ($text, :$where) { - $where //= $.nick; - $.irc.send-cmd: 'PRIVMSG', $where, $text, :$.server; + $.irc.send-cmd: 'PRIVMSG', $where // $.nick, $text, :$.server; + } +} + +role Notice does M { + has $.text is rw; + has Bool $.replied is rw = False; + method Str { $.text } +} +role Notice::Channel does Notice { + has $.channel; + method reply ($text, :$where) { + $.irc.send-cmd: 'NOTICE', $where // $.channel, "$.nick, $text", + :$.server; + $.replied = True; + } +} +role Notice::Me does Notice { + method reply ($text, :$where) { + $.irc.send-cmd: 'NOTICE', $where // $.nick, $text, :$.server; + $.replied = True; } } diff --git a/lib/IRC/Client/Plugin.pm6 b/lib/IRC/Client/Plugin.pm6 deleted file mode 100644 index 2493c3f..0000000 --- a/lib/IRC/Client/Plugin.pm6 +++ /dev/null @@ -1,4 +0,0 @@ -unit role IRC::Client::Plugin; - -has $.IRC_HANDLED = my class IRC_FLAG_HANDLED {}; -has $.IRC_NOT_HANDLED = my class IRC_FLAG_NOT_HANDLED {}; -- cgit v1.1