From 0daa494480f7abe37a6e593c6238811009b7b914 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Fri, 3 Jun 2016 07:01:14 -0400 Subject: Start rewrite --- t/release/servers/01-basic.pl | 67 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 67 insertions(+) create mode 100644 t/release/servers/01-basic.pl (limited to 't/release') 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"; + } -- cgit v1.1 From 140959e4f170d732d990e69b9a0ca129b89e3ac4 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sun, 5 Jun 2016 21:39:47 -0400 Subject: First working test --- t/release/01-basic.t | 68 +++++++++++++++++++++++++++++++++++++++++++ t/release/Test/IRC/Server.pm6 | 20 +++++++++++++ t/release/servers/01-basic.pl | 67 ++++++++++++++++++++---------------------- 3 files changed, 119 insertions(+), 36 deletions(-) create mode 100644 t/release/01-basic.t create mode 100644 t/release/Test/IRC/Server.pm6 (limited to 't/release') 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 ; +use Test; +use IRC::Client; +use Test::IRC::Server; + +my $Wait = (%*ENV//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//0) + :nick + :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 . eq 'ircd_daemon_nick'; + .[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 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"; } -- cgit v1.1 From 7a17edf5807b585698a219aaf551f1393139c001 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Thu, 9 Jun 2016 21:53:21 -0400 Subject: Fix multi-channel join for non-spec-conforming servers --- t/release/01-basic.t | 24 +++++++++--------------- 1 file changed, 9 insertions(+), 15 deletions(-) (limited to 't/release') diff --git a/t/release/01-basic.t b/t/release/01-basic.t index e6a2cd7..114f4c4 100644 --- a/t/release/01-basic.t +++ b/t/release/01-basic.t @@ -1,12 +1,15 @@ use lib ; use Test; +use Test::Notice; use IRC::Client; use Test::IRC::Server; my $Wait = (%*ENV//1) * 5; +notice 'Testing connection to one server and joining two channels'; + +diag 'Starting IRC Server'; my $s = Test::IRC::Server.new; -# $s.start; END { $s.kill }; loop { @@ -14,6 +17,7 @@ loop { sleep 0.5; } +diag 'Starting IRC Client'; start { my $irc = IRC::Client.new( :debug(%*ENV//0) @@ -25,6 +29,7 @@ start { ).run; } +diag 'Waiting for things to happen...'; Promise.in($Wait).then: {$s.kill} await $s.promise; @@ -40,6 +45,9 @@ my $out = [ :event("ircd_daemon_nick")}, { :args($[["IRCBot!~Perl6IRC\@simple.poco.server.irc", "#perl6"],]), :event("ircd_daemon_join") + }, + { + :args($[["IRCBot!~Perl6IRC\@simple.poco.server.irc", "#perl7"],]), :event("ircd_daemon_join") } ]; @@ -52,17 +60,3 @@ for $s.out { 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; -# -- cgit v1.1 From 505933841a1384c234be7b05739c4713b0ee4022 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Fri, 10 Jun 2016 06:39:52 -0400 Subject: Intermediary --- t/release/02-multi-server.t | 75 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 75 insertions(+) create mode 100644 t/release/02-multi-server.t (limited to 't/release') diff --git a/t/release/02-multi-server.t b/t/release/02-multi-server.t new file mode 100644 index 0000000..d234c0b --- /dev/null +++ b/t/release/02-multi-server.t @@ -0,0 +1,75 @@ +use lib ; +use Test; +use Test::Notice; +use IRC::Client; +use Test::IRC::Server; + +my $Wait = (%*ENV//1) * 5; + +notice 'Testing connection to four servers and joining two channels in each'; + +diag 'Starting IRC Servers'; +my $s1 = Test::IRC::Server.new: :port<5020>; +my $s2 = Test::IRC::Server.new: :port<5021>; +my $s3 = Test::IRC::Server.new: :port<5022>; +my $s4 = Test::IRC::Server.new: :port<5023>; +END { $s1.kill; $s2.kill; $s3.kill; $s4.kill; }; + +loop { + last if $s1.out.elems & $s2.out.elems & $s3.out.elems & $s4.out.elems >= 2; + sleep 0.5; +} + +diag 'Starting IRC Client'; +start { + my $irc = IRC::Client.new( + :debug(%*ENV//0) + :nick + :channels<#perl6 #perl7> + :servers( + s1 => { :port<5020> }, + s2 => { :port<5021>, :nick, :channels<#perl7 #perl9> }, + s3 => { :port<5022>, :channels<#perl10 #perl11> }, + s4 => { :port<5023>, :nick }, + ) + ).run; +} + +diag 'Waiting for things to happen...'; +Promise.in($Wait).then: { $s1.kill; $s2.kill; $s3.kill; $s4.kill; } +await Promise.allof: ($s1, $s2, $s3, $s4).map: *.promise; + +dd $s1.out; +diag '----'; +dd $s2.out; +diag '----'; +dd $s3.out; +diag '----'; +dd $s4.out; +diag '----'; + +# +# 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 . eq 'ircd_daemon_nick'; +# .[0][2] = 'time'; +# } +# +# is-deeply $s.out, $out, 'Server output looks right'; + +done-testing; -- cgit v1.1