aboutsummaryrefslogtreecommitdiff
path: root/lib/IRC/Client.pm6
blob: 7b1c7e5f5093ceff0c52b964aad2ce4356afb440 (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
use v6;
use IRC::Parser; # parse-irc
use IRC::Client::Plugin::PingPong;
use IRC::Client::Plugin;
class IRC::Client:ver<1.002001> {
    has Bool:D $.debug                          = False;
    has Str:D  $.host                           = 'localhost';
    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 {
        await IO::Socket::Async.connect( $!host, $!port ).then({
            $!sock = .result;
            $.ssay("NICK $!nick\n");
            $.ssay("USER $!username $!userhost $!host :$!userreal\n");
            $.ssay("JOIN $_\n") for @!channels;

            .register: self for @!plugs.grep(*.^can: 'register');

            react {
                whenever $!sock.Supply -> $str is copy {
                    $!debug and "[server {DateTime.now}] {$str}".put;
                    my $events = parse-irc $str;
                    EVENTS: for @$events -> $e {
                        $e<pipe>    = {};

                        if ( $e<command> eq 'PRIVMSG'
                            and $e<params>[0] eq $!nick
                        ) {
                            for @!plugs.grep(*.^can: 'privmsg-me') -> $p {
                                my $res = $p.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: 'notice-me') -> $p {
                                my $res = $p.notice-me(self, $e);
                                next EVENTS unless $res === IRC_NOT_HANDLED;
                            }
                        }

                        for @!plugs.grep(*.^can: 'all-events') -> $p {
                            my $res = $p.all-events(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: 'unhandled') -> $p {
                            my $res = $p.unhandled(self, $e);
                            next EVENTS unless $res === IRC_NOT_HANDLED;
                        }
                    }
                }
            }

            say "Closing connection";
            $!sock.close;
        });
    }

    method ssay (Str:D $msg) {
        $!debug and "{plug-name}$msg".put;
        $!sock.print("$msg\n");
        self;
    }

    method privmsg (Str $who, Str $what) {
        my $msg = ":$!nick!$!username\@$!userhost 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] ";
}