Import original source of Net-Async-IRC 0.11

10 files changed, 571 insertions, 0 deletions

diff --git a/t/00use.t b/t/00use.t
new file mode 100644
index 0000000..8bb8681
--- /dev/null
+++ b/t/00use.t
@@ -0,0 +1,11 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+use_ok( "Net::Async::IRC" );
+use_ok( "Net::Async::IRC::Protocol" );
+
+done_testing;
diff --git a/t/30client-connect.t b/t/30client-connect.t
new file mode 100644
index 0000000..bee0327
--- /dev/null
+++ b/t/30client-connect.t
@@ -0,0 +1,107 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use IO::Async::Test;
+use IO::Async::Loop;
+use IO::Async::Listener;
+
+use Net::Async::IRC;
+
+my $CRLF = "\x0d\x0a"; # because \r\n isn't portable
+
+my $loop = IO::Async::Loop->new();
+testing_loop( $loop );
+
+my $client;
+my $listener = IO::Async::Listener->new(
+   on_stream => sub {
+      ( undef, $client ) = @_;
+   },
+);
+$loop->add( $listener );
+
+$listener->listen(
+   addr => { family => "inet" },
+)->get;
+
+my @errors;
+
+my $irc = Net::Async::IRC->new(
+   user => "defaultuser",
+   realname => "Default Real name",
+
+   on_message => sub { "IGNORE" },
+
+   on_irc_error => sub {
+      my $self = shift;
+      my ( $err ) = @_;
+
+      push @errors, $err;
+   },
+);
+
+$loop->add( $irc );
+
+ok( !$irc->is_connected, 'not $irc->is_connected' );
+
+$irc->connect(
+   addr => {
+      family => "inet",
+      ip     => $listener->read_handle->sockhost,
+      port   => $listener->read_handle->sockport,
+   },
+)->get;
+
+ok( $irc->is_connected, '$irc->is_connected' );
+ok( !$irc->is_loggedin, 'not $irc->is_loggedin' );
+
+wait_for { $client };
+$client->configure( on_read => sub { 0 } );  # using read futures
+$loop->add( $client );
+
+# Now see if we can send a message
+$irc->send_message( "HELLO", undef, "world" );
+
+my $read_f;
+
+$read_f = $client->read_until( $CRLF );
+wait_for { $read_f->is_ready };
+
+is( scalar $read_f->get, "HELLO world$CRLF", 'Server stream after initial client message' );
+
+my $logged_in = 0;
+
+my $login_f = $irc->login(
+   nick => "MyNick",
+
+   on_login => sub { $logged_in = 1 },
+);
+
+$read_f = $client->read_until( qr/$CRLF.*$CRLF/ );
+wait_for { $read_f->is_ready };
+
+is( scalar $read_f->get,
+   "USER defaultuser 0 * :Default Real name$CRLF" .
+      "NICK MyNick$CRLF",
+   'Server stream after login' );
+
+$client->write( ":irc.example.com 001 MyNick :Welcome to IRC MyNick!defaultuser\@your.host.here$CRLF" );
+
+wait_for { $login_f->is_ready };
+
+ok( !$login_f->failure, 'Client logs in without failure' );
+
+ok( $logged_in, 'Client receives logged in event' );
+ok( $irc->is_connected, '$irc->is_connected' );
+ok( $irc->is_loggedin, '$irc->is_loggedin' );
+
+$client->write( ":something invalid-here$CRLF" );
+
+wait_for { scalar @errors };
+
+ok( defined shift @errors, 'on_error invoked' );
+
+done_testing;
diff --git a/t/31client-cap.t b/t/31client-cap.t
new file mode 100644
index 0000000..f2035ad
--- /dev/null
+++ b/t/31client-cap.t
@@ -0,0 +1,100 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use IO::Async::Test;
+use IO::Async::Loop;
+use IO::Async::Stream;
+
+use Net::Async::IRC;
+
+my $CRLF = "\x0d\x0a"; # because \r\n isn't portable
+
+my $loop = IO::Async::Loop->new();
+testing_loop( $loop );
+
+my ( $S1, $S2 ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!";
+
+# Normal CAP login
+{
+   my $irc = Net::Async::IRC->new(
+      handle => $S1,
+      use_caps => [qw( multi-prefix )],
+   );
+   $loop->add( $irc );
+
+   my $login_f = $irc->login(
+      nick => "MyNick",
+      user => "me",
+      realname => "My real name",
+   );
+
+   my $serverstream = "";
+   wait_for_stream { $serverstream =~ m/(?:.*$CRLF){3}/ } $S2 => $serverstream;
+
+   is( $serverstream, "CAP LS$CRLF" .
+                      "USER me 0 * :My real name$CRLF" .
+                      "NICK MyNick$CRLF", 'Server stream negotiates CAP' );
+   $serverstream = "";
+
+   $S2->syswrite( ':irc.example.com CAP * LS :multi-prefix sasl' . $CRLF );
+
+   wait_for_stream { $serverstream =~ m/.*$CRLF/ } $S2 => $serverstream;
+
+   is( $serverstream, "CAP REQ multi-prefix$CRLF", 'Client requests caps' );
+   $serverstream = "";
+
+   is_deeply( $irc->caps_supported,
+              { 'multi-prefix' => 1,
+                'sasl'         => 1 },
+              '$irc->caps_supported' );
+   ok( $irc->cap_supported( "multi-prefix" ), '$irc->cap_supported' );
+
+   $S2->syswrite( ':irc.example.com CAP * ACK :multi-prefix' . $CRLF );
+
+   wait_for_stream { $serverstream =~ m/.*$CRLF/ } $S2 => $serverstream;
+
+   is( $serverstream, "CAP END$CRLF", 'Client finishes CAP' );
+
+   is_deeply( $irc->caps_enabled,
+              { 'multi-prefix' => 1 },
+              '$irc->caps_enabled' );
+   ok( $irc->cap_enabled( "multi-prefix" ), '$irc->cap_enabled' );
+
+   $S2->syswrite( ':irc.example.com 001 MyNick :Welcome to IRC MyNick!me@your.host' . $CRLF );
+
+   wait_for { $login_f->is_ready };
+   $login_f->get;
+
+   $loop->remove( $irc );
+}
+
+# CAP ignored by server
+{
+   my $irc = Net::Async::IRC->new(
+      handle => $S1,
+      use_caps => [qw( multi-prefix )],
+   );
+   $loop->add( $irc );
+
+   my $login_f = $irc->login(
+      nick => "MyNick",
+      user => "me",
+      realname => "My real name",
+   );
+
+   my $serverstream = "";
+   wait_for_stream { $serverstream =~ m/(?:.*$CRLF){3}/ } $S2 => $serverstream;
+
+   $S2->syswrite( ':irc.example.com 001 MyNick :Welcome to IRC MyNick!me@your.host' . $CRLF );
+
+   wait_for { $login_f->is_ready };
+   $login_f->get;
+
+   is( $irc->caps_supported, undef, '$irc->caps_supported undef for CAPless server' );
+   is( $irc->caps_enabled,   undef, '$irc->caps_enabled undef for CAPless server' );
+}
+
+done_testing;
diff --git a/t/32client-encoding.t b/t/32client-encoding.t
new file mode 100644
index 0000000..7110ab7
--- /dev/null
+++ b/t/32client-encoding.t
@@ -0,0 +1,84 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use utf8;
+
+use Test::More;
+use IO::Async::Test;
+use IO::Async::Loop;
+use IO::Async::Listener;
+
+use Encode qw( encode_utf8 );
+
+use Net::Async::IRC;
+
+my $CRLF = "\x0d\x0a"; # because \r\n isn't portable
+
+my $loop = IO::Async::Loop->new();
+testing_loop( $loop );
+
+SKIP: foreach my $SSL ( 0, 1 ) {
+   if( $SSL ) {
+      eval { require IO::Async::SSL } or skip "No IO::Async::SSL", 1;
+   }
+
+   my $client;
+   my $listener = IO::Async::Listener->new(
+      on_stream => sub {
+         ( undef, $client ) = @_;
+      },
+   );
+   $loop->add( $listener );
+
+   $listener->listen(
+      addr => { family => "inet" },
+      ( $SSL ?
+         ( extensions => [ 'SSL' ],
+           SSL_key_file  => "t/privkey.pem",
+           SSL_cert_file => "t/server.pem", ) :
+         () ),
+   )->get;
+
+   my $irc = Net::Async::IRC->new(
+      user => "defaultuser",
+      realname => "Default Real name",
+
+      encoding => "UTF-8",
+
+      on_message => sub { "IGNORE" },
+
+      on_irc_error => sub {},
+   );
+   $loop->add( $irc );
+
+   $irc->connect(
+      addr => {
+         family => "inet",
+         ip     => $listener->read_handle->sockhost,
+         port   => $listener->read_handle->sockport,
+      },
+      ( $SSL ?
+         ( extensions => [ 'SSL' ],
+           SSL_verify_mode => 0 ) :
+         () ),
+   )->get;
+
+   wait_for { $client };
+   $client->configure( on_read => sub { 0 } );  # using read futures
+   $loop->add( $client );
+
+   $irc->send_message( "PRIVMSG", undef, "target", "Ĉu vi ĉi tio vidas?" );
+
+   my $read_f = $client->read_until( $CRLF );
+   wait_for { $read_f->is_ready };
+
+   is( scalar $read_f->get, encode_utf8( "PRIVMSG target :Ĉu vi ĉi tio vidas?$CRLF" ),
+      'Stream is encoded over ' . ( $SSL ? "SSL" : "plaintext" ) );
+
+   $loop->remove( $irc );
+   $loop->remove( $client );
+   $loop->remove( $listener );
+}
+
+done_testing;
diff --git a/t/33client-nick.t b/t/33client-nick.t
new file mode 100644
index 0000000..078f5dc
--- /dev/null
+++ b/t/33client-nick.t
@@ -0,0 +1,100 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use IO::Async::Test;
+use IO::Async::OS;
+use IO::Async::Loop;
+use IO::Async::Stream;
+
+use Net::Async::IRC;
+
+my $CRLF = "\x0d\x0a"; # because \r\n isn't portable
+
+my $loop = IO::Async::Loop->new();
+testing_loop( $loop );
+
+my ( $S1, $S2 ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!";
+
+my $in_use = 0;
+my $err_nick = 0;
+my $irc = Net::Async::IRC->new(
+   handle => $S1,
+
+   user => "defaultuser",
+   realname => "Default Real name",
+
+   nick => "AlreadyUsedNick",
+
+   on_message_ERR_NICKNAMEINUSE => sub { shift->change_nick( "1stNick" ); $in_use = 1; },
+   on_message_ERR_ERRONEUSNICKNAME => sub { shift->change_nick( "FirstNickTOOLONG" ); $err_nick = 1; },
+   on_message => sub { "IGNORE" },
+);
+
+$loop->add( $irc );
+
+is( $irc->nick, "AlreadyUsedNick", 'Initial nick is set' );
+
+ok( $irc->is_nick_me( "AlreadyUsedNick" ), 'Client recognises initial nick' );
+ok( !$irc->is_nick_me( "SomeoneElse" ), 'Client does not recognise other nick' );
+
+my $login_f = $irc->login;
+
+my $serverstream = "";
+
+wait_for_stream { $serverstream =~ m/$CRLF.*$CRLF/ } $S2 => $serverstream;
+
+is( $serverstream, "USER defaultuser 0 * :Default Real name$CRLF" . 
+                   "NICK AlreadyUsedNick$CRLF", 'Server stream after attempt to login with nick already in use' );
+
+$S2->syswrite( ":irc.example.com 433 * AlreadyUsedNick :Nickname is already in use$CRLF" );
+
+wait_for { $in_use };
+
+ok( $in_use, 'Client recieves ERR_NICKNAMEINUSE error' );
+
+$S2->syswrite( ":irc.example.com 432 * 1stNick :Erroneous nickname$CRLF" );
+
+wait_for { $err_nick };
+
+ok( $err_nick, 'Client recieves ERR_ERRONEUSNICK error' );
+
+$S2->syswrite( ":irc.example.com 001 FirstNick :Welcome to IRC FirstNick!defaultuser\@your.host.here$CRLF" );
+
+wait_for { $login_f->is_ready };
+$login_f->get;
+
+is( $irc->nick, "FirstNick", 'Nick was updated correctly even after multiple errors' );
+
+$serverstream = "";
+
+wait_for_stream { $serverstream =~ m/$CRLF/ } $S2 => $serverstream;
+
+is( $serverstream, "NICK 1stNick$CRLF" .
+                   "NICK FirstNickTOOLONG$CRLF", 'Server stream after login' );
+
+$irc->change_nick( "SecondNick" );
+
+is( $irc->nick, "FirstNick", 'Nick still old until server confirms' );
+
+ok( $irc->is_nick_me( "FirstNick" ), 'Client recognises still old nick' );
+ok( !$irc->is_nick_me( "SecondNick" ), 'Client does not recognise new nick' );
+
+$serverstream = "";
+
+wait_for_stream { $serverstream =~ m/$CRLF/ } $S2 => $serverstream;
+
+is( $serverstream, "NICK SecondNick$CRLF", 'Server stream after NICK command' );
+
+$S2->syswrite( ":FirstNick!defaultuser\@your.host.here NICK SecondNick$CRLF" );
+
+wait_for { not $irc->is_nick_me( "FirstNick" ) };
+
+is( $irc->nick, "SecondNick", 'Object now confirms new nick' );
+
+ok( !$irc->is_nick_me( "FirstNick" ), 'Client no longer recognises old nick' );
+ok( $irc->is_nick_me( "SecondNick" ), 'Client now recognises new nick' );
+
+done_testing;
diff --git a/t/40methods-basic.t b/t/40methods-basic.t
new file mode 100644
index 0000000..dd36500
--- /dev/null
+++ b/t/40methods-basic.t
@@ -0,0 +1,40 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use IO::Async::Test;
+use IO::Async::Loop;
+use IO::Async::Stream;
+
+use Net::Async::IRC;
+
+my $CRLF = "\x0d\x0a"; # because \r\n isn't portable
+
+my $loop = IO::Async::Loop->new();
+testing_loop( $loop );
+
+my ( $S1, $S2 ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!";
+
+my $irc = Net::Async::IRC->new(
+   handle => $S1,
+);
+$loop->add( $irc );
+
+# privmsg
+{
+   my $f = $irc->do_PRIVMSG( target => "#target", text => "Your message here" );
+
+   isa_ok( $f, "Future", '$f' );
+
+   my $serverstream = "";
+   wait_for_stream { $serverstream =~ m/(?:.*$CRLF)/ } $S2 => $serverstream;
+
+   is( $serverstream, "PRIVMSG #target :Your message here$CRLF",
+      '->privmsg' );
+
+   ok( $f->is_ready, '$f is ready' );
+}
+
+done_testing;
diff --git a/t/50client-pingpong.t b/t/50client-pingpong.t
new file mode 100644
index 0000000..4f715bf
--- /dev/null
+++ b/t/50client-pingpong.t
@@ -0,0 +1,86 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+use Time::HiRes qw(); # Empty import, just there to let IO::Async and Net::Async::IRC use it
+
+use IO::Async::Test;
+use IO::Async::OS;
+use IO::Async::Loop;
+use IO::Async::Stream;
+
+use Net::Async::IRC;
+
+my $CRLF = "\x0d\x0a"; # because \r\n isn't portable
+
+my $loop = IO::Async::Loop->new();
+testing_loop( $loop );
+
+my ( $S1, $S2 ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!";
+
+my $lag;
+my $pingout;
+
+my $irc = Net::Async::IRC->new(
+   handle => $S1,
+   on_message => sub { "IGNORE" },
+
+   pingtime => 2,
+   pongtime => 1,
+
+   on_pong_reply   => sub { $lag = $_[1] },
+   on_ping_timeout => sub { $pingout = 1 },
+);
+
+$loop->add( $irc );
+
+# This is all tricky timing-related code. Pay attention
+
+# First [the server] will send three messages, separated by 1sec, and assert
+# that the client didn't send a PING
+
+my $serverstream = "";
+
+my $msgcount = 0;
+
+sub tick {
+   $msgcount++;
+   $S2->syswrite( "HELLO client$CRLF" );
+
+   $loop->enqueue_timer(
+      delay => 1,
+      code => \&tick
+   ) if $msgcount < 3;
+}
+
+tick();
+
+wait_for_stream { $msgcount == 3 } $S2 => $serverstream;
+
+is( $serverstream, "", 'client quiet after server noise' );
+
+# Now [the server] will be quiet and assert that the client sends a PING
+
+wait_for_stream { $serverstream =~ m/$CRLF/ } $S2 => $serverstream;
+
+like( $serverstream, qr/^PING .*$CRLF$/, 'client sent PING after server idle' );
+
+# Now lets be a good server and reply to the PING
+my ( $pingarg ) = $serverstream =~ m/^PING (.*)$CRLF$/;
+$S2->syswrite( ":irc.example.com PONG $pingarg$CRLF" );
+
+undef $lag;
+wait_for { defined $lag };
+
+ok( $lag >= 0 && $lag <= 1, 'client acknowledges PONG reply' );
+
+# Now [the server] won't reply to a PING at all, and hope for an event to note
+# that it failed
+
+wait_for { defined $pingout };
+ok( $pingout, 'client reports PING timeout' );
+
+done_testing;
diff --git a/t/99pod.t b/t/99pod.t
new file mode 100644
index 0000000..eb319fb
--- /dev/null
+++ b/t/99pod.t
@@ -0,0 +1,11 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+eval "use Test::Pod 1.00";
+plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
+
+all_pod_files_ok();
diff --git a/t/privkey.pem b/t/privkey.pem
new file mode 100644
index 0000000..a7eb3d0
--- /dev/null
+++ b/t/privkey.pem
@@ -0,0 +1,15 @@
+-----BEGIN RSA PRIVATE KEY-----
+MIICXAIBAAKBgQDddpSdw0V5emmrozEq3LkTiILDUeUk4MiTmoug1bcfgbQwld4r
+U/Dyl1oT8bonEzIcf7002HAQmhPae+9XdQOxnqyzamRBNwuypO895g5EPswTh9Rr
+PohJse3qWs4yVP1PVeatBwxIvug+6+0XXAymNBVJmQfcCbLX4i/b27NtmwIDAQAB
+AoGAcz93XZY1/F6oyQo21wBgS/r5WZ2vqn5TwwRk70DoeDvuQm5rXI7lT8lVthVQ
+c284373V/782ql0UQdnHFvMtBPT14fPdfysBSFIwjPdAZMG6EqTtYy30o8Hk1N34
+CcBTqS4nt+MvxW3xdvQd/hVZgoWRbdCZ6p11Ky9ylmJgt6kCQQD3cRkKNjeF//8j
+eG/L0OykpTivy0peDCWOZCyRIME45+L/eYaYKMdhQ4YNeaguMC2Z8GrbXf2oRZce
+t2jxn6tdAkEA5R92e5jC3dT+S1SCCSzdr1+IGF8PF5EnPCGtQMl+pfCleAo/aiPK
+pM2lmoUaOoMj8j655mq5gdUxxshPFl7lVwJBAJmo2D3pMU27jbt/PR263lnYaH1y
+pvoEXQYx2yM8zgECr4qq8xRmrnoOLp8Ln48fSBJCpHkZwz3OCWx/xWHXH9kCQEH+
+3wTYyoBVAm42SEJWTwBdtvi2IMW8BJ4YYSwBHd60QyUhZoSvDIaNyX6JijWCYo87
+LBbHdOmFvBGyzrz11n8CQCmlyhmF2xe1xUrYnGgnfIj29KPFmJik2qeDTfxACv4Z
+MzPtOWOEdZjc5h6JTnQTl0fcko35l5FaUeflvw2uBGM=
+-----END RSA PRIVATE KEY-----
diff --git a/t/server.pem b/t/server.pem
new file mode 100644
index 0000000..54b5b51
--- /dev/null
+++ b/t/server.pem
@@ -0,0 +1,17 @@
+-----BEGIN CERTIFICATE-----
+MIICsDCCAhmgAwIBAgIJAOLBB28kRrw6MA0GCSqGSIb3DQEBBQUAMEUxCzAJBgNV
+BAYTAkFVMRMwEQYDVQQIEwpTb21lLVN0YXRlMSEwHwYDVQQKExhJbnRlcm5ldCBX
+aWRnaXRzIFB0eSBMdGQwHhcNMTAxMTIxMjIwMjM5WhcNMTAxMjIxMjIwMjM5WjBF
+MQswCQYDVQQGEwJBVTETMBEGA1UECBMKU29tZS1TdGF0ZTEhMB8GA1UEChMYSW50
+ZXJuZXQgV2lkZ2l0cyBQdHkgTHRkMIGfMA0GCSqGSIb3DQEBAQUAA4GNADCBiQKB
+gQDddpSdw0V5emmrozEq3LkTiILDUeUk4MiTmoug1bcfgbQwld4rU/Dyl1oT8bon
+EzIcf7002HAQmhPae+9XdQOxnqyzamRBNwuypO895g5EPswTh9RrPohJse3qWs4y
+VP1PVeatBwxIvug+6+0XXAymNBVJmQfcCbLX4i/b27NtmwIDAQABo4GnMIGkMB0G
+A1UdDgQWBBQKCmQV0xTMGtYoalfHFbpDr3kgszB1BgNVHSMEbjBsgBQKCmQV0xTM
+GtYoalfHFbpDr3kgs6FJpEcwRTELMAkGA1UEBhMCQVUxEzARBgNVBAgTClNvbWUt
+U3RhdGUxITAfBgNVBAoTGEludGVybmV0IFdpZGdpdHMgUHR5IEx0ZIIJAOLBB28k
+Rrw6MAwGA1UdEwQFMAMBAf8wDQYJKoZIhvcNAQEFBQADgYEAIjrc8INv1WxIq0kV
+yDEmcBeot1RRiCQJJxy3xq6eZZcTkT+YvEVrR/hOWPGL0qFInltBKcp0To0w+Esz
+SQfvieWW1U/aAfcBNJ26HRyzh8N98ZST9k4LlDJbneHB8McF1G5n/D71wmHm1llh
+cIX3gRpAkOW5gnjXUYpgsviJxUQ=
+-----END CERTIFICATE-----