Start rewrite

5 files changed, 177 insertions, 14 deletions

diff --git a/examples/bot.pl6 b/examples/bot.pl6
index 524a74f..3737de1 100644
--- a/examples/bot.pl6
+++ b/examples/bot.pl6
@@ -1,20 +1,8 @@
 use v6;
 use lib 'lib';
 use IRC::Client;
-use IRC::Client::Plugin::Debugger;
-
-class IRC::Client::Plugin::AddressedPlugin is IRC::Client::Plugin {
-    method irc-addressed ($irc, $e, $where) {
-        $irc.privmsg: $where[0], "$where[1], you addressed me";
-    }
-}
 
 my $irc = IRC::Client.new(
-    :host<localhost>
-    :channels<#perl6bot #zofbot>
     :debug
-    :plugins(
-        IRC::Client::Plugin::Debugger.new,
-        IRC::Client::Plugin::AddressedPlugin.new
-    )
-).run;
\ No newline at end of file
+    :port<5667>
+).run;
diff --git a/lib/IRC/Client.pm6 b/lib/IRC/Client.pm6
index e69de29..7c30c4a 100644
--- a/lib/IRC/Client.pm6
+++ b/lib/IRC/Client.pm6
@@ -0,0 +1,56 @@
+unit class IRC::Client;
+
+use IRC::Client::Grammar;
+use IRC::Client::Grammar::Actions;
+
+has Str:D  $.host                        = 'localhost';
+has Bool   $.debug                       = False;
+has Str    $.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                    = ['#perl6'];
+has        @.plugins;
+has IO::Socket::Async   $!sock;
+
+method run {
+    await IO::Socket::Async.connect( $!host, $!port ).then({
+        $!sock = .result;
+        self!ssay: "PASS $!password\n" if $!password.defined;
+        self!ssay: "NICK $!nick\n";
+        self!ssay: "USER $!username $!username $!host :$!userreal\n";
+
+        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, $left-overs) = IRC::Client::Grammar.parse(
+                    $str, actions => IRC::Client::Grammar::Actions
+                ).made;
+
+                for @$events -> $e {
+                    say "[event] $e";
+                    CATCH { warn .backtrace }
+                }
+            }
+
+            CATCH { warn .backtrace }
+        }
+
+        say "Closing connection";
+        $!sock.close;
+
+        # CATCH { warn .backtrace }
+    });
+}
+
+method !ssay (Str:D $msg) {
+    $!debug and "$msg".put;
+    $!sock.print("$msg\n");
+    self;
+}
diff --git a/lib/IRC/Client/Grammar.pm6 b/lib/IRC/Client/Grammar.pm6
new file mode 100644
index 0000000..255528a
--- /dev/null
+++ b/lib/IRC/Client/Grammar.pm6
@@ -0,0 +1,21 @@
+unit grammar IRC::Client::Grammar;
+token TOP { <message>+ <leftovers> }
+token leftovers { \N* }
+token SPACE { ' '+ }
+token message { [':' <prefix> <SPACE> ]? <command> <params> \n }
+    token prefix  {
+        [ <servername> || <nick> ['!' <user>]? ['@' <host>]? ]
+        <before <SPACE>>
+    }
+        token servername { <host> }
+        token nick { <letter> [ <letter> | <number> | <special> ]* }
+        token user { <-[\ \x0\r\n]>+?  <before [<SPACE> | '@']>}
+        token host { <-[\s!@]>+ }
+    token command { <letter>+ | <number>**3 }
+    token params { <SPACE>* [ ':' <trailing> | <middle> <params> ]? }
+        token middle { <-[:\ \x0\r\n]> <-[\ \x0\r\n]>* }
+        token trailing { <-[\x0\r\n]>* }
+
+    token letter { <[a..zA..Z]> }
+    token number { <[0..9]> }
+    token special { <[-_\[\]\\`^{}]> }
diff --git a/lib/IRC/Client/Grammar/Actions.pm6 b/lib/IRC/Client/Grammar/Actions.pm6
new file mode 100644
index 0000000..74ae4e8
--- /dev/null
+++ b/lib/IRC/Client/Grammar/Actions.pm6
@@ -0,0 +1,31 @@
+unit class IRC::Client::Grammar::Actions;
+
+method TOP ($/) { $/.make: ($<message>».made, $<left-overs>) }
+method left-overs ($/) {
+    $/.made: $/.defined ?? !$/ !! '';
+}
+
+method message ($/) {
+    my $pref = $/<prefix>;
+    my %args = command => ~$/<command>;
+    for qw/nick user host/ {
+        $pref{$_}.defined or next;
+        %args<who>{$_} = $pref{$_}.Str;
+    }
+    %args<who><host> = ~$pref<servername> if $pref<servername>.defined;
+
+    my $p = $/<params>;
+
+    for ^100 { # bail out after 100 iterations; we're stuck
+        if ( $p<middle>.defined ) {
+            %args<params>.append: ~$p<middle>;
+        }
+        if ( $p<trailing>.defined ) {
+            %args<params>.append: ~$p<trailing>;
+            last;
+        }
+        $p = $p<params>;
+    }
+
+    $/.make: %args;
+}
diff --git a/t/release/servers/01-basic.pl b/t/release/servers/01-basic.pl
new file mode 100644
index 0000000..fe5ea06
--- /dev/null
+++ b/t/release/servers/01-basic.pl
@@ -0,0 +1,67 @@
+# A fairly simple example:
+use strict;
+use warnings;
+use POE qw(Component::Server::IRC);
+
+my %config = (
+    servername => 'simple.poco.server.irc',
+    nicklen    => 15,
+    network    => 'SimpleNET'
+);
+
+my $pocosi = POE::Component::Server::IRC->spawn( config => \%config );
+
+POE::Session->create(
+    package_states => [
+        'main' => [qw(_start _default)],
+    ],
+    heap => { ircd => $pocosi },
+);
+
+$poe_kernel->run();
+
+sub _start {
+    my ($kernel, $heap) = @_[KERNEL, HEAP];
+
+    $heap->{ircd}->yield('register', 'all');
+
+    # Anyone connecting from the loopback gets spoofed hostname
+    # $heap->{ircd}->add_auth(
+    #     mask     => '*@localhost',
+    #     spoof    => 'm33p.com',
+    #     no_tilde => 1,
+    # );
+
+    # We have to add an auth as we have specified one above.
+    $heap->{ircd}->add_auth(mask => '*@*');
+
+    # Start a listener on the 'standard' IRC port.
+    $heap->{ircd}->add_listener(port => 5667);
+
+    # Add an operator who can connect from localhost
+    $heap->{ircd}->add_operator(
+        {
+            username => 'moo',
+            password => 'fishdont',
+        }
+    );
+}
+
+sub _default {
+    my ($event, @args) = @_[ARG0 .. $#_];
+
+    print "$event: ";
+    for my $arg (@args) {
+        if (ref($arg) eq 'ARRAY') {
+            print "[", join ( ", ", @$arg ), "] ";
+        }
+        elsif (ref($arg) eq 'HASH') {
+            print "{", join ( ", ", %$arg ), "} ";
+        }
+        else {
+            print "'$arg' ";
+        }
+    }
+
+    print "\n";
+ }