File: 20client.t

package info (click to toggle)
libprotocol-irc-perl 0.13-2
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, forky, sid, trixie
  • size: 264 kB
  • sloc: perl: 2,122; makefile: 2
file content (69 lines) | stat: -rw-r--r-- 1,623 bytes parent folder | download
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
65
66
67
68
69
#!/usr/bin/perl

use v5.14;
use warnings;

use Test::More;

my $CRLF = "\x0d\x0a"; # because \r\n isn't portable

my @messages;
my @written;

package TestIRC {
   use base qw( Protocol::IRC::Client );

   sub new { return bless {}, shift }

   sub nick { return "MyNick" }

   sub on_message
   {
      my $self = shift;
      my ( $command, $message, $hints ) = @_;
      push @messages, [ $command, $message, $hints ];
   }

   sub write { $_[1] =~ s/\x0d\x0a$//; push @written, $_[1] }
}

my $irc = TestIRC->new;
sub write_irc
{
   my $line = $_[0];
   $irc->on_read( $line );
   length $line == 0 or die '$irc failed to read all of the line';
}

ok( defined $irc, 'defined $irc' );

# receiving
{
   write_irc( ':irc.example.com COMMAND arg1 arg2 :here is arg3' . $CRLF );

   my ( $command, $msg, $hints );
   ( $command, $msg, $hints ) = @{ shift @messages };

   is( $command, "COMMAND", '$command' );
   is( $msg->command, "COMMAND", '$msg->command' );

   is_deeply( [ $msg->args ], [ 'arg1', 'arg2', 'here is arg3' ], '$msg->args' );
}

# sending
{
   $irc->send_message( Protocol::IRC::Message->new( CMDA => ) );
   is( shift @written, "CMDA", '->send_message( P:I::Message )' );

   $irc->send_message( PING => { text => "12345" } );
   is( shift @written, "PING 12345", '->send_message( $command, { %namedargs } )' );

   $irc->send_message( CMDB => undef );
   is( shift @written, "CMDB", '->send_message( $command, $prefix, @args )' );

   # Name mangling
   $irc->send_message( JOIN => { target => "#channel" } );
   is( shift @written, "JOIN #channel", 'target to target_name mangling' );
}

done_testing;