From c56f8b4359f2730bb9e8bccd40bf2c9fa840f433 Mon Sep 17 00:00:00 2001
From: Zoffix Znet <cpan@zoffix.com>
Date: Sat, 4 Jun 2016 23:20:01 -0400
Subject: First working rewrite

---
 lib/IRC/Client.pm6 | 78 ++++++++++++++++++++++++++++++++----------------------
 1 file changed, 46 insertions(+), 32 deletions(-)

(limited to 'lib/IRC/Client.pm6')

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: ' ';
 }
-- 
cgit v1.1