Implement multi-server interface

3 files changed, 123 insertions, 77 deletions

diff --git a/lib/IRC/Client.pm6 b/lib/IRC/Client.pm6
index ceacb95..1bd62cf 100644
--- a/lib/IRC/Client.pm6
+++ b/lib/IRC/Client.pm6
@@ -1,6 +1,7 @@
 unit class IRC::Client;
 
 use IRC::Client::Grammar;
+use IRC::Client::Server;
 use IRC::Client::Grammar::Actions;
 
 my class IRC_FLAG_NEXT {};
@@ -10,22 +11,12 @@ role IRC::Client::Plugin is export {
     has $.irc is rw;
 }
 
-has Str:D  $.host                        = 'localhost';
-has Int:D  $.debug                       = 0;
-has Str    $.password;
-has Int:D  $.port where 0 <= $_ <= 65535 = 6667;
-has        @.nick                        = 'P6Bot', 'P6Bot_', 'P6Bot__';
-has Str:D  $.username                    = 'Perl6IRC';
-has Str:D  $.userhost                    = 'localhost';
-has Str:D  $.userreal                    = 'Perl6 IRC Client';
-has Str:D  @.channels                    = ['#perl6'];
-has        @.filters where .all ~~ Callable;
-has        @.plugins;
-has        %.servers;
-has Bool   $!is-connected                = False;
-has Lock   $!lock                        = Lock.new;
-has        $!current-nick                = @!nick[0];
-has Channel $!event-pipe                 = Channel.new;
+has @.filters where .all ~~ Callable;
+has %.servers where .values.all ~~ IRC::Client::Server;
+has @.plugins;
+has $.debug;
+has Lock    $!lock       = Lock.new;
+has Channel $!event-pipe = Channel.new;
 
 my &colored = try {
     require Terminal::ANSIColor;
@@ -33,16 +24,52 @@ my &colored = try {
     = GLOBAL::Terminal::ANSIColor::EXPORT::DEFAULT::<&colored>;
 } // sub (Str $s, $) { $s };
 
+submethod BUILD (
+            :@!filters,
+            :@!plugins,
+    Int:D   :$!debug = 0,
+
+            :%servers   is copy,
+    Int:D   :$port      where 0 <= $_ <= 65535   = 6667,
+    Str     :$password,
+    Str:D   :$host      = 'localhost',
+            :$nick      = ['P6Bot', 'P6Bot_', 'P6Bot__'],
+    Str:D   :$username  = 'Perl6IRC',
+    Str:D   :$userhost  = 'localhost',
+    Str:D   :$userreal  = 'Perl6 IRC Client',
+    Str:D   :$channels  = ['#perl6'],
+) {
+    my %all-conf = :$port,     :$password, :$host,     :$nick,
+                   :$username, :$userhost, :$userreal, :$channels;
+
+    %servers = '_' => {} unless %servers;
+    for %servers.keys -> $label {
+        my $conf = %servers{$label};
+        my $s = IRC::Client::Server.new(
+            :socket(Nil),
+            :$label,
+            :channels[ |($conf<channels> // %all-conf<channels>) ],
+            |%(
+                <host password port nick username userhost userreal>
+                    .map: { $_ => $conf{$_} // %all-conf{$_} }
+            ),
+        );
+        $s.nick = $s.nick[0].map: { $_ ~ '_' x $++ } if $s.nick.elems == 1;
+        $s.current-nick = $s.nick[0];
+        %!servers{$label} = $s;
+    }
+}
+
 method join (*@channels, :$server) {
     self.send-cmd: 'JOIN', $_, :$server for @channels;
     self;
 }
 
-method nick (*@nicks, :$server) {
-    return @!nick unless @nicks;
-    @nicks = @nicks.map: * ~ '_' x $++ if @nicks == 1;
-    @!nick = @nicks;
-    self.send-cmd: 'NICK', @!nick[0], :$server;
+method nick (*@nicks, :$server = '*') {
+    @nicks = @nicks.map: { $_ ~ '_' x $++ } if @nicks == 1;
+    self!set-server-attr($server, 'nick', @nicks);
+    self!set-server-attr($server, 'current-nick', @nicks[0]);
+    self.send-cmd: 'NICK', @nicks[0], :$server;
     self;
 }
 
@@ -51,8 +78,16 @@ method part (*@channels, :$server) {
     self;
 }
 
+method !set-server-attr ($server, $method, $what) {
+    if $server ne '*' {
+        %!servers{$server}."$method"() = $what;
+        return;
+    }
+
+    ."$method"() = $what for %!servers.values;
+}
+
 method run {
-    self!prep-servers;
     .irc = self for @.plugins.grep: { .DEFINITE and .^can: 'irc' };
 
     start {
@@ -67,38 +102,38 @@ method run {
             }
             elsif $closed { last }
         }
+        CATCH { default { warn $_; warn .backtrace } }
     }
 
-    for %!servers.kv -> $s-name, $s-conf {
-        $s-conf<promise>
-        = IO::Socket::Async.connect($s-conf<host>, $s-conf<port>).then: {
-            $!lock.protect: { $s-conf<sock> = .result; };
+    for %!servers.values -> $server {
+        $server.promise
+        = IO::Socket::Async.connect($server.host, $server.port).then: {
+            $!lock.protect: { $server.socket = .result; };
+
+            self!ssay: "PASS $server.password()", :$server
+                if $server.password.defined;
+            self!ssay: "NICK {$server.nick[0]}", :$server;
 
-            self!ssay: "PASS $!password", :server($s-name)
-                if $!password.defined;
-            self!ssay: "NICK @!nick[0]", :server($s-name);
-            self!ssay:
-                "USER $!username $!username $!host :$!userreal",
-                :server($s-name);
+            self!ssay: :$server, join ' ', 'USER', $server.username,
+                $server.username, $server.host, ':' ~ $server.userreal;
 
             my $left-overs = '';
             react {
-                whenever $s-conf<sock>.Supply :bin -> $buf is copy {
+                whenever $server.socket.Supply :bin -> $buf is copy {
                     my $str = try $buf.decode: 'utf8';
                     $str or $str = $buf.decode: 'latin-1';
                     $str = ($left-overs//'') ~ $str;
 
-                    (my $events, $left-overs)
-                    = self!parse: $str, :server($s-name);
+                    (my $events, $left-overs) = self!parse: $str, :$server;
                     $!event-pipe.send: $_ for $events.grep: *.defined;
                 }
                 CATCH { default { warn $_; warn .backtrace } }
             }
-            $s-conf<sock>.close;
+            $server.socket.close;
             CATCH { default { warn $_; warn .backtrace } }
         };
     }
-    await Promise.allof: %!servers.values».<promise>;
+    await Promise.allof: %!servers.values».promise;
 }
 
 method send (:$where!, :$text!, :$server, :$notice) {
@@ -111,21 +146,26 @@ method send (:$where!, :$text!, :$server, :$notice) {
 }
 
 method send-cmd ($cmd, *@args is copy, :$prefix = '', :$server) {
-    if $cmd eq 'NOTICE'|'PRIVMSG' and @!filters
-        and my @f = @!filters.grep({
-               .signature.ACCEPTS: \(@args[1])
-            or .signature.ACCEPTS: \(@args[1], where => @args[0])
-        })
-    {
-        start {
-            CATCH { default { warn $_; warn .backtrace } }
-            my ($where, $text) = @args;
-            for @f -> $f {
-                given $f.signature.params.elems {
-                    when 1 { $text = $f($text); }
-                    when 2 { ($text, $where) = $f($text, :$where) }
+    if $cmd eq 'NOTICE'|'PRIVMSG' {
+        my ($where, $text) = @args;
+        if @!filters
+            and my @f = @!filters.grep({
+                   .signature.ACCEPTS: \($text)
+                or .signature.ACCEPTS: \($text, :$where)
+            })
+        {
+            start {
+                CATCH { default { warn $_; warn .backtrace } }
+                for @f -> $f {
+                    given $f.signature.params.elems {
+                        when 1 { $text = $f($text); }
+                        when 2 { ($text, $where) = $f($text, :$where) }
+                    }
                 }
+                self!ssay: :$server, join ' ', $cmd, $where, ":$prefix$text";
             }
+        }
+        else {
             self!ssay: :$server, join ' ', $cmd, $where, ":$prefix$text";
         }
     }
@@ -143,15 +183,14 @@ method send-cmd ($cmd, *@args is copy, :$prefix = '', :$server) {
 ###############################################################################
 
 method !handle-event ($e) {
+    my $s = %!servers{ $e.server };
     given $e.command {
         when '001'  {
-            %!servers{ $e.server }<nick> = $e.args[0];
-            self!ssay: "JOIN $_", :server($e.server) for @.channels;
+            $s.current-nick = $e.args[0];
+            self!ssay: "JOIN $_", :server($s) for |$s.channels;
         }
         when 'PING' { return $e.reply; }
         when 'JOIN' {
-            # say "Joined channel $e.channel() on $e.server()"
-                # if $e.nick eq %!servers{ $e.server }<nick>;
         }
     }
 
@@ -161,22 +200,22 @@ method !handle-event ($e) {
     my @events = flat gather {
         given $event-name {
             when 'irc-privmsg-channel' | 'irc-notice-channel' {
-                my $nick = $!current-nick;
+                my $nick = $s.current-nick;
                 if $e.text.subst-mutate: /^ $nick <[,:\s]> \s* /, '' {
-                    take 'irc-addressed', ('irc-to-me' if $!is-connected);
+                    take 'irc-addressed', ('irc-to-me' if $s.is-connected);
                 }
-                elsif $e ~~ / << $nick >> / and $!is-connected {
+                elsif $e.text ~~ / << $nick >> / and $s.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),
+                take $event-name, ('irc-to-me' if $s.is-connected),
                     'irc-privmsg';
             }
             when 'irc-notice-me' {
-                take $event-name, ('irc-to-me' if $!is-connected),
+                take $event-name, ('irc-to-me' if $s.is-connected),
                     'irc-notice';
             }
             when 'irc-mode-channel' | 'irc-mode-me' {
@@ -184,7 +223,7 @@ method !handle-event ($e) {
             }
             when 'irc-numeric' {
                 if $e.command eq '001' {
-                    $!is-connected = True ;
+                    $s.is-connected = True;
                     take 'irc-connected';
                 }
                 take 'irc-' ~ $e.command, $event-name;
@@ -198,7 +237,7 @@ method !handle-event ($e) {
             if $!debug >= 3 or ($!debug == 2 and not $event eq 'irc-all');
 
         for self!plugs-that-can($event, $e) {
-            my $res = ."$event"($e);
+            my $res is default(Nil) = ."$event"($e);
             next if $res ~~ IRC_FLAG_NEXT;
 
             # Do not .reply with bogus return values
@@ -232,21 +271,11 @@ method !plugs-that-can ($method, $e) {
     }
 }
 
-method !prep-servers {
-    %!servers = '*' => {} unless %!servers;
-
-    for %!servers.values -> $s {
-        $s{$_} //= self."$_"()
-            for <host password port nick username userhost userreal>;
-        $s<channels> = @.channels;
-        $s<socket> = Nil;
-    }
-}
-
 method !ssay (Str:D $msg, :$server is copy) {
     $server //= '*';
     $!debug and debug-print $msg, :out, :$server;
-    %!servers{ $server }<sock>.print("$msg\n");
+    %!servers{$_}.socket.print: "$msg\n"
+        for |($server eq '*' ?? %!servers.keys.sort !! $server);
     self;
 }
 
@@ -257,9 +286,9 @@ method !ssay (Str:D $msg, :$server is copy) {
 ###############################################################################
 ###############################################################################
 
-sub debug-print (Str(Any) $str, :$in, :$out, :$sys, :$server) {
+sub debug-print (Str() $str, :$in, :$out, :$sys, :$server) {
     my $server-str = $server
-        ?? colored($server, 'bold white on_cyan') ~ ' ' !! '';
+        ?? colored(~$server, 'bold white on_cyan') ~ ' ' !! '';
 
     my @bits = $str.split: ' ';
     if $in {
diff --git a/lib/IRC/Client/Message.pm6 b/lib/IRC/Client/Message.pm6
index 9559fd1..89295e3 100644
--- a/lib/IRC/Client/Message.pm6
+++ b/lib/IRC/Client/Message.pm6
@@ -7,7 +7,7 @@ role IRC::Client::Message {
     has Str:D $.host     is required;
     has Str:D $.usermask is required;
     has Str:D $.command  is required;
-    has Str:D $.server   is required;
+    has       $.server   is required;
     has       $.args     is required;
 
     method Str { ":$!usermask $!command $!args[]" }
@@ -34,7 +34,7 @@ role Ping does M {
 role Privmsg does M {
     has      $.text    is rw;
     has Bool $.replied is rw = False;
-    method Str { $.text }
+    method ACCEPTS ($what) { $.text ~~ $what }
 }
 role Privmsg::Channel does Privmsg {
     has $.channel;
diff --git a/lib/IRC/Client/Server.pm6 b/lib/IRC/Client/Server.pm6
new file mode 100644
index 0000000..86f5253
--- /dev/null
+++ b/lib/IRC/Client/Server.pm6
@@ -0,0 +1,17 @@
+unit class IRC::Client::Server;
+
+has         @.channels where .all ~~ Str;
+has         @.nick     where .all ~~ Str;
+has Int     $.port     where 0 <= $_ <= 65535;
+has Str     $.label;
+has Str     $.host;
+has Str     $.password;
+has Str     $.username;
+has Str     $.userhost;
+has Str     $.userreal;
+has Str     $.current-nick     is rw;
+has Promise $.promise          is rw;
+has Bool    $.is-connected     is rw;
+has IO::Socket::Async $.socket is rw;
+
+method Str { $!label }