From 11c9eec8eb2b5afabcee34c30e5bc3a092453724 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Thu, 28 Jul 2016 13:36:53 -0400 Subject: Implement multi-server interface --- lib/IRC/Client.pm6 | 179 ++++++++++++++++++++++++++------------------- lib/IRC/Client/Message.pm6 | 4 +- lib/IRC/Client/Server.pm6 | 17 +++++ 3 files changed, 123 insertions(+), 77 deletions(-) create mode 100644 lib/IRC/Client/Server.pm6 (limited to 'lib') 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 // %all-conf) ], + |%( + + .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 - = IO::Socket::Async.connect($s-conf, $s-conf).then: { - $!lock.protect: { $s-conf = .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.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.close; + $server.socket.close; CATCH { default { warn $_; warn .backtrace } } }; } - await Promise.allof: %!servers.values».; + 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 } = $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 }; } } @@ -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 ; - $s = @.channels; - $s = Nil; - } -} - method !ssay (Str:D $msg, :$server is copy) { $server //= '*'; $!debug and debug-print $msg, :out, :$server; - %!servers{ $server }.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 } -- cgit v1.1