blob: 49d1cff9448f10b51ea897fd519f239166aa1bc6 (
plain)
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
|
use v6;
use IRC::Parser; # parse-irc
use IRC::Client::Plugin::PingPong;
use IRC::Client::Plugin;
class IRC::Client:ver<2.002001> {
has Bool:D $.debug = False;
has Str:D $.host = 'localhost';
has Str:D $.password;
has Int:D $.port where 0 <= $_ <= 65535 = 6667;
has Str:D $.nick = 'Perl6IRC';
has Str:D $.username = 'Perl6IRC';
has Str:D $.userhost = 'localhost';
has Str:D $.userreal = 'Perl6 IRC Client';
has Str:D @.channels = ['#perl6bot'];
has IO::Socket::Async $.sock;
has @.plugins = [];
has @.plugins-essential = [
IRC::Client::Plugin::PingPong.new
];
has @!plugs = [|@!plugins-essential, |@!plugins];
method run {
.irc-start-up: self for @!plugs.grep(*.^can: 'irc-start-up');
await IO::Socket::Async.connect( $!host, $!port ).then({
$!sock = .result;
$.ssay("PASS $!password\n") if $!password.defined;
$.ssay("NICK $!nick\n");
$.ssay("USER $!username $!username $!host :$!userreal\n");
$.ssay("JOIN {@!channels[]} x\n");
.irc-connected: self for @!plugs.grep(*.^can: 'irc-connected');
# my $left-overs = '';
react {
whenever $!sock.Supply :bin -> $buf is copy {
my $str = try $buf.decode: 'utf8';
$str or $str = $buf.decode: 'latin-1';
# $str ~= $left-overs;
$!debug and "[server {DateTime.now}] {$str}".put;
my $events = parse-irc $str;
EVENTS: for @$events -> $e {
$e<pipe> = {};
for @!plugs.grep(*.^can: 'irc-all-events') -> $p {
my $res = $p.irc-all-events(self, $e);
next EVENTS unless $res === IRC_NOT_HANDLED;
}
if ( $e<command> eq 'PRIVMSG'
and $e<params>[0] eq $!nick
) {
for @!plugs.grep(*.^can: 'irc-privmsg-me') -> $p {
my $res = $p.irc-privmsg-me(self, $e);
next EVENTS unless $res === IRC_NOT_HANDLED;
}
}
if ( $e<command> eq 'NOTICE'
and $e<params>[0] eq $!nick
) {
for @!plugs.grep(*.^can: 'irc-notice-me') -> $p {
my $res = $p.irc-notice-me(self, $e);
next EVENTS unless $res === IRC_NOT_HANDLED;
}
}
my $cmd = 'irc-' ~ $e<command>.lc;
for @!plugs.grep(*.^can: $cmd) -> $p {
my $res = $p."$cmd"(self, $e);
next EVENTS unless $res === IRC_NOT_HANDLED;
}
for @!plugs.grep(*.^can: 'irc-unhandled') -> $p {
my $res = $p.irc-unhandled(self, $e);
next EVENTS unless $res === IRC_NOT_HANDLED;
}
CATCH { warn .backtrace }
}
}
CATCH { warn .backtrace }
}
say "Closing connection";
$!sock.close;
# CATCH { warn .backtrace }
});
}
method ssay (Str:D $msg) {
$!debug and "{plug-name}$msg".put;
$!sock.print("$msg\n");
self;
}
method privmsg (Str $who, Str $what) {
my $msg = "PRIVMSG $who :$what\n";
$!debug and "{plug-name}$msg".put;
$!sock.print("$msg\n");
self;
}
}
sub plug-name {
my $plug = callframe(3).file;
my $cur = $?FILE;
return '[core] ' if $plug eq $cur;
$cur ~~ s/'.pm6'$//;
$plug ~~ s:g/^ $cur '/' | '.pm6'$//;
$plug ~~ s/'/'/::/;
return "[$plug] ";
}
|
