aboutsummaryrefslogtreecommitdiff
path: root/lib/IRC/Client.pm6
diff options
context:
space:
mode:
authorZoffix Znet <cpan@zoffix.com>2016-06-04 23:20:01 -0400
committerZoffix Znet <cpan@zoffix.com>2016-06-04 23:20:01 -0400
commitc56f8b4359f2730bb9e8bccd40bf2c9fa840f433 (patch)
tree24d2021ab2794647aad2f44d802be160edfc485d /lib/IRC/Client.pm6
parent5a2196b2c8f2ac2eacb3ddaf40b3e75b9c38bb62 (diff)
First working rewrite
Diffstat (limited to 'lib/IRC/Client.pm6')
-rw-r--r--lib/IRC/Client.pm678
1 files changed, 46 insertions, 32 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: ' ';
}