First working rewrite

5 files changed, 84 insertions, 45 deletions

diff --git a/lib/IRC/Client.pm6 b/lib/IRC/Client.pm6
index 0c836a4..afc4303 100644
--- a/lib/IRC/Client.pm6
+++ b/lib/IRC/Client.pm6
@@ -4,10 +4,10 @@ use IRC::Client::Grammar;
 use IRC::Client::Grammar::Actions;
 
 has Str:D  $.host                        = 'localhost';
-has Bool   $.debug                       = False;
+has Int:D  $.debug                       = 0;
 has Str    $.password;
 has Int:D  $.port where 0 <= $_ <= 65535 = 6667;
-has Str:D  $.nick                        = 'Perl6IRC';
+has Str:D  $.nick is rw                  = 'Perl6IRC';
 has Str:D  $.username                    = 'Perl6IRC';
 has Str:D  $.userhost                    = 'localhost';
 has Str:D  $.userreal                    = 'Perl6 IRC Client';
@@ -23,23 +23,20 @@ method run {
         self!ssay: "NICK $!nick";
         self!ssay: "USER $!username $!username $!host :$!userreal";
 
-        my $left-overs = '';
         react {
             CATCH { warn .backtrace }
 
             whenever $!sock.Supply :bin -> $buf is copy {
+                state $left-overs = '';
                 my $str = try $buf.decode: 'utf8';
                 $str or $str = $buf.decode: 'latin-1';
-                $str ~= $left-overs;
+                $str = $left-overs ~ $str;
 
                 (my $events, $left-overs) = self!parse: $str;
                 $str ~~ /$<left>=(\N*)$/;
-                dd $str;
-                say "#### SHOULD Left over: `$<left>`";
-                say "#### LEFT OVERS: `$left-overs`";
                 for $events.grep: *.defined -> $e {
                     CATCH { warn .backtrace }
-                    $!debug and debug-print $e, 'in';
+                    $!debug and debug-print $e, :in;
                     self!handle-event: $e;
                 }
             }
@@ -58,19 +55,31 @@ method !handle-event ($e) {
         when '001'  { self!ssay: "JOIN @.channels[]"; }
         when 'PING' { $e.reply }
         when 'JOIN' {
-            say "Joined channel $e.channel()";
+            say "Joined channel $e.channel()"
+                if $e.nick eq $!nick;
         }
     }
+
+    my $method = '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';
+    }
+}
+
+method !plugs-that-can ($method) {
+    return @!plugins.grep(*.^can: $method);
 }
 
 method !ssay (Str:D $msg) {
-    $!debug and debug-print $msg, 'out';
+    $!debug and debug-print $msg, :out;
     $!sock.print("$msg\n");
     self;
 }
 
 method !parse (Str:D $str) {
-    return IRC::Client::Grammar.parse(
+    return |IRC::Client::Grammar.parse(
         $str,
         actions => IRC::Client::Grammar::Actions.new(
             irc    => self,
@@ -79,31 +88,36 @@ method !parse (Str:D $str) {
     ).made;
 }
 
-sub debug-print (Str(Any) $str, $dir where * eq 'in' | 'out') {
-    state $colored = try {
+sub debug-print (Str(Any) $str, :$in, :$out, :$sys) {
+    state &colored = try {
         require Terminal::ANSIColor;
-        $colored = GLOBAL::Terminal::ANSIColor::EXPORT::DEFAULT::<&colored>;
+        &colored
+        = GLOBAL::Terminal::ANSIColor::EXPORT::DEFAULT::<&colored>;
     } // sub (Str $s) { '' };
 
-    my @out;
-    if $str ~~ /^ '❚⚠❚'/ {
-        @out = $str.split: ' ', 3;
-        @out[0] = $colored(@out[0], 'bold white on_red');
-        @out[1] = @out[1] ~~ /^ <[0..9]>**3 $/
-            ?? $colored(@out[1], 'bold red')
-            !! $colored(@out[1], 'bold magenta');
-        @out[2] = $colored(@out[2], 'bold cyan');
+    my @bits = $str.split: ' ';
+    if $in {
+        my ($pref, $cmd) = 0, 1;
+        if @bits[0] eq '❚⚠❚' {
+            @bits[0] = colored @bits[0], 'bold white on_red';
+            $pref++; $cmd++;
+        }
+        @bits[$pref] = colored @bits[$pref], 'bold magenta';
+        @bits[$cmd] = @bits[$cmd] ~~ /^ <[0..9]>**3 $/
+            ?? colored(@bits[$cmd], 'bold red')
+            !! colored(@bits[$cmd], 'bold yellow');
+        put colored('▬▬▶ ', 'bold blue' ) ~ @bits.join: ' ';
+    }
+    elsif $out {
+        @bits[0] = colored @bits[0], 'bold magenta';
+        put colored('◀▬▬ ', 'bold green') ~ @bits.join: ' ';
+    }
+    elsif $sys {
+        put colored(' ' x 4 ~ '↳', 'bold white') ~ ' '
+            ~ @bits.join(' ')
+                .subst: /(\`<-[`]>+\`)/, { colored(~$0, 'bold cyan') };
     }
     else {
-        @out = $str.split: ' ', 2;
-        @out[0] = @out[0] ~~ /^ <[0..9]>**3 $/
-            ?? $colored(@out[0], 'bold red')
-            !! $colored(@out[0], 'bold magenta');
-        @out[1] = $colored(@out[1], 'bold cyan');
+        die "Unknown debug print mode";
     }
-
-    put ( $dir eq 'in'
-        ?? $colored('▬▬▶ ', 'bold blue' )
-        !! $colored('◀▬▬ ', 'bold green')
-    ) ~ @out.join: ' ';
 }
diff --git a/lib/IRC/Client/Grammar.pm6 b/lib/IRC/Client/Grammar.pm6
index a258e56..feec9fd 100644
--- a/lib/IRC/Client/Grammar.pm6
+++ b/lib/IRC/Client/Grammar.pm6
@@ -1,6 +1,6 @@
 unit grammar IRC::Client::Grammar;
-token TOP { <message>+ <leftovers> }
-token leftovers { \N* }
+token TOP { <message>+ <left-overs> }
+token left-overs { \N* }
 token SPACE { ' '+ }
 token message { [':' <prefix> <SPACE> ]? <command> <params> \n }
     token prefix  {
diff --git a/lib/IRC/Client/Grammar/Actions.pm6 b/lib/IRC/Client/Grammar/Actions.pm6
index 6ebe33d..cf702f8 100644
--- a/lib/IRC/Client/Grammar/Actions.pm6
+++ b/lib/IRC/Client/Grammar/Actions.pm6
@@ -40,8 +40,8 @@ method message ($match) {
         irc      => $!irc,
         nick     => %args<who><nick>//'',
         server   => $!server,
+        usermask => ~($match<prefix>//''),
         username => %args<who><user>//'';
-    .<usermask> = .<nick> ~ '!' ~ .<username> ~ '@' ~ .<host> given %msg-args;
 
     my $msg;
     given %msg-args<command> {
@@ -53,11 +53,17 @@ method message ($match) {
                 :channel( %args<params>[0] ),
                 |%msg-args;
         }
-        when 'NOTICE'  { $msg = msg-notice  %args, %msg-args }
-        when 'MODE'    { $msg = msg-mode    %args, %msg-args }
-        when 'PING'    { $msg = IRC::Client::Message::Ping.new: |%msg-args; }
-        when 'PRIVMSG' { $msg = msg-privmsg %args, %msg-args }
-        default { $msg = IRC::Client::Message::Unknown.new: |%msg-args }
+        when 'PART' {
+            $msg = IRC::Client::Message::Part.new:
+                :channel( %args<params>[0] ),
+                |%msg-args;
+        }
+        when 'NOTICE'  { $msg = msg-notice  %args, %msg-args                  }
+        when 'MODE'    { $msg = msg-mode    %args, %msg-args                  }
+        when 'PING'    { $msg = IRC::Client::Message::Ping.new: |%msg-args    }
+        when 'PRIVMSG' { $msg = msg-privmsg %args, %msg-args                  }
+        when 'QUIT'    { $msg = IRC::Client::Message::Quit.new: |%msg-args    }
+        default        { $msg = IRC::Client::Message::Unknown.new: |%msg-args }
     }
 
     $match.make: $msg;
diff --git a/lib/IRC/Client/Message.pm6 b/lib/IRC/Client/Message.pm6
index 4abb718..1b38d23 100644
--- a/lib/IRC/Client/Message.pm6
+++ b/lib/IRC/Client/Message.pm6
@@ -10,7 +10,7 @@ role IRC::Client::Message {
     has Str:D $.server   is required;
     has       @.args     is required;
 
-    method Str { "$.command @.args[]" }
+    method Str { ":$!usermask $!command @!args[]" }
 }
 
 constant M = IRC::Client::Message;
@@ -23,11 +23,26 @@ role Mode             does M       { has @.modes;                            }
 role Mode::Channel    does Mode    { has $.channel;                          }
 role Mode::Me         does Mode    {                                         }
 role Numeric          does M       {                                         }
-role Privmsg          does M       { has $.text;                             }
-role Privmsg::Channel does Privmsg { has $.channel;                          }
-role Privmsg::Me      does Privmsg {                                         }
-role Unknown          does M       { method Str { "❚⚠❚ $.command @.args[]" } }
+role Part             does M       { has $.channel;                          }
+role Quit             does M       {                                         }
+role Unknown          does M       {
+    method Str { "❚⚠❚ :$.usermask $.command @.args[]" }
+}
 
 role Ping does M {
     method reply { $.irc.send-cmd: 'PONG', @.args; }
 }
+
+role Privmsg does M { has $.text; }
+role Privmsg::Channel does Privmsg {
+    has $.channel;
+    method reply ($text, :$where) {
+        $.irc.send-cmd: 'PRIVMSG', $where // $.channel, $text;
+    }
+}
+role Privmsg::Me does Privmsg {
+    method reply ($text, :$where) {
+        $where //= $.nick;
+        $.irc.send-cmd: 'PRIVMSG', $where, $text;
+    }
+}
diff --git a/lib/IRC/Client/Plugin.pm6 b/lib/IRC/Client/Plugin.pm6
new file mode 100644
index 0000000..2493c3f
--- /dev/null
+++ b/lib/IRC/Client/Plugin.pm6
@@ -0,0 +1,4 @@
+unit role IRC::Client::Plugin;
+
+has $.IRC_HANDLED     = my class IRC_FLAG_HANDLED     {};
+has $.IRC_NOT_HANDLED = my class IRC_FLAG_NOT_HANDLED {};