1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
|
unit class IRC::Client;
use IRC::Client::Grammar;
use IRC::Client::Grammar::Actions;
has Str:D $.host = 'localhost';
has Int:D $.debug = 0;
has Str $.password;
has Int:D $.port where 0 <= $_ <= 65535 = 6667;
has Str:D $.nick is rw = 'Perl6IRC';
has Str:D $.username = 'Perl6IRC';
has Str:D $.userhost = 'localhost';
has Str:D $.userreal = 'Perl6 IRC Client';
has Str:D @.channels = ['#perl6'];
has @.plugins;
has @.servers;
has IO::Socket::Async $!sock;
method run {
await IO::Socket::Async.connect( $!host, $!port ).then({
$!sock = .result;
self!ssay: "PASS $!password" if $!password.defined;
self!ssay: "NICK $!nick";
self!ssay: "USER $!username $!username $!host :$!userreal";
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;
(my $events, $left-overs) = self!parse: $str;
$str ~~ /$<left>=(\N*)$/;
for $events.grep: *.defined -> $e {
CATCH { warn .backtrace }
$!debug and debug-print $e, :in;
self!handle-event: $e;
}
}
}
$!sock.close;
});
}
method send-cmd ($cmd, *@args) {
@args[*-1] = ':' ~ @args[*-1];
self!ssay: join ' ', $cmd, @args;
}
method !handle-event ($e) {
given $e.command {
when '001' { self!ssay: "JOIN @.channels[]"; }
when 'PING' { $e.reply }
when 'JOIN' {
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;
$!sock.print("$msg\n");
self;
}
method !parse (Str:D $str) {
return |IRC::Client::Grammar.parse(
$str,
actions => IRC::Client::Grammar::Actions.new(
irc => self,
server => 'dummy',
),
).made;
}
sub debug-print (Str(Any) $str, :$in, :$out, :$sys) {
state &colored = try {
require Terminal::ANSIColor;
&colored
= GLOBAL::Terminal::ANSIColor::EXPORT::DEFAULT::<&colored>;
} // sub (Str $s) { '' };
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 {
die "Unknown debug print mode";
}
}
|
