aboutsummaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
authorZoffix Znet <cpan@zoffix.com>2016-06-05 21:39:47 -0400
committerZoffix Znet <cpan@zoffix.com>2016-06-05 21:39:47 -0400
commit140959e4f170d732d990e69b9a0ca129b89e3ac4 (patch)
treec96d92c8eba8af28eea21585c1c0e5c8a18f69d7 /lib
parent16056e8af837a4d982d23728adf24b4cc406576c (diff)
First working test
Diffstat (limited to 'lib')
-rw-r--r--lib/IRC/Client.pm68
-rw-r--r--lib/IRC/Client/Grammar/Actions.pm65
-rw-r--r--lib/IRC/Client/Message.pm61
-rw-r--r--lib/IRC/Client/Message/Numeric.pm62
-rw-r--r--lib/IRC/Client/Message/Privmsg.pm64
-rw-r--r--lib/IRC/Client/Message/Privmsg/Channel.pm65
-rw-r--r--lib/IRC/Client/Message/Privmsg/Me.pm62
-rw-r--r--lib/IRC/Client/Message/Unknown.pm64
-rw-r--r--lib/old-IRC/Client.pm6174
-rw-r--r--lib/old-IRC/Client/Plugin.pm63
-rw-r--r--lib/old-IRC/Client/Plugin/Debugger.pm68
-rw-r--r--lib/old-IRC/Client/Plugin/PingPong.pm62
-rw-r--r--lib/old-IRC/Grammar.pm620
-rw-r--r--lib/old-IRC/Grammar/Actions.pm626
-rw-r--r--lib/old-IRC/Parser.pm67
15 files changed, 10 insertions, 261 deletions
diff --git a/lib/IRC/Client.pm6 b/lib/IRC/Client.pm6
index 96580cf..cacd7c1 100644
--- a/lib/IRC/Client.pm6
+++ b/lib/IRC/Client.pm6
@@ -37,14 +37,14 @@ method run {
"USER $!username $!username $!host :$!userreal",
:server($s-name);
+ my $left-overs = '';
react {
CATCH { warn .backtrace }
whenever $s-conf<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;
+ $str = ($left-overs//'') ~ $str;
(my $events, $left-overs)
= self!parse: $str, :server($s-name);
@@ -84,8 +84,8 @@ method !handle-event ($e) {
}
when 'PING' { $e.reply }
when 'JOIN' {
- say "Joined channel $e.channel()"
- if $e.nick eq %!servers{ $e.server }<nick>;
+ # say "Joined channel $e.channel() on $e.server()"
+ # if $e.nick eq %!servers{ $e.server }<nick>;
}
}
diff --git a/lib/IRC/Client/Grammar/Actions.pm6 b/lib/IRC/Client/Grammar/Actions.pm6
index cf702f8..7c16227 100644
--- a/lib/IRC/Client/Grammar/Actions.pm6
+++ b/lib/IRC/Client/Grammar/Actions.pm6
@@ -58,6 +58,11 @@ method message ($match) {
:channel( %args<params>[0] ),
|%msg-args;
}
+ when 'NICK' {
+ $msg = IRC::Client::Message::Nick.new:
+ :new-nick( %args<params>[0] ),
+ |%msg-args;
+ }
when 'NOTICE' { $msg = msg-notice %args, %msg-args }
when 'MODE' { $msg = msg-mode %args, %msg-args }
when 'PING' { $msg = IRC::Client::Message::Ping.new: |%msg-args }
diff --git a/lib/IRC/Client/Message.pm6 b/lib/IRC/Client/Message.pm6
index 9a51803..74261c9 100644
--- a/lib/IRC/Client/Message.pm6
+++ b/lib/IRC/Client/Message.pm6
@@ -22,6 +22,7 @@ role Notice::Me does Notice { }
role Mode does M { has @.modes; }
role Mode::Channel does Mode { has $.channel; }
role Mode::Me does Mode { }
+role Nick does M { has $.new-nick; }
role Numeric does M { }
role Part does M { has $.channel; }
role Quit does M { }
diff --git a/lib/IRC/Client/Message/Numeric.pm6 b/lib/IRC/Client/Message/Numeric.pm6
deleted file mode 100644
index c059eb4..0000000
--- a/lib/IRC/Client/Message/Numeric.pm6
+++ /dev/null
@@ -1,2 +0,0 @@
-use IRC::Client::Message;
-unit role IRC::Client::Message::Numeric does IRC::Client::Message;
diff --git a/lib/IRC/Client/Message/Privmsg.pm6 b/lib/IRC/Client/Message/Privmsg.pm6
deleted file mode 100644
index 31efdea..0000000
--- a/lib/IRC/Client/Message/Privmsg.pm6
+++ /dev/null
@@ -1,4 +0,0 @@
-use IRC::Client::Message;
-unit role IRC::Client::Message::Privmsg does IRC::Client::Message;
-
-has $.what;
diff --git a/lib/IRC/Client/Message/Privmsg/Channel.pm6 b/lib/IRC/Client/Message/Privmsg/Channel.pm6
deleted file mode 100644
index 36cf3d6..0000000
--- a/lib/IRC/Client/Message/Privmsg/Channel.pm6
+++ /dev/null
@@ -1,5 +0,0 @@
-use IRC::Client::Message::Privmsg;
-unit role IRC::Client::Message::Privmsg::Channel
- does IRC::Client::Message::Privmsg;
-
-has $.channel;
diff --git a/lib/IRC/Client/Message/Privmsg/Me.pm6 b/lib/IRC/Client/Message/Privmsg/Me.pm6
deleted file mode 100644
index 1ff31ba..0000000
--- a/lib/IRC/Client/Message/Privmsg/Me.pm6
+++ /dev/null
@@ -1,2 +0,0 @@
-use IRC::Client::Message::Privmsg;
-unit role IRC::Client::Message::Privmsg::Me does IRC::Client::Message::Privmsg;
diff --git a/lib/IRC/Client/Message/Unknown.pm6 b/lib/IRC/Client/Message/Unknown.pm6
deleted file mode 100644
index 91baa79..0000000
--- a/lib/IRC/Client/Message/Unknown.pm6
+++ /dev/null
@@ -1,4 +0,0 @@
-use IRC::Client::Message;
-unit role IRC::Client::Message::Unknown does IRC::Client::Message;
-
-method Str { "❚⚠❚ $.command @.args[]" }
diff --git a/lib/old-IRC/Client.pm6 b/lib/old-IRC/Client.pm6
deleted file mode 100644
index 700739c..0000000
--- a/lib/old-IRC/Client.pm6
+++ /dev/null
@@ -1,174 +0,0 @@
-use v6;
-use IRC::Parser; # parse-irc
-use IRC::Client::Plugin::PingPong;
-use IRC::Client::Plugin;
-unit class IRC::Client;
-
-has Bool:D $.debug = False;
-has Str:D $.host = 'localhost';
-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 = ['#perl6bot'];
-has IO::Socket::Async $.sock;
-has @.plugins = [];
-has @.plugins-essential = [
- IRC::Client::Plugin::PingPong.new
-];
-has @!plugs = [|@!plugins-essential, |@!plugins];
-
-method handle-event ($e) {
- $e<pipe> = {};
-
- for @!plugs.grep(*.^can: 'irc-all-events') -> $p {
- my $res = $p.irc-all-events(self, $e);
- return unless $res === IRC_NOT_HANDLED;
- }
-
- # Wait for END_MOTD or ERR_NOMOTD before attempting to join
- if $e<command> eq '422' | '376' {
- $.ssay("JOIN {@!channels[]}\n");
- .irc-connected: self for @!plugs.grep(*.^can: 'irc-connected');
- }
-
- my $nick = $!nick;
- if ( ( $e<command> eq 'PRIVMSG' and $e<params>[0] eq $nick )
- or ( $e<command> eq 'NOTICE' and $e<params>[0] eq $nick )
- or ( $e<command> eq 'PRIVMSG'
- and $e<params>[1] ~~ /:i ^ $nick <[,:]> \s+/
- )
- ) {
- my %res = :where($e<who><nick> ),
- :who( $e<who><nick> ),
- :how( $e<command> ),
- :what( $e<params>[1] );
-
- %res<where> = $e<params>[0] # this message was said in the channel
- unless ( $e<command> eq 'PRIVMSG' and $e<params>[0] eq $nick )
- or ( $e<command> eq 'NOTICE' and $e<params>[0] eq $nick );
-
- %res<what>.subst-mutate: /:i ^ $nick <[,:]> \s+/, ''
- if %res<where> ~~ /^ <[#&]>/;
-
- for @!plugs.grep(*.^can: 'irc-to-me') -> $p {
- my $res = $p.irc-to-me(self, $e, %res);
- return 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);
- return 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);
- return unless $res === IRC_NOT_HANDLED;
- }
- }
-
- my $cmd = 'irc-' ~ $e<command>.lc;
- for @!plugs.grep(*.^can: $cmd) -> $p {
- my $res = $p."$cmd"(self, $e);
- return unless $res === IRC_NOT_HANDLED;
- }
-
- for @!plugs.grep(*.^can: 'irc-unhandled') -> $p {
- my $res = $p.irc-unhandled(self, $e);
- return unless $res === IRC_NOT_HANDLED;
- }
-}
-
-method notice (Str $who, Str $what) {
- my $msg = "NOTICE $who :$what\n";
- $!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;
-}
-
-method respond (
- Str:D :$how = 'privmsg',
- Str:D :$where is required,
- Str:D :$what is required is copy,
- Str:D :$who,
- :$when where Any|Dateish|Instant;
- # TODO: remove Any: https://rt.perl.org/Ticket/Display.html?id=127142
-) {
- $what = "$who, $what" if $who and $where ~~ /^<[#&]>/;
- my $method = $how.fc eq 'PRIVMSG'.fc ?? 'privmsg'
- !! $how.fc eq 'NOTICE'.fc ?? 'notice'
- !! fail 'Unknown :$how specified. Use PRIVMSG or NOTICE';
-
- if $when {
- Promise.at($when).then: { self."$method"($where, $what) };
- CATCH { warn .backtrace }
- }
- else {
- self."$method"($where, $what);
- }
- self;
-}
-
-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");
-
- # 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;
- for @$events -> $e {
- self.handle-event: $e;
- 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;
-}
-
-#### HELPER SUBS
-
-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] ";
-}
diff --git a/lib/old-IRC/Client/Plugin.pm6 b/lib/old-IRC/Client/Plugin.pm6
deleted file mode 100644
index d73d7bd..0000000
--- a/lib/old-IRC/Client/Plugin.pm6
+++ /dev/null
@@ -1,3 +0,0 @@
-constant IRC_HANDLED = "irc plugin handled \x1";
-constant IRC_NOT_HANDLED = "irc plugin not-handled \x2";
-unit class IRC::Client::Plugin;
diff --git a/lib/old-IRC/Client/Plugin/Debugger.pm6 b/lib/old-IRC/Client/Plugin/Debugger.pm6
deleted file mode 100644
index 13b1461..0000000
--- a/lib/old-IRC/Client/Plugin/Debugger.pm6
+++ /dev/null
@@ -1,8 +0,0 @@
-use Data::Dump;
-use IRC::Client::Plugin;
-unit class IRC::Client::Plugin::Debugger is IRC::Client::Plugin;
-
-method irc-all-events ($irc, $e) {
- say Dump $e, :indent(4);
- return IRC_NOT_HANDLED;
-}
diff --git a/lib/old-IRC/Client/Plugin/PingPong.pm6 b/lib/old-IRC/Client/Plugin/PingPong.pm6
deleted file mode 100644
index 2651fd6..0000000
--- a/lib/old-IRC/Client/Plugin/PingPong.pm6
+++ /dev/null
@@ -1,2 +0,0 @@
-unit class IRC::Client::Plugin::PingPong;
-method irc-ping ($irc, $e) { $irc.ssay("PONG {$irc.nick} $e<params>[0]") }
diff --git a/lib/old-IRC/Grammar.pm6 b/lib/old-IRC/Grammar.pm6
deleted file mode 100644
index c05322c..0000000
--- a/lib/old-IRC/Grammar.pm6
+++ /dev/null
@@ -1,20 +0,0 @@
-unit grammar IRC::Grammar;
-token TOP { <message>+ }
-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/old-IRC/Grammar/Actions.pm6 b/lib/old-IRC/Grammar/Actions.pm6
deleted file mode 100644
index 234e392..0000000
--- a/lib/old-IRC/Grammar/Actions.pm6
+++ /dev/null
@@ -1,26 +0,0 @@
-unit class IRC::Grammar::Actions;
-method TOP ($/) { $/.make: $<message>>>.made }
-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/lib/old-IRC/Parser.pm6 b/lib/old-IRC/Parser.pm6
deleted file mode 100644
index dda05e6..0000000
--- a/lib/old-IRC/Parser.pm6
+++ /dev/null
@@ -1,7 +0,0 @@
-use IRC::Grammar;
-use IRC::Grammar::Actions;
-unit class IRC::Parser;
-
-sub parse-irc (Str:D $input) is export {
- IRC::Grammar.parse($input, actions => IRC::Grammar::Actions).made // [];
-}