1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
|
#!/usr/bin/perl
use v5.14;
use warnings;
use Test::More;
use Test::Fatal qw( lives_ok );
my $CRLF = "\x0d\x0a"; # because \r\n isn't portable
my $written = "";
my @messages;
my $foo_received;
package TestIRC {
use base qw( Protocol::IRC );
sub new { return bless [], shift }
sub write { $written .= $_[1] }
sub on_message
{
return if $_[3]->{handled};
Test::More::is( $_[1], $_[2]->command_name, '$command is $message->command_name' );
push @messages, $_[2];
return 1;
}
sub on_message_FOO { $foo_received++ }
sub isupport
{
return "ascii" if $_[1] eq "CASEMAPPING";
}
}
my $irc = TestIRC->new;
$irc->send_message( "USER", undef, "me", "0", "*", "My real name" );
is( $written, "USER me 0 * :My real name$CRLF", 'Written stream after ->send_message' );
my $buffer = ':irc.example.com 001 YourNameHere :Welcome to IRC YourNameHere!me@your.host' . $CRLF;
$irc->on_read( $buffer );
is( length $buffer, 0, '->on_read consumes the entire line' );
is( scalar @messages, 1, 'Received 1 message after server reply' );
my $msg = shift @messages;
isa_ok( $msg, "Protocol::IRC::Message", '$msg isa Protocol::IRC::Message' );
is( $msg->command, "001", '$msg->command' );
is( $msg->prefix, "irc.example.com", '$msg->prefix' );
is_deeply( [ $msg->args ], [ "YourNameHere", "Welcome to IRC YourNameHere!me\@your.host" ], '$msg->args' );
$buffer = ":irc.example.com FOO$CRLF";
$irc->on_read( $buffer );
ok( $foo_received, '$foo_received after FOO message' );
$buffer = "$CRLF$CRLF";
lives_ok { $irc->on_read( $buffer ) } 'Blank lines does not die';
is( length $buffer, 0, 'Blank lines still eat all buffer' );
done_testing;
|
