diff options
-rw-r--r-- | .gitignore | 1 | ||||
-rw-r--r-- | examples/bot.pl6 | 4 | ||||
-rw-r--r-- | lib/IRC/Client.pm6 | 8 | ||||
-rw-r--r-- | lib/IRC/Client/Grammar/Actions.pm6 | 5 | ||||
-rw-r--r-- | lib/IRC/Client/Message.pm6 | 1 | ||||
-rw-r--r-- | lib/IRC/Client/Message/Numeric.pm6 | 2 | ||||
-rw-r--r-- | lib/IRC/Client/Message/Privmsg.pm6 | 4 | ||||
-rw-r--r-- | lib/IRC/Client/Message/Privmsg/Channel.pm6 | 5 | ||||
-rw-r--r-- | lib/IRC/Client/Message/Privmsg/Me.pm6 | 2 | ||||
-rw-r--r-- | lib/IRC/Client/Message/Unknown.pm6 | 4 | ||||
-rw-r--r-- | lib/old-IRC/Client.pm6 | 174 | ||||
-rw-r--r-- | lib/old-IRC/Client/Plugin.pm6 | 3 | ||||
-rw-r--r-- | lib/old-IRC/Client/Plugin/Debugger.pm6 | 8 | ||||
-rw-r--r-- | lib/old-IRC/Client/Plugin/PingPong.pm6 | 2 | ||||
-rw-r--r-- | lib/old-IRC/Grammar.pm6 | 20 | ||||
-rw-r--r-- | lib/old-IRC/Grammar/Actions.pm6 | 26 | ||||
-rw-r--r-- | lib/old-IRC/Parser.pm6 | 7 | ||||
-rw-r--r-- | t/release/01-basic.t | 68 | ||||
-rw-r--r-- | t/release/Test/IRC/Server.pm6 | 20 | ||||
-rw-r--r-- | t/release/servers/01-basic.pl | 67 |
20 files changed, 133 insertions, 298 deletions
@@ -1,2 +1,3 @@ lib/.precomp +t/release/.precomp *~ diff --git a/examples/bot.pl6 b/examples/bot.pl6 index 12245db..3a2127e 100644 --- a/examples/bot.pl6 +++ b/examples/bot.pl6 @@ -14,9 +14,11 @@ my $irc = IRC::Client.new( :debug<1> # :channels<#zofbot> # :host<irc.freenode.net> + :port<6667> :servers( mine => { :port<5667> }, - inspircd => { :port<6667> }, + inspircd => { }, + # freenode => { :host<irc.freenode.net> }, ) :plugins(MyPlug.new) ).run; 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 // []; -} diff --git a/t/release/01-basic.t b/t/release/01-basic.t new file mode 100644 index 0000000..e6a2cd7 --- /dev/null +++ b/t/release/01-basic.t @@ -0,0 +1,68 @@ +use lib <lib t/release>; +use Test; +use IRC::Client; +use Test::IRC::Server; + +my $Wait = (%*ENV<IRC_CLIENT_TEST_WAIT>//1) * 5; + +my $s = Test::IRC::Server.new; +# $s.start; +END { $s.kill }; + +loop { + last if $s.out.elems >= 2; + sleep 0.5; +} + +start { + my $irc = IRC::Client.new( + :debug(%*ENV<IRC_CLIENT_DEBUG>//0) + :nick<IRCBot> + :channels<#perl6 #perl7> + :servers( + meow => { :port<5000> } + ) + ).run; +} + +Promise.in($Wait).then: {$s.kill} +await $s.promise; + +my $out = [ + {:args($[[Any],]), :event("ircd_registered")}, + {:args($[[5000, 1, "0.0.0.0"],]), :event("ircd_listener_add")}, + { + :args( + $[["IRCBot", 1, 'time', "+i", "~Perl6IRC", + "simple.poco.server.irc", "simple.poco.server.irc", + "Perl6 IRC Client"],] + ), + :event("ircd_daemon_nick")}, + { + :args($[["IRCBot!~Perl6IRC\@simple.poco.server.irc", "#perl6"],]), :event("ircd_daemon_join") + } +]; + +# Fix time signature; +for $s.out { + next unless .<event> eq 'ircd_daemon_nick'; + .<args>[0][2] = 'time'; +} + +is-deeply $s.out, $out, 'Server output looks right'; + +done-testing; + +# sleep 10; + +# dd $s.out; +# +# [ +# {:args($[[Any],]), :event("ircd_registered") }, +# {:args($[[5000, 1, "0.0.0.0"],]), :event("ircd_listener_add")} +# ] + + +# ok 1; +# done-testing; +# diff --git a/t/release/Test/IRC/Server.pm6 b/t/release/Test/IRC/Server.pm6 new file mode 100644 index 0000000..fed3d66 --- /dev/null +++ b/t/release/Test/IRC/Server.pm6 @@ -0,0 +1,20 @@ +unit class Test::IRC::Server; + +use JSON::Fast; + +has $!port; +has $!proc; +has Promise $.promise; +has @.out; + +submethod BUILD (:$!port = 5000, :$server = 't/release/servers/01-basic.pl') { + $!proc = Proc::Async.new: 'perl', $server, $!port; + $!proc.stdout.tap: { + %*ENV<IRC_CLIENT_DEBUG> and dd .lines; + @!out.append: |.lines».&from-json + }; + $!proc.stderr.tap: { warn $_ }; + $!promise = $!proc.start; +} + +method kill { $!proc.kill; } diff --git a/t/release/servers/01-basic.pl b/t/release/servers/01-basic.pl index fe5ea06..086e213 100644 --- a/t/release/servers/01-basic.pl +++ b/t/release/servers/01-basic.pl @@ -1,8 +1,13 @@ -# A fairly simple example: use strict; use warnings; +use JSON::Meth; +use 5.020; use POE qw(Component::Server::IRC); +$|++; + +my ($Port) = @ARGV; + my %config = ( servername => 'simple.poco.server.irc', nicklen => 15, @@ -24,44 +29,34 @@ 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', - } - ); + $heap->{ircd}->add_listener(port => $Port); + $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"; + say { + event => $event, + args => \@args, + }->$j; + + + # 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"; } |